end
(* ErrorT transformer when wrapped monad has plus, zero *)
module TP : functor (Wrapped : Monad.P) -> sig
- include module type of T(Wrapped)
+ type 'a result = 'a Wrapped.result
+ type 'a result_exn = 'a Wrapped.result_exn
+ include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
+ val elevate : 'a Wrapped.m -> 'a m
+ val throw : err -> 'a m
+ val catch : 'a m -> (err -> 'a m) -> 'a m
include Monad.PLUS with type 'a m := 'a m
end
module T2 : functor (Wrapped : Monad.S2) -> sig
val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
end
module TP2 : functor (Wrapped : Monad.P2) -> sig
- include module type of T2(Wrapped)
+ type ('x,'a) result = ('x,'a) Wrapped.result
+ type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+ include Monad.S2 with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+ val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+ val throw : err -> ('x,'a) m
+ val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
include Monad.PLUS2 with type ('x,'a) m := ('x,'a) m
end
end = struct
let run_exn u =
let w = Wrapped.bind u (fun t -> match t with
| Success a -> Wrapped.unit a
- (* | _ -> Wrapped.fail () *)
| Error e -> raise (Err.Exc e))
in Wrapped.run_exn w
end
| Error e -> handler e)
end
module TP(Wrapped : Monad.P) = struct
+ (* code repetition, ugh *)
module TransP = struct
- include T(Wrapped)
+ include Monad.MakeT(struct
+ module Wrapped = Wrapped
+ type 'a m = 'a error Wrapped.m
+ type 'a result = 'a Wrapped.result
+ type 'a result_exn = 'a Wrapped.result_exn
+ let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Success a))
+ let bind u f = Wrapped.bind u (fun t -> match t with
+ | Success a -> f a
+ | Error e -> Wrapped.unit (Error e))
+ let run u =
+ let w = Wrapped.bind u (fun t -> match t with
+ | Success a -> Wrapped.unit a
+ | Error e -> Wrapped.zero ())
+ in Wrapped.run w
+ let run_exn u =
+ let w = Wrapped.bind u (fun t -> match t with
+ | Success a -> Wrapped.unit a
+ | Error e -> raise (Err.Exc e))
+ in Wrapped.run_exn w
+ end)
+ let throw e = Wrapped.unit (Error e)
+ let catch u handler = Wrapped.bind u (fun t -> match t with
+ | Success _ -> Wrapped.unit t
+ | Error e -> handler e)
let plus u v = Wrapped.plus u v
let zero () = elevate (Wrapped.zero ())
end
| Error e -> handler e)
end
module TP2(Wrapped : Monad.P2) = struct
+ (* code repetition, ugh *)
module TransP = struct
- include T2(Wrapped)
- (* code repetition, ugh *)
+ include Monad.MakeT2(struct
+ module Wrapped = Wrapped
+ type ('x,'a) m = ('x,'a error) Wrapped.m
+ type ('x,'a) result = ('x,'a) Wrapped.result
+ type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+ let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Success a))
+ let bind u f = Wrapped.bind u (fun t -> match t with
+ | Success a -> f a
+ | Error e -> Wrapped.unit (Error e))
+ let run u =
+ let w = Wrapped.bind u (fun t -> match t with
+ | Success a -> Wrapped.unit a
+ | Error e -> Wrapped.zero ())
+ in Wrapped.run w
+ let run_exn u =
+ let w = Wrapped.bind u (fun t -> match t with
+ | Success a -> Wrapped.unit a
+ | Error e -> raise (Err.Exc e))
+ in Wrapped.run_exn w
+ end)
+ let throw e = Wrapped.unit (Error e)
+ let catch u handler = Wrapped.bind u (fun t -> match t with
+ | Success _ -> Wrapped.unit t
+ | Error e -> handler e)
let plus u v = Wrapped.plus u v
let zero () = elevate (Wrapped.zero ())
end