Merge pull request #927 from MisterDA/lwt_result

Get `Lwt_result` closer to `Stdlib.Result`

Author: smorimoto

CHANGES

@@ -8,6 +8,7 @@
 ====== Additions ======
 
   * In the Lwt_io module, add `?cloexec:bool` optional arguments to functions that create file descriptors (`pipe`). The `?cloexec` argument is simply forwarded to the wrapped Lwt_unix function. (#872, #911, Antonin Décimo)
+  * Add Lwt_result.error, Lwt_result.iter, and Lwt_result.iter_error for consistency with Stdlib. (#927, Antonin Décimo)
 
 ====== Fixes ======
 
@@ -16,6 +17,10 @@
   * Lwt.pick and Lwt.choose select preferentially failed promises as per
   documentation (#856, #874, Raman Varabets)
 
+====== Deprecations ======
+
+  * Alias Lwt_result.map_err and Lwt_result.bind_lwt_err to Lwt_result.map_error and Lwt_result.bind_lwt_error for consistency with Stdlib. (#927, Antonin Décimo)
+
 ===== 5.5.0 =====
 
 ====== Deprecations ======

src/core/lwt_result.ml

@@ -20,6 +20,7 @@ let fail e = Lwt.return (Error e)
 
 let lift = Lwt.return
 let ok x = Lwt.map (fun y -> Ok y) x
+let error x = Lwt.map (fun y -> Error y) x
 
 let map f e =
   Lwt.map
@@ -28,12 +29,13 @@ let map f e =
       | Ok x -> Ok (f x))
     e
 
-let map_err f e =
+let map_error f e =
   Lwt.map
     (function
       | Error e -> Error (f e)
       | Ok x -> Ok x)
     e
+let map_err f e = map_error f e
 
 let catch e =
   Lwt.catch
@@ -65,11 +67,12 @@ let bind_result e f =
       | Ok x -> f x)
     e
 
-let bind_lwt_err e f =
+let bind_lwt_error e f =
   Lwt.bind e
     (function
       | Error e -> Lwt.bind (f e) fail
       | Ok x -> return x)
+let bind_lwt_err e f = bind_lwt_error e f
 
 let both a b =
   let s = ref None in
@@ -78,7 +81,7 @@ let both a b =
     | None -> s:= Some e
     | Some _ -> ()
   in
-  let (a,b) = map_err set_once a,map_err set_once b in
+  let (a,b) = map_error set_once a,map_error set_once b in
   let some_assert = function
     | None -> assert false
     | Some e -> Error e
@@ -87,10 +90,22 @@ let both a b =
     (function
       | Ok x, Ok y -> Ok (x,y)
       | Error _, Ok _
-      | Ok _,Error _ 
+      | Ok _,Error _
       | Error _, Error _ -> some_assert !s)
     (Lwt.both a b)
 
+let iter f r =
+  Lwt.bind r
+    (function
+      | Ok x -> f x
+      | Error _ -> Lwt.return_unit)
+
+let iter_error f r =
+  Lwt.bind r
+    (function
+      | Error e -> f e
+      | Ok _ -> Lwt.return_unit)
+
 module Infix = struct
   let (>>=) = bind
   let (>|=) e f = map f e

src/core/lwt_result.mli

@@ -20,6 +20,9 @@ val lift : ('a, 'b) result -> ('a, 'b) t
 
 val ok : 'a Lwt.t -> ('a, _) t
 
+val error : 'b Lwt.t -> (_, 'b) t
+(** @since 5.6.0  *)
+
 val catch : 'a Lwt.t -> ('a, exn) t
 (** [catch x] behaves like [return y] if [x] evaluates to [y],
     and like [fail e] if [x] raises [e] *)
