Source file arrow_zero.ml

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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
module Core_over_category_and_via_arrow_and_fst
    (Category : Preface_specs.Category.CORE)
    (Req : Preface_specs.Arrow_zero.WITH_ARROW_AND_FST
             with type ('a, 'b) t = ('a, 'b) Category.t) =
struct
  include Arrow.Core_over_category_and_via_arrow_and_fst (Category) (Req)

  let neutral = Req.neutral
end

module Core_over_category_and_via_arrow_and_split
    (Category : Preface_specs.Category.CORE)
    (Req : Preface_specs.Arrow_zero.WITH_ARROW_AND_SPLIT
             with type ('a, 'b) t = ('a, 'b) Category.t) =
struct
  include Arrow.Core_over_category_and_via_arrow_and_split (Category) (Req)

  let neutral = Req.neutral
end

module Operation_over_category = Arrow.Operation_over_category
module Alias = Arrow.Alias
module Infix_over_category = Arrow.Infix_over_category

module Via
    (Core : Preface_specs.Arrow_zero.CORE)
    (Operation : Preface_specs.Arrow_zero.OPERATION)
    (Alias : Preface_specs.Arrow_zero.ALIAS)
    (Infix : Preface_specs.Arrow_zero.INFIX) =
struct
  include Core
  include Operation
  include Alias
  include Infix
  module Infix = Infix
end

module Over_category_and_via_arrow_and_fst
    (Category : Preface_specs.CATEGORY)
    (Req : Preface_specs.Arrow_zero.WITH_ARROW_AND_FST
             with type ('a, 'b) t = ('a, 'b) Category.t) =
struct
  module Core = Core_over_category_and_via_arrow_and_fst (Category) (Req)
  module Operation = Operation_over_category (Category) (Core)
  module Alias = Alias (Operation)

  module Infix =
    Infix_over_category
      (struct
        type ('a, 'b) t = ('a, 'b) Category.t

        include Category.Infix
      end)
      (Core)
      (Operation)

  include Core
  include Operation
  include Alias
  include Infix
end

module Over_category_and_via_arrow_and_split
    (Category : Preface_specs.CATEGORY)
    (Req : Preface_specs.Arrow_zero.WITH_ARROW_AND_SPLIT
             with type ('a, 'b) t = ('a, 'b) Category.t) =
struct
  module Core = Core_over_category_and_via_arrow_and_split (Category) (Req)
  module Operation = Operation_over_category (Category) (Core)
  module Alias = Alias (Operation)

  module Infix =
    Infix_over_category
      (struct
        type ('a, 'b) t = ('a, 'b) Category.t

        include Category.Infix
      end)
      (Core)
      (Operation)

  include Core
  include Operation
  include Alias
  include Infix
end

module Over_arrow
    (Arrow : Preface_specs.ARROW)
    (Req : Preface_specs.Arrow_zero.WITH_NEUTRAL
             with type ('a, 'b) t = ('a, 'b) Arrow.t) =
struct
  module Core_aux =
    Core_over_category_and_via_arrow_and_fst
      (Arrow)
      (struct
        include Arrow
        include Req
      end)

  module Operation_aux = Operation_over_category (Arrow) (Core_aux)
  module Infix_aux = Infix_over_category (Arrow) (Core_aux) (Operation_aux)
  include Core_aux
  include Operation_aux
  include Arrow

  module Infix = struct
    include Arrow.Infix
    include Infix_aux
  end

  include Infix
end

module From_monad_plus (Monad : Preface_specs.Monad_plus.CORE) =
  Over_arrow
    (Arrow.From_monad
       (Monad))
       (struct
         type ('a, 'b) t = 'a -> 'b Monad.t

         let neutral _ = Monad.neutral
       end)

module From_arrow_plus (Plus : Preface_specs.ARROW_PLUS) = Plus

module Product (F : Preface_specs.ARROW_ZERO) (G : Preface_specs.ARROW_ZERO) =
  Over_arrow
    (Arrow.Product (F) (G))
       (struct
         type ('a, 'b) t = ('a, 'b) F.t * ('a, 'b) G.t

         let neutral = (F.neutral, G.neutral)
       end)