From c340ad33581cda2cde3eb5105bf82a5e539d6f4f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Jun 2014 14:46:30 +0200
Subject: [PATCH 1/3] more combinators in CCError

---
 core/CCError.ml  | 26 ++++++++++++++++++++++++++
 core/CCError.mli | 23 +++++++++++++++++++++--
 2 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/core/CCError.ml b/core/CCError.ml
index 6d92b531..8418f21f 100644
--- a/core/CCError.ml
+++ b/core/CCError.ml
@@ -73,6 +73,10 @@ 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 Collections} *)
 
 let map_l f l =
@@ -99,6 +103,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
diff --git a/core/CCError.mli b/core/CCError.mli
index 76a49065..49462101 100644
--- a/core/CCError.mli
+++ b/core/CCError.mli
@@ -59,13 +59,32 @@ 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 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} *)
 

From e6dd5db678f14eacf151de629897279b6b5b8f61 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Jun 2014 15:25:34 +0200
Subject: [PATCH 2/3] CCError.map2

---
 core/CCError.ml  | 4 ++++
 core/CCError.mli | 4 ++++
 2 files changed, 8 insertions(+)

diff --git a/core/CCError.ml b/core/CCError.ml
index 8418f21f..da7f7888 100644
--- a/core/CCError.ml
+++ b/core/CCError.ml
@@ -49,6 +49,10 @@ 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
diff --git a/core/CCError.mli b/core/CCError.mli
index 49462101..61e8e98a 100644
--- a/core/CCError.mli
+++ b/core/CCError.mli
@@ -47,6 +47,10 @@ val of_exn : exn -> 'a t
 
 val map : ('a -> 'b) -> '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 flat_map : ('a -> 'b t) -> 'a t -> 'b t
 
 val guard : (unit -> 'a) -> 'a t

From f64002b05329f09ee07f70d047bbe96ee0eafe75 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Jun 2014 15:33:57 +0200
Subject: [PATCH 3/3] applicative and lifting operators for CCError

---
 core/CCError.ml  | 32 +++++++++++++++++++++++++++-----
 core/CCError.mli | 18 ++++++++++++++++--
 2 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/core/CCError.ml b/core/CCError.ml
index da7f7888..17696f23 100644
--- a/core/CCError.ml
+++ b/core/CCError.ml
@@ -57,11 +57,6 @@ 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
@@ -81,6 +76,33 @@ 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 =
diff --git a/core/CCError.mli b/core/CCError.mli
index 61e8e98a..f2b0834a 100644
--- a/core/CCError.mli
+++ b/core/CCError.mli
@@ -53,8 +53,6 @@ val map2 : ('a -> 'b) -> (string -> string) -> 'a t -> 'b t
 
 val flat_map : ('a -> 'b t) -> 'a t -> 'b t
 
-val guard : (unit -> 'a) -> 'a t
-
 val (>|=) : 'a t -> ('a -> 'b) -> 'b t
 
 val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
@@ -67,6 +65,22 @@ 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