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] 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