Shell: add Error_monad.{iter2_p,iteri2_p}

This commit is contained in:
Grégoire Henry 2017-11-19 14:59:47 +01:00 committed by Grégoire
parent 06a6cf5b9a
commit 3c06879deb
2 changed files with 33 additions and 0 deletions

View File

@ -312,6 +312,37 @@ module Make() = struct
| Ok (), Error exn | Ok (), Error exn
| Error exn, Ok () -> Lwt.return (Error exn) | Error exn, Ok () -> Lwt.return (Error exn)
let rec iter2_p f l1 l2 =
match l1, l2 with
| [], [] -> return ()
| [], _ | _, [] -> invalid_arg "Error_monad.iter2_p"
| x1 :: l1 , x2 :: l2 ->
let tx = f x1 x2 and tl = iter2_p f l1 l2 in
tx >>= fun tx_res ->
tl >>= fun tl_res ->
match tx_res, tl_res with
| Ok (), Ok () -> Lwt.return (Ok ())
| Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
| Ok (), Error exn
| Error exn, Ok () -> Lwt.return (Error exn)
let iteri2_p f l1 l2 =
let rec iteri2_p i f l1 l2 =
match l1, l2 with
| [], [] -> return ()
| [], _ | _, [] -> invalid_arg "Error_monad.iteri2_p"
| x1 :: l1 , x2 :: l2 ->
let tx = f i x1 x2 and tl = iteri2_p (i+1) f l1 l2 in
tx >>= fun tx_res ->
tl >>= fun tl_res ->
match tx_res, tl_res with
| Ok (), Ok () -> Lwt.return (Ok ())
| Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
| Ok (), Error exn
| Error exn, Ok () -> Lwt.return (Error exn)
in
iteri2_p 0 f l1 l2
let rec fold_left_s f init l = let rec fold_left_s f init l =
match l with match l with
| [] -> return init | [] -> return init

View File

@ -118,6 +118,8 @@ module type S = sig
(** A {!List.iter} in the monad *) (** A {!List.iter} in the monad *)
val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
val iter_p : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t val iter_p : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
val iter2_p : ('a -> 'b -> unit tzresult Lwt.t) -> 'a list -> 'b list -> unit tzresult Lwt.t
val iteri2_p : (int -> 'a -> 'b -> unit tzresult Lwt.t) -> 'a list -> 'b list -> unit tzresult Lwt.t
(** A {!List.map} in the monad *) (** A {!List.map} in the monad *)
val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t