From a64d7602a375f17005f55b9ecc333694cef1ace5 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 2 Jul 2014 13:22:21 +0200
Subject: [PATCH] CCError: retry and choose combinators

---
 core/CCError.ml  | 39 +++++++++++++++++++++++++++++++++++++++
 core/CCError.mli | 13 +++++++++++++
 2 files changed, 52 insertions(+)

diff --git a/core/CCError.ml b/core/CCError.ml
index 17696f23..9fe54a90 100644
--- a/core/CCError.ml
+++ b/core/CCError.ml
@@ -129,6 +129,37 @@ let fold_seq f acc seq =
 
 let fold_l f acc l = fold_seq f acc (fun k -> List.iter k l)
 
+(** {2 Misc} *)
+
+let choose l =
+  let rec _find = function
+    | [] -> raise Not_found
+    | ((`Ok _) as res) :: _ -> res
+    | (`Error _) :: l' -> _find l'
+  in
+  try _find l
+  with Not_found ->
+    let buf = Buffer.create 32 in
+    (* print errors on the buffer *)
+    let rec print buf l = match l with
+      | `Ok _ :: _ -> assert false
+      | (`Error x)::((y::xs) as l) ->
+        Buffer.add_string buf x;
+        Buffer.add_string buf ", ";
+        print buf l
+      | `Error x::[] -> Buffer.add_string buf x
+      | [] -> ()
+    in
+    Printf.bprintf buf "CCError.choice failed: [%a]" print l;
+    fail (Buffer.contents buf)
+
+let rec retry n f = match n with
+  | 0 -> fail "retry failed"
+  | _ ->
+      match f () with
+      | `Ok _ as res -> res
+      | `Error _ -> retry (n-1) f
+
 (** {2 Monadic Operations} *)
 
 module type MONAD = sig
@@ -149,6 +180,14 @@ module Traverse(M : MONAD) = struct
   let fold_m f acc e = match e with
     | `Error s -> M.return acc
     | `Ok x -> f acc x >>= fun y -> M.return y
+
+  let rec retry_m n f = match n with
+    | 0 -> M.return (fail "retry failed")
+    | _ ->
+        let x = f () in
+        x >>= function
+        | `Ok _ -> x
+        | `Error _ -> retry_m (n-1) f
 end
 
 (** {2 Conversions} *)
diff --git a/core/CCError.mli b/core/CCError.mli
index f2b0834a..7504356f 100644
--- a/core/CCError.mli
+++ b/core/CCError.mli
@@ -89,6 +89,17 @@ val fold_l : ('b -> 'a -> 'b t) -> 'b -> 'a list -> 'b t
 
 val fold_seq : ('b -> 'a -> 'b t) -> 'b -> 'a sequence -> 'b t
 
+(** {2 Misc} *)
+
+val choose : 'a t list -> 'a t
+(** [choose l] selects a member of [l] that is a [`Ok _] value,
+    or returns [`Error msg] otherwise, where [msg] is obtained by
+    combining the error messages of all elements of [l] *)
+
+val retry : int -> (unit -> 'a t) -> 'a t
+(** [retry n f] calls [f] at most [n] times, returning the first result
+    of [f ()] that doesn't fail. If [f] fails [n] times, [retry n f] fails. *)
+
 (** {2 Monadic Operations} *)
 module type MONAD = sig
   type 'a t
@@ -102,6 +113,8 @@ module Traverse(M : MONAD) : sig
   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
+
+  val retry_m : int -> (unit -> 'a t M.t) -> 'a t M.t
 end
 
 (** {2 Conversions} *)