1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
module type Seed = sig
type t
val op : t -> t -> t
end
module type S = sig
include Seed
val ( * ) : t -> t -> t
val concat : t NonEmptyList.t -> t
end
module type Seed1 = sig
type 'a t
val op : 'a t -> 'a t -> 'a t
end
module type S1 = sig
include Seed1
val ( * ) : 'a t -> 'a t -> 'a t
val concat : 'a t NonEmptyList.t -> 'a t
end
module Law (S : S) = struct
let associativity x y z = S.(x * (y * z)) = S.((x * y) * z)
end
module Make (S:Seed) : S with type t = S.t = struct
include S
let ( * ) a b = op a b
let concat xs = NonEmptyList.fold op xs
end
module Make1 (Seed: Seed1) : S1 with type 'a t = 'a Seed.t = struct
include Seed
let ( * ) a b = op a b
let concat xs = NonEmptyList.fold op xs
end
let make (type a) op =
let module Seed = (struct
type t = a
let op = op
end)
in
(module Make (Seed) : S with type t = a)
module Bool = struct
module Or = (val make (||))
module And = (val make (&&))
end
module Int = struct
module Sum = (val make (+))
module Product = (val make ( * ))
end
module Option = struct
module Make (S : S) : S with type t = S.t Option.t = struct
module Seed = struct
type t = S.t Option.t
let op a b =
match a , b with
| None , b -> b
| a , None -> a
| Some a , Some b -> Some (S.op a b)
end
include Make (Seed)
end
end
module Endo = struct
module Make (T : Triv.S) : S with type t = (T.t -> T.t) = struct
let compose : (T.t -> T.t) -> (T.t -> T.t) -> (T.t -> T.t) =
fun f g x -> f (g x)
include (val make compose)
end
let make (type a) (proxy : a Util.proxy) =
(module Make (val Triv.make proxy) : S with type t = a -> a)
end
module Dual = struct
module Make (S : S) : S with type t = S.t = struct
include S
let op = Fun.flip op
end
let make op = make (Fun.flip op)
end
module NonEmptyList = struct
include NonEmptyList
include Make1 (NonEmptyList)
end