package preface

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

Source file choice.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
module type LAWS = sig
  type ('a, 'b) t

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

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

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

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

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

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

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

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

module For (C : Preface_specs.CHOICE) :
  LAWS with type ('a, 'b) t := ('a, 'b) C.t = struct
  open Law
  include Profunctor.For (C)

  let choice_1 () =
    let lhs x = C.left x
    and rhs x = C.dimap Util.swap_either Util.swap_either (C.right x) in

    law ("left" =~ lhs) ("dimap swap swap % right" =~ rhs)
  ;;

  let choice_2 () =
    let lhs x = C.map_snd Either.left x
    and rhs x = C.contramap_fst Either.left (C.left x) in

    law
      ("map_snd Either.left" =~ lhs)
      ("contramap_fst Either.left % left" =~ rhs)
  ;;

  let choice_3 () =
    let lhs f x = C.contramap_fst (Util.Fun.Choice.right f) (C.left x)
    and rhs f x = C.map_snd (Util.Fun.Choice.right f) (C.left x) in

    law
      ("contramap_fst (Fun.Choice.right f) % left" =~ lhs)
      ("map_snd (Fun.Choice.right f) % left" =~ rhs)
  ;;

  let choice_4 () =
    let lhs x = C.left (C.left x)
    and rhs x = C.dimap Util.assoc_either Util.unassoc_either (C.left x) in

    law ("left % left" =~ lhs) ("dimap assoc unassoc % left" =~ rhs)
  ;;

  let choice_5 () =
    let lhs x = C.right x
    and rhs x = C.dimap Util.swap_either Util.swap_either (C.left x) in

    law ("right" =~ lhs) ("dimap swap swap % left" =~ rhs)
  ;;

  let choice_6 () =
    let lhs x = C.map_snd Either.right x
    and rhs x = C.contramap_fst Either.right (C.right x) in

    law
      ("map_snd Either.right" =~ lhs)
      ("contramap_fst Either.right % right" =~ rhs)
  ;;

  let choice_7 () =
    let lhs f x = C.contramap_fst (Util.Fun.Choice.left f) (C.right x)
    and rhs f x = C.map_snd (Util.Fun.Choice.left f) (C.right x) in

    law
      ("contramap_fst (Fun.Choice.left f) % right" =~ lhs)
      ("map_snd (Fun.Choice.left f) % right" =~ rhs)
  ;;

  let choice_8 () =
    let lhs x = C.right (C.right x)
    and rhs x = C.dimap Util.unassoc_either Util.assoc_either (C.right x) in

    law ("right % right" =~ lhs) ("dimap unassoc assoc % left" =~ 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