diff --git a/src/core/CCEither.ml b/src/core/CCEither.ml new file mode 100644 index 00000000..6fd3b7e0 --- /dev/null +++ b/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 diff --git a/src/core/CCEither.mli b/src/core/CCEither.mli new file mode 100644 index 00000000..9ec879ba --- /dev/null +++ b/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. *) diff --git a/src/core/containers.ml b/src/core/containers.ml index 1898cc0b..41b1b049 100644 --- a/src/core/containers.ml +++ b/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 diff --git a/src/core/containersLabels.ml b/src/core/containersLabels.ml index 50356298..191ca597 100644 --- a/src/core/containersLabels.ml +++ b/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 diff --git a/src/core/dune b/src/core/dune index 68135ac9..ec28aac7 100644 --- a/src/core/dune +++ b/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))) diff --git a/src/core/mkshims.ml b/src/core/mkshims.ml index 73292c7c..c76a0273 100644 --- a/src/core/mkshims.ml +++ b/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); )