diff --git a/CHANGES.md b/CHANGES.md index c07ebee..3b574b7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +Next +---- + +- Add `of_fmt` to compose with existing pretty printers written in `Format` + (#1). + 1.0.1 ----- diff --git a/src/pp.ml b/src/pp.ml index 4a440eb..b467b17 100644 --- a/src/pp.ml +++ b/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) diff --git a/src/pp.mli b/src/pp.mli index 865f0ac..de54f11 100644 --- a/src/pp.mli +++ b/src/pp.mli @@ -172,3 +172,14 @@ 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. + + Disclaimer: this function is to meant to help using [Pp] in + existing code that already use the [Format] module without having + to port everything to [Pp]. It is not meant as the normal way to + create [Pp.t] values. +*) +val of_fmt : (Format.formatter -> 'a -> unit) -> 'a -> _ t diff --git a/test/tests.ml b/test/tests.ml index 02a05ee..cdea0ba 100644 --- a/test/tests.ml +++ b/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 |}]