Allow to safely inject delayed formatters.

src/pp.ml

@@ -16,6 +16,7 @@ type +'a t =
   | Newline
   | Text of string
   | Tag of 'a * 'a t
+  | Format of (Format.formatter -> unit)
 
 let rec map_tags t ~f =
   match t with
@@ -29,6 +30,7 @@ let rec map_tags t ~f =
   | Hovbox (indent, t) -> Hovbox (indent, map_tags t ~f)
   | (Verbatim _ | Char _ | Break _ | Newline | Text _) as t -> t
   | Tag (tag, t) -> Tag (f tag, map_tags t ~f)
+  | Format f -> Format f
 
 let rec filter_map_tags t ~f =
   match t with
@@ -47,6 +49,7 @@ let rec filter_map_tags t ~f =
     match f tag with
     | None -> t
     | Some tag -> Tag (tag, t) )
+  | Format f -> Format f
 
 module Render = struct
   open Format
@@ -89,6 +92,7 @@ module Render = struct
     | Newline -> pp_force_newline ppf ()
     | Text s -> pp_print_text ppf s
     | Tag (tag, t) -> tag_handler ppf tag t
+    | Format f -> f ppf
 end
 
 let to_fmt_with_tags = Render.render
@@ -166,3 +170,6 @@ let chain l ~f =
 module O = struct
   let ( ++ ) = seq
 end
+
+let of_fmt f x = Format (fun ppf -> f ppf x)
+let pf ppf = Format.kdprintf (fun f -> Format f) ppf

src/pp.mli

@@ -162,3 +162,12 @@ val to_fmt_with_tags :
   -> 'a t
   -> tag_handler:(Format.formatter -> 'a -> 'a t -> unit)
   -> unit
+
+(** {1 Injection} *)
+
+(** Inject a classic formatter in a document *)
+val of_fmt : (Format.formatter -> 'a -> unit) -> 'a -> _ t
+
+(** [pf "..." a b c] behaves like {!printf}, but returns a document *)
+val pf : ('a, Format.formatter, unit, 'b t) format4 -> 'a
+

test/tests.ml

@@ -195,3 +195,27 @@ let%expect_test _ =
       - scream loudly at your computer
       - take a break from your keyboard
       - clear your head and try again |}]
+
+let pp_pair ppf (a,b) = Format.fprintf ppf "(%i,@ %i)" a b
+
+let%expect_test _ =
+  print (
+    Pp.text "hello" ++ Pp.newline ++
+    Pp.vbox (Pp.of_fmt pp_pair (1,2)) ++ Pp.space ++ Pp.text "foo"
+  );
+  [%expect{|
+    hello
+    (1,
+    2)
+    foo |}]
+
+let%expect_test _ =
+  print (
+    Pp.text "hello" ++ Pp.newline ++
+    Pp.vbox (Pp.pf "(%i,@ %i)" 1 2) ++ Pp.space ++ Pp.text "foo"
+  );
+  [%expect{|
+    hello
+    (1,
+    2)
+    foo |}]