package bastet

  1. Overview
  2. Docs
package bastet
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file Dual.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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
open Interface

(** A data structure representing the dual of a monoid *)
type 'a dual = Dual of 'a

module type MAGMA_F = functor (M : MAGMA) -> MAGMA with type t = M.t dual

module type SEMIGROUP_F = functor (S : SEMIGROUP) -> SEMIGROUP with type t = S.t dual

module type MONOID_F = functor (M : MONOID) -> MONOID with type t = M.t dual

module type MAGMA_ANY_F = functor (M : MAGMA_ANY) -> MAGMA_ANY with type 'a t = 'a M.t dual

module type SEMIGROUP_ANY_F = functor (S : SEMIGROUP_ANY) ->
  SEMIGROUP_ANY with type 'a t = 'a S.t dual

module type MONOID_ANY_F = functor (M : MONOID_ANY) -> MONOID_ANY with type 'a t = 'a M.t dual

module type TRAVERSABLE_F = functor (A : APPLICATIVE) ->
  TRAVERSABLE with type 'a t = 'a dual and type 'a applicative_t = 'a A.t

module Magma : MAGMA_F =
functor
  (M : MAGMA)
  ->
  struct
    type t = M.t dual

    let append (Dual a) (Dual b) = Dual (M.append b a)
  end

module Semigroup : SEMIGROUP_F =
functor
  (S : SEMIGROUP)
  ->
  struct
    include Magma (S)
  end

module Monoid : MONOID_F =
functor
  (M : MONOID)
  ->
  struct
    include Semigroup (M)

    let empty = Dual M.empty
  end

module Functor : FUNCTOR with type 'a t = 'a dual = struct
  type 'a t = 'a dual

  let map f (Dual a) = Dual (f a)
end

module Applicative : APPLICATIVE with type 'a t = 'a dual = struct
  include Functor

  let apply (Dual f) (Dual a) = Dual (f a)

  let pure a = Dual a
end

module Monad : MONAD with type 'a t = 'a dual = struct
  include Applicative

  let flat_map (Dual a) f = f a
end

module Magma_Any : MAGMA_ANY_F =
functor
  (M : MAGMA_ANY)
  ->
  struct
    type 'a t = 'a M.t dual

    let append (Dual a) (Dual b) = Dual (M.append b a)
  end

module Semigroup_Any : SEMIGROUP_ANY_F =
functor
  (S : SEMIGROUP_ANY)
  ->
  struct
    include Magma_Any (S)
  end

module Monoid_Any : MONOID_ANY_F =
functor
  (M : MONOID_ANY)
  ->
  struct
    include Semigroup_Any (M)

    let empty = Dual M.empty
  end

module Foldable : FOLDABLE with type 'a t = 'a dual = struct
  type 'a t = 'a dual

  let fold_left f init (Dual x) = f init x

  and fold_right f init (Dual x) = f x init

  module Fold = struct
    let fold_map f (Dual x) = f x
  end

  module Fold_Map (M : MONOID) = struct
    include Fold
  end

  module Fold_Map_Any (M : MONOID_ANY) = struct
    include Fold
  end

  module Fold_Map_Plus (P : PLUS) = struct
    include Fold
  end
end

module Traversable : TRAVERSABLE_F =
functor
  (A : APPLICATIVE)
  ->
  struct
    type 'a t = 'a dual

    and 'a applicative_t = 'a A.t

    include (Functor : FUNCTOR with type 'a t := 'a t)

    include (Foldable : FOLDABLE with type 'a t := 'a t)

    module I = Infix.Functor (A)

    let traverse f x =
      let open I in
      match x with
      | Dual x' -> (fun x -> Dual x) <$> f x'

    let sequence x =
      let open I in
      match x with
      | Dual x' -> (fun x -> Dual x) <$> x'
  end

module Infix = struct
  include Infix.Monad (Monad)
end