merge from master

core/CCError.ml

@@ -49,15 +49,14 @@ let map f e = match e with
   | `Ok x -> `Ok (f x)
   | `Error s -> `Error s
 
+let map2 f g e = match e with
+  | `Ok x -> `Ok (f x)
+  | `Error s -> `Error (g s)
+
 let flat_map f e = match e with
   | `Ok x -> f x
   | `Error s -> `Error s
 
-let guard f =
-  try
-    return (f ())
-  with e -> of_exn e
-
 let (>|=) e f = map f e
 
 let (>>=) e f = flat_map f e
@@ -73,6 +72,37 @@ let compare cmp a b = match a, b with
   | _, `Ok _ -> -1
   | `Error s, `Error s' -> String.compare s s'
 
+let fold ~success ~failure x = match x with
+  | `Ok x -> success x
+  | `Error s -> failure s
+
+(** {2 Wrappers} *)
+
+let guard f =
+  try
+    return (f ())
+  with e -> of_exn e
+
+let wrap1 f x =
+  try return (f x)
+  with e -> of_exn e
+
+let wrap2 f x y =
+  try return (f x y)
+  with e -> of_exn e
+
+let wrap3 f x y z =
+  try return (f x y z)
+  with e -> of_exn e
+
+(** {2 Applicative} *)
+
+let pure = return
+
+let (<*>) f x = match f with
+  | `Error s -> fail s
+  | `Ok f -> map f x
+
 (** {2 Collections} *)
 
 let map_l f l =
@@ -99,6 +129,28 @@ let fold_seq f acc seq =
 
 let fold_l f acc l = fold_seq f acc (fun k -> List.iter k l)
 
+(** {2 Monadic Operations} *)
+
+module type MONAD = sig
+  type 'a t
+  val return : 'a -> 'a t
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+end
+
+module Traverse(M : MONAD) = struct
+  let (>>=) = M.(>>=)
+
+  let map_m f e = match e with
+    | `Error s -> M.return (`Error s)
+    | `Ok x -> f x >>= fun y -> M.return (`Ok y)
+
+  let sequence_m m = map_m (fun x->x) m
+
+  let fold_m f acc e = match e with
+    | `Error s -> M.return acc
+    | `Ok x -> f acc x >>= fun y -> M.return y
+end
+
 (** {2 Conversions} *)
 
 let to_opt = function

core/CCError.mli

@@ -47,9 +47,11 @@ val of_exn : exn -> 'a t
 
 val map : ('a -> 'b) -> 'a t -> 'b t
 
-val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+val map2 : ('a -> 'b) -> (string -> string) -> 'a t -> 'b t
+(** Same as {!map}, but also with a function that can transform
+    the error message in case of failure *)
 
-val guard : (unit -> 'a) -> 'a t
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
 
 val (>|=) : 'a t -> ('a -> 'b) -> 'b t
 
@@ -59,13 +61,48 @@ val equal : 'a equal -> 'a t equal
 
 val compare : 'a ord -> 'a t ord
 
+val fold : success:('a -> 'b) -> failure:(string -> 'b) -> 'a t -> 'b
+(** [fold ~success ~failure e] opens [e] and, if [e = `Ok x], returns
+    [success x], otherwise [e = `Error s] and it returns [failure s]. *)
+
+(** {2 Wrappers} *)
+
+val guard : (unit -> 'a) -> 'a t
+
+val wrap1 : ('a -> 'b) -> 'a -> 'b t
+
+val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t
+
+val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd t
+
+(** {2 APplicative} *)
+
+val pure : 'a -> 'a t
+
+val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+
 (** {2 Collections} *)
 
 val map_l : ('a -> 'b t) -> 'a list -> 'b list t
 
-val fold_l : ('acc -> 'a -> 'acc t) -> 'acc -> 'a list -> 'acc t
+val fold_l : ('b -> 'a -> 'b t) -> 'b -> 'a list -> 'b t
 
-val fold_seq : ('acc -> 'a -> 'acc t) -> 'acc -> 'a sequence -> 'acc t
+val fold_seq : ('b -> 'a -> 'b t) -> 'b -> 'a sequence -> 'b t
+
+(** {2 Monadic Operations} *)
+module type MONAD = sig
+  type 'a t
+  val return : 'a -> 'a t
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+end
+
+module Traverse(M : MONAD) : sig
+  val sequence_m : 'a M.t t -> 'a t M.t
+
+  val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t
+
+  val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
+end
 
 (** {2 Conversions} *)