diff --git a/core/CCError.ml b/core/CCError.ml index 6d92b531..17696f23 100644 --- a/core/CCError.ml +++ b/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 diff --git a/core/CCError.mli b/core/CCError.mli index 76a49065..f2b0834a 100644 --- a/core/CCError.mli +++ b/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} *)