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
101
102
103
104
105
106
107
open Preface_core.Fun
module Core (Req : Preface_specs.Functor.WITH_MAP) :
Preface_specs.Functor.CORE with type 'a t = 'a Req.t =
Req
module Operation (Core : Preface_specs.Functor.CORE) :
Preface_specs.Functor.OPERATION with type 'a t = 'a Core.t = struct
type 'a t = 'a Core.t
let replace value x = (Core.map <% const) value x
let void x = replace () x
end
module Infix
(Core : Preface_specs.Functor.CORE)
(Operation : Preface_specs.Functor.OPERATION with type 'a t = 'a Core.t) :
Preface_specs.Functor.INFIX with type 'a t = 'a Core.t = struct
type 'a t = 'a Operation.t
let ( <$> ) = Core.map
let ( <&> ) x f = Core.map f x
let ( <$ ) value x = Operation.replace value x
let ( $> ) x value = Operation.replace value x
end
module Via
(Core : Preface_specs.Functor.CORE)
(Operation : Preface_specs.Functor.OPERATION with type 'a t = 'a Core.t)
(Infix : Preface_specs.Functor.INFIX with type 'a t = 'a Core.t) :
Preface_specs.FUNCTOR with type 'a t = 'a Core.t = struct
include Core
include Operation
include Infix
module Infix = Infix
end
module Via_map (Req : Preface_specs.Functor.WITH_MAP) :
Preface_specs.FUNCTOR with type 'a t = 'a Req.t = struct
module Core = Core (Req)
include Core
module Operation = Operation (Core)
include Operation
module Infix = Infix (Core) (Operation)
include Infix
end
module Composition (F : Preface_specs.FUNCTOR) (G : Preface_specs.FUNCTOR) :
Preface_specs.FUNCTOR with type 'a t = 'a G.t F.t = Via_map (struct
type 'a t = 'a G.t F.t
let map f x = F.map (G.map f) x
end)
module From_arrow (A : Preface_specs.ARROW) :
Preface_specs.FUNCTOR with type 'a t = (unit, 'a) A.t = Via_map (struct
type 'a t = (unit, 'a) A.t
let map f x = A.(x >>> arrow f)
end)
module From_applicative (Applicative : Preface_specs.APPLICATIVE) :
Preface_specs.FUNCTOR with type 'a t = 'a Applicative.t =
Applicative
module From_alt (Alt : Preface_specs.ALT) :
Preface_specs.FUNCTOR with type 'a t = 'a Alt.t =
Alt
module From_monad (Monad : Preface_specs.MONAD) :
Preface_specs.FUNCTOR with type 'a t = 'a Monad.t =
Monad
module From_alternative (Alternative : Preface_specs.ALTERNATIVE) :
Preface_specs.FUNCTOR with type 'a t = 'a Alternative.t =
Alternative
module From_monad_plus (Monad_plus : Preface_specs.MONAD_PLUS) :
Preface_specs.FUNCTOR with type 'a t = 'a Monad_plus.t =
Monad_plus
module From_comonad (Comonad : Preface_specs.COMONAD) :
Preface_specs.FUNCTOR with type 'a t = 'a Comonad.t =
Comonad
module Sum (F : Preface_specs.FUNCTOR) (G : Preface_specs.FUNCTOR) = struct
type 'a sum =
| L of 'a F.t
| R of 'a G.t
include Via_map (struct
type 'a t = 'a sum
let map f = function L x -> L (F.map f x) | R x -> R (G.map f x)
end)
end
module Product (F : Preface_specs.FUNCTOR) (G : Preface_specs.FUNCTOR) :
Preface_specs.FUNCTOR with type 'a t = 'a F.t * 'a G.t = Via_map (struct
type 'a t = 'a F.t * 'a G.t
let map f (x, y) = (F.map f x, G.map f y)
end)