transformer.ml

(* for OCaml <4.03.0 define:
  type ('a, 'b) result = Ok of 'a | Error of 'b *)

module type MONAD = sig
  type 'a t
  val return : 'a -> 'a t
  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end

module Id = struct
  type 'a t = 'a
  let return x = x
  let (>>=) x f = f x
end

module OptionT(M : MONAD) = struct
  type 'a t = 'a option M.t
  let return x = M.return (Some x)
  let (>>=) x f = M.(
    x >>= function
      | None as y -> return y
      | Some y -> f y)
end

module ResultT(M : MONAD)(Error : sig type t end) = struct
  type 'a t = ('a, Error.t) result M.t
  let return x = M.return (Ok x)
  let (>>=) x f = M.(
    x >>= function
      | Error _ as y -> return y
      | Ok y -> f y)
end

module Option = OptionT(Id)
module Result = ResultT(Id)

let () =
  let module ResultOpt = ResultT(Option)(struct type t = string end) in

  let f x = Some (Ok (x + 7)) in
  let g x = ResultOpt.return (x * 3) in
  let h x = Some (Error "lol") in

  let x = Some (Ok 5) in
  let y = ResultOpt.(x >>= f >>= h >>= g) in
  let z = ResultOpt.(x >>= f >>= g) in

  assert (y = Some (Error "lol"));
  assert (z = Some (Ok 36));
  ()

let () =
  let module OptResult = OptionT(Result(struct type t = string end)) in

  let f x = Ok (Some (x + 7)) in
  let g x = OptResult.return (x * 3) in
  let h x = Ok None in

  let x = Ok (Some 5) in
  let y = OptResult.(x >>= f >>= h >>= g) in
  let z = OptResult.(x >>= f >>= g) in

  assert (y = Ok None);
  assert (z = Ok (Some 36));
  ()