Allow to safely inject delayed formatters.

src/pp.ml

@@ -21,6 +21,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
@@ -34,6 +35,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
@@ -52,6 +54,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
@@ -94,6 +97,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
@@ -174,3 +178,5 @@ let chain l ~f =
 module O = struct
   let ( ++ ) = seq
 end
+
+let of_fmt f x = Format (fun ppf -> f ppf x)

src/pp.mli

@@ -172,3 +172,8 @@ 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

test/tests.ml

@@ -209,3 +209,16 @@ let%expect_test _ =
 x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x \
  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
 |}]
+
+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 |}]