more combinators in CCError

This commit is contained in:
Simon Cruanes 2014-06-27 14:46:30 +02:00
parent 6ae3e5b283
commit c340ad3358
2 changed files with 47 additions and 2 deletions

View file

@ -73,6 +73,10 @@ let compare cmp a b = match a, b with
| _, `Ok _ -> -1 | _, `Ok _ -> -1
| `Error s, `Error s' -> String.compare s s' | `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} *) (** {2 Collections} *)
let map_l f l = 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) 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} *) (** {2 Conversions} *)
let to_opt = function let to_opt = function

View file

@ -59,13 +59,32 @@ val equal : 'a equal -> 'a t equal
val compare : 'a ord -> 'a t ord 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} *) (** {2 Collections} *)
val map_l : ('a -> 'b t) -> 'a list -> 'b list t 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} *) (** {2 Conversions} *)