package preface

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

Source file indexed_selective.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
151
152
153
154
155
156
157
158
159
160
module type LAWS = sig
  type ('a, 'index) t

  include Indexed_applicative.LAWS with type ('a, 'index) t := ('a, 'index) t

  val selective_1 :
    unit -> ((('a, 'a) Either.t, 'index) t, ('a, 'index) t) Law.t

  val selective_2 :
       unit
    -> ( ('a, 'b) Either.t
       , ('a -> 'b, 'index) t -> ('a -> 'b, 'index) t -> ('b, 'index) t )
       Law.t

  val selective_3 :
       unit
    -> ( (('a, 'b) Either.t, 'index) t
       ,    (('c, 'a -> 'b) Either.t, 'index) t
         -> ('c -> 'a -> 'b, 'index) t
         -> ('b, 'index) t )
       Law.t

  val selective_4 :
       unit
    -> ( 'a -> 'b
       , (('c, 'a) Either.t, 'index) t -> ('c -> 'a, 'index) t -> ('b, 'index) t
       )
       Law.t

  val selective_5 :
       unit
    -> ( 'a -> 'b
       , (('a, 'c) Either.t, 'index) t -> ('b -> 'c, 'index) t -> ('c, 'index) t
       )
       Law.t

  val selective_6 :
       unit
    -> ( 'a -> 'b -> 'c
       , (('b, 'c) Either.t, 'index) t -> ('a, 'index) t -> ('c, 'index) t )
       Law.t

  val selective_7 :
    unit -> ((('a, 'b) Either.t, 'index) t, ('a -> 'b) -> ('b, 'index) t) Law.t
end

module type LAWS_RIGID = sig
  include LAWS

  val selective_8 :
    unit -> (('a -> 'b, 'index) t, ('a, 'index) t -> ('b, 'index) t) Law.t

  val selective_9 :
       unit
    -> ( ('a, 'index) t
       , (('b, 'c) Either.t, 'index) t -> ('b -> 'c, 'index) t -> ('c, 'index) t
       )
       Law.t
end

module For (S : Preface_specs.INDEXED_SELECTIVE) :
  LAWS with type ('a, 'index) t := ('a, 'index) S.t = struct
  open Law
  open Preface_core.Fun
  include Indexed_applicative.For (S)

  let selective_1 () =
    let lhs x = S.(x <*? pure id)
    and rhs x = S.(Either.fold ~left:id ~right:id <$> x) in

    law ("x <*? pure Fun.id" =~ lhs) ("Either.case Fun.id Fun.id <$> x" =~ rhs)
  ;;

  let selective_2 () =
    let lhs x y z = S.(pure x <*? Infix.(replace () y *> z))
    and rhs x y z =
      S.(replace () Infix.(pure x <*? y) *> Infix.(pure x <*? z))
    in

    law
      ("pure x <*? (y *> z)" =~ lhs)
      ("(pure x <*? y) *> (pure x <*? z)" =~ rhs)
  ;;

  let selective_3 () =
    let lhs x y z = S.(x <*? (y <*? z))
    and rhs x y z =
      let f a = Either.map_right Either.right a in
      let g x a = Either.map ~left:(fun x -> (x, a)) ~right:(fun f -> f a) x in
      let h f (a, b) = f a b in
      let open S in
      let fst = f <$> x
      and snd = g <$> y
      and trd = h <$> z in
      fst <*? snd <*? trd
    in

    law ("x <*? (y <*? z)" =~ lhs)
      ( "(Either.(map_right right) <$> x) <*? ((fun x a -> Either.map \
         ~left:(fun x -> (x, a)) ~right:(fun f -> f a) x) <$> y) <*? (uncurry \
         <$> z)"
      =~ rhs )
  ;;

  let selective_4 () =
    let lhs f x y = S.(f <$> select x y)
    and rhs f x y = S.(select (Either.map_right f <$> x) (( % ) f <$> y)) in

    law
      ("f <$> select x y" =~ lhs)
      ("select (Either.map_right f <$> x) (map f <$> y)" =~ rhs)
  ;;

  let selective_5 () =
    let lhs f x y = S.(select (Either.map_left f <$> x) y)
    and rhs f x y = S.(select x (( %> ) f <$> y)) in

    law
      ("select (Either.map_left f <$> x) y" =~ lhs)
      ("select x ((%>) f) <$> y)" =~ rhs)
  ;;

  let selective_6 () =
    let lhs f x y = S.(select x (f <$> y))
    and rhs f x y =
      S.(select (Either.map_left (flip f) <$> x) (( |> ) <$> y))
    in

    law
      ("select x (f <$> y)" =~ lhs)
      ("select (Either.map_left (flip f) <$> x) ((|>) <$> y)" =~ rhs)
  ;;

  let selective_7 () =
    let lhs x y = S.(x <*? pure y)
    and rhs x y = S.(Either.fold ~left:y ~right:id <$> x) in

    law ("x <*? pure y" =~ lhs) ("Either.case y Fun.id <$> x" =~ rhs)
  ;;
end

module For_rigid (S : Preface_specs.INDEXED_SELECTIVE) :
  LAWS_RIGID with type ('a, 'index) t := ('a, 'index) S.t = struct
  open Law
  include For (S)

  let selective_8 () =
    let lhs f x = S.apply f x
    and rhs f x = S.(select (map Either.left f) (map ( |> ) x)) in

    law ("f <*> x" =~ lhs) ("select (map Either.left f) (map ( |> ) x" =~ rhs)
  ;;

  let selective_9 () =
    let lhs x y z = S.(Infix.(ignore <$> x) *> Infix.(y <*? z))
    and rhs x y z = S.(Infix.((ignore <$> x) *> y) <*? z) in

    law ("x *> (y <*? z)" =~ lhs) ("(x *> y) <*? z" =~ rhs)
  ;;
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct