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} *)