Fun of Modular Implicits

fun_of_modular_implicits.ml

module type Show = sig
  type t
  val show : t -> string
end

let show (implicit S : Show) x = S.show x

module Show_instances = struct
  implicit module Show_unit = struct
    type t = unit
    let show t = "()"
  end

  implicit module Show_int = struct
    type t = int
    let show t = string_of_int t
  end

  implicit module Show_float = struct
    type t = float
    let show t = string_of_float t
  end

  implicit functor Show_list (X : Show) = struct
    type t = X.t list
    let show t =
      let buf = Buffer.create 16 in
      Buffer.add_char buf '[';
      List.iter
        (fun x ->
           if Buffer.length buf > 1 then
             Buffer.add_string buf ", ";
           Buffer.add_string buf (X.show x))
        t;
      Buffer.add_char buf ']';
      Buffer.contents buf
  end

  implicit functor Show_option (X : Show) = struct
    type t = X.t option
    let show = function
      | None -> "None"
      | Some x -> Printf.sprintf "Some %s" (X.show x)
  end
end

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

implicit module Monad_list = struct
  type 'a t = 'a list
  let return x = [x]
  let (>>=) t f = List.concat (List.map f t)
end

implicit module Monad_option = struct
  type 'a t = 'a option
  let return x = Some x
  let (>>=) t f = match t with
    | None -> None
    | Some x -> f x
end

let incrM (implicit M : Monad) x =
  let open M in
  x >>= fun y -> return (y + 1)

let () =
  let open Show_instances in
  print_endline (show ());
  print_endline (show (incrM [1; 2; 3]));
  let module Show_int_option = Show_option (Show_int) in
  print_endline (show (implicit Show_int_option) (incrM None));
  print_endline (show (incrM (Some 1)))