Merge pull request #247 from c-cube/result

add `Lwt_result`

.merlin

@@ -6,4 +6,7 @@ B _build/**
 
 
 S tests/
-S examples/
+S examples/
+
+PKG result
+PKG bytes

_oasis

@@ -106,11 +106,12 @@ Library "lwt"
     Lwt_mutex,
     Lwt_mvar,
     Lwt_pool,
+    Lwt_result,
     Lwt_sequence,
     Lwt_stream,
     Lwt_switch,
     Lwt_pqueue
-  BuildDepends: bytes
+  BuildDepends: bytes, result
   XMETADescription: Lightweight thread library for OCaml (core library)
 
 Library "lwt-log"

opam

@@ -32,6 +32,7 @@ remove: [[ "ocamlfind" "remove" "lwt" ]]
 depends: [
   "ocamlfind" {build & >= "1.5.0"}
   "base-bytes"
+  "result"
   ( "base-no-ppx" | "ppx_tools" )
   ## OASIS is not required in released version
   "oasis" {>= "0.4.4"}

src/core/lwt.ml

@@ -302,12 +302,16 @@ let safe_run_waiters sleeper state =
 (* A ['a result] is either [Return of 'a] or [Fail of exn] so it is
    covariant. *)
 
-type +'a result (* = 'a thread_state *)
-external result_of_state : 'a thread_state -> 'a result = "%identity"
-external state_of_result : 'a result -> 'a thread_state = "%identity"
+type +'a result = ('a, exn) Result.result
 
-let make_value v = result_of_state (Return v)
-let make_error e = result_of_state (Fail e)
+let state_of_result
+  : 'a result -> 'a thread_state
+  = function
+  | Result.Ok x -> Return x
+  | Result.Error e -> Fail e
+
+let make_value v = Result.Ok v
+let make_error e = Result.Error e
 
 let wakeup_result t result =
   let t = repr_rec (wakener_repr t) in
@@ -522,6 +526,8 @@ let return_some x = return (Some x)
 let return_nil = return []
 let return_true = return true
 let return_false = return false
+let return_ok x = return (Result.Ok x)
+let return_error x = return (Result.Error x)
 
 let of_result result =
   thread { state = state_of_result result }

src/core/lwt.mli

@@ -121,6 +121,16 @@ val return_true : bool t
 val return_false : bool t
   (** [return_false = return false] *)
 
+val return_ok : 'a -> ('a, _) Result.result t
+  (** [return_ok x] is similar to [return (Ok x)], to indicate success
+      explicitely..
+      @since NEXT_RELEASE *)
+
+val return_error : 'e -> (_, 'e) Result.result t
+  (** [return_error x] is similar to [return (Error x)], to indicate
+      an error explicitely
+      @since NEXT_RELEASE *)
+
 (** {2 Thread storage} *)
 
 type 'a key
@@ -295,14 +305,18 @@ val wakeup_later_exn : 'a u -> exn -> unit
 val waiter_of_wakener : 'a u -> 'a t
   (** Returns the thread associated to a wakener. *)
 
-type +'a result
-  (** Either a value of type ['a], either an exception. *)
+type +'a result = ('a, exn) Result.result
+  (** Either a value of type ['a], either an exception.
+
+      This type is defined as [('a, exn) Result.result] @since NEXT_RELEASE *)
 
 val make_value : 'a -> 'a result
-  (** [value x] creates a result containing the value [x]. *)
+  (** [value x] creates a result containing the value [x].
+      @deprecated since NEXT_RELEASE as it corresponds to {!Result.Ok} *)
 
 val make_error : exn -> 'a result
-  (** [error e] creates a result containing the exception [e]. *)
+  (** [error e] creates a result containing the exception [e].
+      @deprecated since NEXT_RELEASE as it corresponds to {!Result.Error} *)
 
 val of_result : 'a result -> 'a t
   (** Returns a thread from a result. *)

src/core/lwt_result.ml

@@ -0,0 +1,92 @@
+(* Lightweight thread library for OCaml
+ * http://www.ocsigen.org/lwt
+ * Interface Lwt
+ * Copyright (C) 2005-2008 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *               2009-2012 Jérémie Dimino
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as
+ * published by the Free Software Foundation, with linking exceptions;
+ * either version 2.1 of the License, or (at your option) any later
+ * version. See COPYING file for details.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ * 02111-1307, USA.
+ *)
+
+(** Module [Lwt_result]: explicit error handling *)
+
+open Result
+
+type (+'a, +'b) t = ('a, 'b) Result.result Lwt.t
+
+let return x = Lwt.return (Ok x)
+let fail e = Lwt.return (Error e)
+
+let lift = Lwt.return
+let ok x = Lwt.map (fun y -> Ok y) x
+
+let map f e =
+  Lwt.map
+    (function
+      | Error e -> Error e
+      | Ok x -> Ok (f x))
+    e
+
+let map_err f e =
+  Lwt.map
+    (function
+      | Error e -> Error (f e)
+      | Ok x -> Ok x)
+    e
+
+let catch e =
+  Lwt.catch
+    (fun () -> ok e)
+    fail
+
+let get_exn e =
+  Lwt.bind e
+    (function
+      | Ok x -> Lwt.return x
+      | Error e -> Lwt.fail e)
+
+let bind e f =
+  Lwt.bind e
+    (function
+      | Error e -> Lwt.return (Error e)
+      | Ok x -> f x)
+
+let bind_lwt e f =
+  Lwt.bind e
+    (function
+      | Ok x -> ok (f x)
+      | Error e -> fail e)
+
+let bind_result e f =
+  Lwt.map
+    (function
+      | Error e -> Error e
+      | Ok x -> f x)
+    e
+
+let bind_lwt_err e f =
+  Lwt.bind e
+    (function
+      | Error e -> Lwt.bind (f e) fail
+      | Ok x -> return x)
+
+module Infix = struct
+  let (>>=) = bind
+  let (>|=) e f = map f e
+end
+
+include Infix

src/core/lwt_result.mli

@@ -0,0 +1,65 @@
+(* Lightweight thread library for OCaml
+ * http://www.ocsigen.org/lwt
+ * Interface Lwt
+ * Copyright (C) 2005-2008 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *               2009-2012 Jérémie Dimino
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as
+ * published by the Free Software Foundation, with linking exceptions;
+ * either version 2.1 of the License, or (at your option) any later
+ * version. See COPYING file for details.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ * 02111-1307, USA.
+ *)
+
+(** Module [Lwt_result]: explicit error handling *)
+
+(** This module provides helpers for values of type [('a, 'b) result Lwt.t] *)
+
+type (+'a, +'b) t = ('a, 'b) Result.result Lwt.t
+
+val return : 'a -> ('a, _) t
+
+val fail : 'b -> (_, 'b) t
+
+val lift : ('a, 'b) Result.result -> ('a, 'b) t
+
+val ok : 'a Lwt.t -> ('a, _) t
+
+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] *)
+
+val get_exn : ('a, exn) t -> 'a Lwt.t
+(** [get_exn] is the opposite of {!catch}: it unwraps the result type,
+    returning the value in case of success, calls {!Lwt.fail} in
+    case of error. *)
+
+val map : ('a -> 'b) -> ('a,'e) t -> ('b,'e) t
+
+val map_err : ('e1 -> 'e2) -> ('a,'e1) t -> ('a,'e2) t
+
+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_result : ('a,'e) t -> ('a -> ('b,'e) Result.result) -> ('b,'e) t
+
+module Infix : sig
+  val (>|=) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
+  val (>>=) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
+end
+
+include module type of Infix