@@ -31,13 +34,15 @@ val get_exn : ('a, exn) t -> 'a Lwt.t
 
 val map : ('a -> 'b) -> ('a,'e) t -> ('b,'e) t
 
-val map_err : ('e1 -> 'e2) -> ('a,'e1) t -> ('a,'e2) t
+val map_error : ('e1 -> 'e2) -> ('a,'e1) t -> ('a,'e2) t
+(** @since 5.6.0 *)
 
 val bind : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
 
 val bind_lwt : ('a,'e) t -> ('a -> 'b Lwt.t) -> ('b,'e) t
 
-val bind_lwt_err : ('a,'e1) t -> ('e1 -> 'e2 Lwt.t) -> ('a,'e2) t
+val bind_lwt_error : ('a,'e1) t -> ('e1 -> 'e2 Lwt.t) -> ('a,'e2) t
+(** @since 5.6.0 *)
 
 val bind_result : ('a,'e) t -> ('a -> ('b,'e) result) -> ('b,'e) t
 
@@ -49,6 +54,19 @@ val both : ('a,'e) t -> ('b,'e) t -> ('a * 'b,'e) t
     If both [p_1] and [p_2] resolve with [Error _], the promise is resolved with
     the error that occurred first. *)
 
+val iter : ('a -> unit Lwt.t) -> ('a, 'e) t -> unit Lwt.t
+(** [iter f r] is [f v] if [r] is a promise resolved with [Ok v], and
+    {!Lwt.return_unit} otherwise.
+
+    @since Lwt 5.6.0
+*)
+
+val iter_error : ('e -> unit Lwt.t) -> ('a, 'e) t -> unit Lwt.t
+(** [iter_error f r] is [f v] if [r] is a promise resolved with [Error v],
+    and {!Lwt.return_unit} otherwise.
+
+    @since Lwt 5.6.0
+*)
 
 module Infix : sig
   val (>|=) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
@@ -95,3 +113,11 @@ module Syntax : sig
 end
 
 include module type of Infix
+
+(** {3 Deprecated} *)
+
+val map_err : ('e1 -> 'e2) -> ('a,'e1) t -> ('a,'e2) t [@@deprecated "Alias to map_error"]
+(** @deprecated Alias to [map_error] since 5.6.0. *)
+
+val bind_lwt_err : ('a,'e1) t -> ('e1 -> 'e2 Lwt.t) -> ('a,'e2) t [@@deprecated "Alias to bind_lwt_error"]
+(** @deprecated Alias to [bind_lwt_error] since 5.6.0. *)

test/core/test_lwt_result.ml

@@ -38,17 +38,17 @@ let suite =
          Lwt.return (Lwt_result.map ((+) 1) x = x)
       );
 
-    test "map_err"
+    test "map_error"
       (fun () ->
          let x = Lwt_result.return 0 in
-         Lwt.return (Lwt_result.map_err ((+) 1) x = x)
+         Lwt.return (Lwt_result.map_error ((+) 1) x = x)
       );
 
-    test "map_err, error case"
+    test "map_error, error case"
       (fun () ->
          let x = Lwt_result.fail 0 in
          let correct = Lwt_result.fail 1 in
-         Lwt.return (Lwt_result.map_err ((+) 1) x = correct)
+         Lwt.return (Lwt_result.map_error ((+) 1) x = correct)
       );
 
     test "bind"
@@ -72,6 +72,12 @@ let suite =
          Lwt.return (Lwt_result.ok x = Lwt_result.return 0)
       );
 
+    test "error"
+      (fun () ->
+        let x = Lwt.return 0 in
+        Lwt.return (Lwt_result.error x = Lwt_result.fail 0)
+      );
+
     test "catch"
       (fun () ->
          let x = Lwt.return 0 in
@@ -110,18 +116,18 @@ let suite =
          Lwt.return (Lwt_result.bind_lwt x f = Lwt_result.fail 0)
       );
 
-    test "bind_lwt_err"
+    test "bind_lwt_error"
       (fun () ->
          let x = Lwt_result.return 0 in
          let f y = Lwt.return (y + 1) in
-         Lwt.return (Lwt_result.bind_lwt_err x f = Lwt_result.return 0)
+         Lwt.return (Lwt_result.bind_lwt_error x f = Lwt_result.return 0)
       );
 
-    test "bind_lwt_err, error case"
+    test "bind_lwt_error, error case"
       (fun () ->
          let x = Lwt_result.fail 0 in
          let f y = Lwt.return (y + 1) in
-         Lwt.return (Lwt_result.bind_lwt_err x f = Lwt_result.fail 1)
+         Lwt.return (Lwt_result.bind_lwt_error x f = Lwt_result.fail 1)
       );
 
     test "bind_result"
@@ -192,6 +198,42 @@ let suite =
          Lwt.bind p (fun x -> Lwt.return (x = Result.Error 1))
       );
 
+    test "iter"
+      (fun () ->
+        let x = Lwt_result.return 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual = 2))
+      );
+
+    test "iter, error case"
+      (fun () ->
+        let x = Lwt_result.fail 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual <> 2))
+      );
+
+    test "iter_error"
+      (fun () ->
+        let x = Lwt_result.fail 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter_error (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual = 2))
+      );
+
+    test "iter_error, success case"
+      (fun () ->
+        let x = Lwt_result.return 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter_error (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual <> 2))
+      );
+
     test "let*"
       (fun () ->
         let p1, r1 = Lwt.wait () in