Source file result_lwt.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2019,2020 DaiLambda, Inc. <contact@dailambda.jp>            *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)
(* "Error" monad *)

include Monad.Make2(struct
    type ('a, 'b) t = ('a, 'b) Result.t Lwt.t
    let return = Lwt.return_ok

    let bind x f = Lwt.bind x @@
      function
      | Error e -> Lwt.return_error e
      | Ok x -> f x
end)

(* optimized *)
let map f x = Lwt.map (Result.map f) x

let (>|=) x f = Lwt.map (Result.map f) x

let from_Ok_lwt x =
  Lwt.bind x (function
      | Ok x -> Lwt.return x | Error _e -> failwith "Expected an Ok")

let from_Error_lwt x =
  Lwt.bind x (function
      | Ok _x -> failwith "Expected an Error" | Error e -> Lwt.return e)

let default r f = Lwt.bind r @@ function
  | Ok x -> Lwt.return x
  | Error e -> Lwt.return (f e)

let errorf fmt = Printf.ksprintf (fun s -> Lwt.return_error s) fmt

let map_error f = Lwt.map (Result.map_error f)

module Infix = struct
  let (>>=?) = Infix.(>>=)
  let (>|=?) = (>|=)
  let (>>?) = Result.Infix.(>>=)
  let (>|?) = Result.Infix.(>|=)
  let (>>=) = Lwt.Infix.(>>=)
  let (>|=) = Lwt.Infix.(>|=)
end

module Syntax = struct
  open Infix
  let (let*=?) = (>>=?)
  let (let+=?) = (>|=?)
  let (let*?) = (>>?)
  let (let+?) = (>|?)
  let (let*=) = (>>=)
  let (let+=) = (>|=)
end