From 39c33046cedc60f54255500eb25455911223628d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 28 Jun 2014 15:16:37 +0200
Subject: [PATCH] stub for monadic IO in CCPrint

---
 core/CCPrint.ml  | 31 +++++++++++++++++++++++++++++++
 core/CCPrint.mli | 22 ++++++++++++++++++++++
 2 files changed, 53 insertions(+)

diff --git a/core/CCPrint.ml b/core/CCPrint.ml
index bff1b12f..bcbd26db 100644
--- a/core/CCPrint.ml
+++ b/core/CCPrint.ml
@@ -144,3 +144,34 @@ let _with_file_out filename f =
 
 let to_file filename format =
   _with_file_out filename (fun oc -> fprintf oc format)
+
+(** {2 Monadic IO} *)
+
+module type MONAD_IO = sig
+  type 'a t     (** the IO monad *)
+  type output   (** Output channels *)
+
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val write : output -> string -> unit t
+end
+
+module MakeIO(M : MONAD_IO) = struct
+  let output out pp x =
+    let buf = Buffer.create 128 in
+    pp buf x;
+    M.write out (Buffer.contents buf)
+
+  let printl out pp x =
+    let buf = Buffer.create 128 in
+    pp buf x;
+    Buffer.add_char buf '\n';
+    M.write out (Buffer.contents buf)
+
+  let fprintf out format =
+    let buf = Buffer.create 128 in
+    Printf.kbprintf
+      (fun buf -> M.write out (Buffer.contents buf))
+      buf
+      format
+end
diff --git a/core/CCPrint.mli b/core/CCPrint.mli
index 270eaae6..7911b453 100644
--- a/core/CCPrint.mli
+++ b/core/CCPrint.mli
@@ -76,3 +76,25 @@ val to_file : string -> ('a, Buffer.t, unit, unit) format4 -> 'a
 
 val printf : ('a, Buffer.t, unit, unit) format4 -> 'a
 val eprintf : ('a, Buffer.t, unit, unit) format4 -> 'a
+
+(** {2 Monadic IO} *)
+
+module type MONAD_IO = sig
+  type 'a t     (** the IO monad *)
+  type output   (** Output channels *)
+
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val write : output -> string -> unit t
+end
+
+module MakeIO(M : MONAD_IO) : sig
+  val output : M.output -> 'a t -> 'a -> unit M.t
+  (** Output a single value *)
+
+  val printl : M.output -> 'a t -> 'a -> unit M.t
+  (** Output a value and add a newline "\n" after. *)
+
+  val fprintf : M.output -> ('a, Buffer.t, unit, unit M.t) format4 -> 'a
+  (** Fprintf on a monadic output *)
+end