package preface

  1. Overview
  2. Docs
package preface
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.

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