Source file poly_result.ml

open Base

type ('a, 'error) t = [`Ok of 'a | `Error of 'error]

module Monad = struct
  include Monad.Make2(struct
      type ('a, 'error) t = [`Ok of 'a | `Error of 'error]

      let return v = `Ok v

      let bind t f = match t with
        | `Ok v -> f v
        | `Error e -> `Error e
    end)

  let mapM f xs =
    let rec loop acc = function
      | [] -> return & List.rev acc
      | x::xs ->
          match f x with
          | `Error _ as e -> e
          | `Ok y ->
              loop (y::acc) xs
    in
    loop [] xs

  let mapM_ f xs =
    let rec loop = function
      | [] -> return ()
      | x::xs ->
          match f x with
          | `Error _ as e -> e
          | `Ok () ->
              loop xs
    in
    loop xs

  module Infix = struct
    include Infix

    let (>>=!) v f = match v with
      | `Ok v -> `Ok v
      | `Error e -> f e

    let (>>|!) v f = match v with
      | `Ok v -> `Ok v
      | `Error e -> `Error (f e)
  end
end

include Monad

let fail e = `Error e

let catch f =
  let module Error = struct exception Error end in
  let error = ref None in
  let fail e = error := Some e; raise Error.Error in
  try `Ok (f ~fail) with
  | Error.Error ->
      match !error with
      | Some e -> `Error e
      | None -> assert false

let catch_exn f = catch (fun ~fail -> try f () with e -> fail e)

let map_error f = function
  | `Ok v -> `Ok v
  | `Error e -> `Error (f e)

let to_option = function
  | `Ok v -> Some v
  | `Error _ -> None

module Stdlib = struct

  let ok x = `Ok x
  let ng x = `Error x

  let from_Ok = function
    | `Ok v -> v
    | `Error _ -> raise Vresult.IsError

  let result left right = function
    | `Ok v -> left v
    | `Error e -> right e

  let at_Error f = result (fun x -> x) f
end

include Stdlib