Merge pull request #349 from c-cube/cceither

feat: add CCEither module

src/core/CCEither.ml

@@ -0,0 +1,73 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+type 'a iter = ('a -> unit) -> unit
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Format.formatter -> 'a -> unit
+
+(** {2 Basics} *)
+
+include CCShimsEither_
+
+let left l = Left l
+
+let right r = Right r
+
+let is_left = function Left _ -> true | Right _ -> false
+
+(*$=
+  (is_left (Left 1)) (true)
+  (is_left (Right 1)) (false)
+*)
+
+let is_right = function Left _ -> false | Right _ -> true
+
+(*$=
+  (is_right (Left 1)) (false)
+  (is_right (Right 1)) (true)
+*)
+
+let find_left = function Left l -> Some l | Right _ -> None
+
+(*$=
+  (find_left (Left 1)) (Some 1)
+  (find_left (Right 1)) (None)
+*)
+
+let find_right = function Left _ -> None | Right r -> Some r
+
+(*$=
+  (find_right (Left 1)) (None)
+  (find_right (Right 1)) (Some 1)
+*)
+
+let map_left f = function Left l -> Left (f l) | Right r -> Right r
+
+let map_right f = function Left l -> Left l | Right r -> Right (f r)
+
+let map ~left ~right = function Left l -> Left (left l) | Right r -> Right (right r)
+
+let fold ~left ~right = function Left l -> left l | Right r -> right r
+
+let iter = fold
+
+let for_all = fold
+
+let equal ~left ~right e1 e2 =
+  match e1, e2 with
+    | (Left l1, Left l2) -> left l1 l2
+    | (Right r1, Right r2) -> right r1 r2
+    | _ -> false
+
+let compare ~left ~right e1 e2 =
+  match e1, e2 with
+    | (Left _, Right _) -> -1
+    | (Right _, Left _) -> 1
+    | (Left l1, Left l2) -> left l1 l2
+    | (Right r1, Right r2) -> right r1 r2
+
+(** {2 IO} *)
+
+let pp ~left ~right fmt = function
+  | Left l -> Format.fprintf fmt "Left@ (@[%a@])" left l
+  | Right r -> Format.fprintf fmt "Right@ (@[%a@])" right r

src/core/CCEither.mli

@@ -0,0 +1,66 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Either Monad}
+
+    Module that is compatible with Either form OCaml 4.12 but can be use with any
+    ocaml version compatible with container
+
+    @since NEXT_RELEASE
+*)
+
+type 'a iter = ('a -> unit) -> unit
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Format.formatter -> 'a -> unit
+
+(** {2 Basics} *)
+
+
+include module type of CCShimsEither_
+
+val left : 'a -> ('a, 'b) t
+(** [left l] is [Left l] *)
+
+val right : 'b -> ('a, 'b) t
+(** [right r] is [Right r] *)
+
+val is_left : ('a, 'b) t -> bool
+(** [is_left x] checks if [x = Left _] *)
+
+val is_right : ('a, 'b) t -> bool
+(** [is_right x] checks if [x = Right _] *)
+
+val find_left : ('a, 'b) t -> 'a option
+(** [find_left x] returns [l] if [x = Left l] and [None] otherwise. *)
+
+val find_right : ('a, 'b) t -> 'b option
+(** [find_right x] returns [r] if [x = Left r] and [None] otherwise. *)
+
+val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t
+(** Map of the Left variant. *)
+
+val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t
+(** Map of the Right variant. *)
+
+val map : left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t
+(** Map using [left] or [right]. *)
+
+val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c
+(** Fold using [left] or [right]. *)
+
+val iter : left:('a -> unit) -> right:('b -> unit) -> ('a, 'b) t -> unit
+(** Iter using [left] or [right]. *)
+
+val for_all : left:('a -> bool) -> right:('b -> bool) -> ('a, 'b) t -> bool
+(** Check some property on [Left] or [Right] variant. *)
+
+val equal : left:('a -> 'a -> bool) -> right:('b -> 'b -> bool) ->
+  ('a, 'b) t -> ('a, 'b) t -> bool
+
+val compare : left:('a -> 'a -> int) -> right:('b -> 'b -> int) ->
+  ('a, 'b) t -> ('a, 'b) t -> int
+
+(** {2 IO} *)
+
+val pp : left:('a printer) -> right:('b printer) -> ('a, 'b) t printer
+(** Pretty printer. *)

src/core/containers.ml

@@ -7,6 +7,7 @@ module Array = CCArray
 module Bool = CCBool
 module Char = CCChar
 module Equal = CCEqual
+module Either = CCEither
 module Float = CCFloat
 module Format = CCFormat
 module Fun = CCFun

src/core/containersLabels.ml

@@ -7,6 +7,7 @@ module Array = CCArrayLabels
 module Bool = CCBool
 module Char = CCChar
 module Equal = CCEqualLabels
+module Either = CCEither
 module Float = CCFloat
 module Format = CCFormat
 module Fun = CCFun

src/core/dune

@@ -7,7 +7,7 @@
 (rule
  (targets CCShims_.ml CCShimsList_.ml CCShimsFun_.ml CCShimsFun_.mli
    CCShimsArray_.ml CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsMkLetList_.ml
-   CCShimsArrayLabels_.ml CCShimsInt_.ml)
+   CCShimsArrayLabels_.ml CCShimsInt_.ml CCShimsEither_.ml)
  (deps ./mkshims.exe)
  (action
   (run ./mkshims.exe)))

src/core/mkshims.ml

@@ -255,6 +255,14 @@ let popcount =
   if Sys.int_size = 63 then popcount_64_ else popcount
 "
 
+let shims_either_pre_412 = "
+  type ('a, 'b) t = Left of 'a | Right of 'b
+  "
+
+let shims_either_post_412 = "
+  type ('a, 'b) t = ('a, 'b) Either.t = Left of 'a | Right of 'b
+"
+
 let () =
   C.main ~name:"mkshims" (fun c ->
     let version = C.ocaml_config_var_exn c "version" in
@@ -286,4 +294,7 @@ let () =
     write_file "CCShimsInt_.ml"
       ((if (major, minor) >= (4,8) then shims_int_post_408 else shims_int_pre_408)
       ^ if int_size=63 then shims_int_64bit else shims_int_non_64bit);
+    write_file "CCShimsEither_.ml"
+      (if (major, minor) >= (4,12) then shims_either_post_412
+       else shims_either_pre_412);
   )