A collection of experiments, more or less organized.
Rambling around checks
+76
+53
lib/pidgin/check.ml
+53
lib/pidgin/check.ml
···
1
+
type error =
2
+
| Unexpected_kind of
3
+
{ expected : Kind.t
4
+
; given : Kind.t
5
+
; repr : Repr.t
6
+
}
7
+
8
+
type ('a, 'b) t =
9
+
{ kind : Kind.t
10
+
; validation : 'a -> ('b, error) Result.t
11
+
}
12
+
13
+
type 'a v = (Repr.t, 'a) t
14
+
15
+
let map f v =
16
+
let validation x = x |> v.validation |> Result.map f in
17
+
{ v with validation }
18
+
;;
19
+
20
+
let mk ~kind validation = { kind; validation }
21
+
22
+
let unexpected_kind ~expected ~repr =
23
+
let given = Kind.from_repr repr in
24
+
Unexpected_kind { expected; given; repr } |> Result.error
25
+
;;
26
+
27
+
let or_ a b =
28
+
let expected = Kind.or_ a.kind b.kind in
29
+
let validation x =
30
+
match a.validation x with
31
+
| Ok x -> Ok x
32
+
| _ -> b.validation x
33
+
in
34
+
mk ~kind:expected validation
35
+
;;
36
+
37
+
let null =
38
+
let expected = Kind.null in
39
+
let validation = function
40
+
| Repr.Null -> Ok ()
41
+
| repr -> unexpected_kind ~expected ~repr
42
+
in
43
+
mk ~kind:expected validation
44
+
;;
45
+
46
+
let unit =
47
+
let expected = Kind.unit in
48
+
let validation = function
49
+
| Repr.Unit -> Ok ()
50
+
| repr -> unexpected_kind ~expected ~repr
51
+
in
52
+
mk ~kind:expected validation
53
+
;;
+23
lib/pidgin/check.mli
+23
lib/pidgin/check.mli
···
1
+
(** Represent a validation function. *)
2
+
3
+
(** {1 Types} *)
4
+
5
+
type ('a, 'b) t
6
+
type 'a v = (Repr.t, 'a) t
7
+
8
+
type error = private
9
+
| Unexpected_kind of
10
+
{ expected : Kind.t
11
+
; given : Kind.t
12
+
; repr : Repr.t
13
+
}
14
+
15
+
(** {1 Combining checks} *)
16
+
17
+
val or_ : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t
18
+
val map : ('a -> 'b) -> ('input, 'a) t -> ('input, 'b) t
19
+
20
+
(** {1 Presaved combinators} *)
21
+
22
+
val unit : unit v
23
+
val null : unit v