package preface

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

Source file either.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
open Preface_core.Fun
include Preface_core.Shims.Either

let pure x = Right x

module Bifunctor = Preface_make.Bifunctor.Via_bimap (struct
  type nonrec ('a, 'b) t = ('a, 'b) t

  let bimap f g = function Left x -> Left (f x) | Right x -> Right (g x)
end)

module Functor (T : Preface_specs.Types.T0) =
Preface_make.Functor.Via_map (struct
  type nonrec 'a t = (T.t, 'a) t

  let map f x = Bifunctor.bimap id f x
end)

let traverse_aux pure map f = function
  | Left x -> pure (Left x)
  | Right x -> map right (f x)
;;

module Alt (T : Preface_specs.Types.T0) =
  Preface_make.Alt.Over_functor
    (Functor
       (T))
       (struct
         type nonrec 'a t = (T.t, 'a) t

         let combine x y = (match (x, y) with (Left _, a) -> a | (a, _) -> a)
       end)

module Applicative (T : Preface_specs.Types.T0) = struct
  module A = Preface_make.Applicative.Via_apply (struct
    module F = Functor (T)

    type nonrec 'a t = (T.t, 'a) t

    let pure = pure

    let apply fa xa =
      (match (fa, xa) with (Right f, x) -> F.map f x | (Left x, _) -> Left x)
    ;;
  end)

  module T (A : Preface_specs.APPLICATIVE) =
    Preface_make.Traversable.Over_applicative
      (A)
      (struct
        type 'a t = 'a A.t

        type 'a iter = (T.t, 'a) Bifunctor.t

        let traverse f x = traverse_aux A.pure A.map f x
      end)

  include Preface_make.Traversable.Join_with_applicative (A) (T)
end

module Monad (T : Preface_specs.Types.T0) = struct
  module M = Preface_make.Monad.Via_bind (struct
    type nonrec 'a t = (T.t, 'a) t

    let return = pure

    let bind f = function Right x -> f x | Left x -> Left x
  end)

  module T (M : Preface_specs.MONAD) =
    Preface_make.Traversable.Over_monad
      (M)
      (struct
        type 'a t = 'a M.t

        type 'a iter = (T.t, 'a) Bifunctor.t

        let traverse f x = traverse_aux M.return M.map f x
      end)

  include Preface_make.Traversable.Join_with_monad (M) (T)
end

module Foldable (T : Preface_specs.Types.T0) =
Preface_make.Foldable.Via_fold_right (struct
  type nonrec 'a t = (T.t, 'a) t

  let fold_right f x acc = (match x with Left _ -> acc | Right v -> f v acc)
end)

let equal f g left right =
  match (left, right) with
  | (Left x, Left y) -> f x y
  | (Right x, Right y) -> g x y
  | _ -> false
;;

let pp f g formater = function
  | Left x -> Format.fprintf formater "Left (%a)" f x
  | Right x -> Format.fprintf formater "Right (%a)" g x
;;
OCaml

Innovation. Community. Security.