From faf15dbb12431464883a0a6037e8bdb9fd07ecb7 Mon Sep 17 00:00:00 2001
From: Ali Caglayan <alizter@gmail.com>
Date: Tue, 17 Oct 2023 20:45:26 -0700
Subject: [PATCH] refactor: remove Format constructor (#17)

We remove the Format constructor in Pp.t that prevented it from being
drectly serializable.

Signed-off-by: Ali Caglayan <alizter@gmail.com>
---
 CHANGES.md    |  5 ++++
 src/pp.ml     | 65 +++------------------------------------------------
 src/pp.mli    | 35 ++++++++++++---------------
 test/tests.ml | 13 -----------
 4 files changed, 23 insertions(+), 95 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 3acf09c..679b048 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,8 @@
+Unreleased
+----------
+
+- Remove `of_fmt` constructor. (#17, @Alizter)
+
 1.2.0
 -----
 
diff --git a/src/pp.ml b/src/pp.ml
index 5332dad..c18c16e 100644
--- a/src/pp.ml
+++ b/src/pp.ml
@@ -24,59 +24,10 @@ module Ast = struct
     | Tag of 'a * 'a t
 end
 
-type +'a t =
-  | Nop
-  | Seq of 'a t * 'a t
-  | Concat of 'a t * 'a t list
-  | Box of int * 'a t
-  | Vbox of int * 'a t
-  | Hbox of 'a t
-  | Hvbox of int * 'a t
-  | Hovbox of int * 'a t
-  | Verbatim of string
-  | Char of char
-  | Break of (string * int * string) * (string * int * string)
-  | Newline
-  | Text of string
-  | Tag of 'a * 'a t
-  | Format of (Format.formatter -> unit)
+include Ast
 
-let rec of_ast : 'a. 'a Ast.t -> 'a t = function
-  | Nop -> Nop
-  | Seq (x, y) -> Seq (of_ast x, of_ast y)
-  | Concat (x, y) -> Concat (of_ast x, List.map ~f:of_ast y)
-  | Box (x, y) -> Box (x, of_ast y)
-  | Vbox (x, y) -> Vbox (x, of_ast y)
-  | Hbox x -> Hbox (of_ast x)
-  | Hvbox (x, y) -> Hvbox (x, of_ast y)
-  | Hovbox (x, y) -> Hovbox (x, of_ast y)
-  | Verbatim s -> Verbatim s
-  | Char c -> Char c
-  | Break (x, y) -> Break (x, y)
-  | Newline -> Newline
-  | Text s -> Text s
-  | Tag (a, x) -> Tag (a, of_ast x)
-
-let to_ast x =
-  let rec to_ast : 'a t -> 'a Ast.t = function
-    | Nop -> Nop
-    | Seq (x, y) -> Seq (to_ast x, to_ast y)
-    | Concat (x, y) -> Concat (to_ast x, List.map ~f:(fun x -> to_ast x) y)
-    | Box (x, y) -> Box (x, to_ast y)
-    | Vbox (x, y) -> Vbox (x, to_ast y)
-    | Hbox x -> Hbox (to_ast x)
-    | Hvbox (x, y) -> Hvbox (x, to_ast y)
-    | Hovbox (x, y) -> Hovbox (x, to_ast y)
-    | Verbatim s -> Verbatim s
-    | Char c -> Char c
-    | Break (x, y) -> Break (x, y)
-    | Newline -> Newline
-    | Tag (a, x) -> Tag (a, to_ast x)
-    | Text s -> Text s
-    | Format _ -> raise_notrace Exit
-  in
-  try Ok (to_ast x) with
-  | Exit -> Error ()
+let of_ast = Fun.id
+let to_ast = Fun.id
 
 let rec map_tags t ~f =
   match t with
@@ -90,7 +41,6 @@ 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
@@ -109,7 +59,6 @@ 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
@@ -152,7 +101,6 @@ 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
@@ -223,8 +171,6 @@ module O = struct
   let ( ++ ) = seq
 end
 
-let of_fmt f x = Format (fun ppf -> f ppf x)
-
 let compare =
   let compare_both (type a b) (f : a -> a -> int) (g : b -> b -> int) (a, b)
       (c, d) =
@@ -299,10 +245,5 @@ let compare =
       | Text _, _ -> -1
       | _, Text _ -> 1
       | Tag (a, b), Tag (c, d) -> compare_both compare_tag compare (a, b) (c, d)
-      | Format _, Format _ ->
-        raise
-          (Invalid_argument "[Pp.of_fmt] values not supported in [Pp.compare]")
-      | Format _, _ -> -1
-      | _, Format _ -> 1
     in
     compare
diff --git a/src/pp.mli b/src/pp.mli
index 8104736..cd5d55e 100644
--- a/src/pp.mli
+++ b/src/pp.mli
@@ -1,7 +1,11 @@
 (** Pretty-printing. *)
 
-(** A document that is not yet rendered. The argument is the type of tags in the
-    document. For instance tags might be used for styles. *)
+(** ['tag t] represents a document that is not yet rendered. The argument ['tag]
+    is the type of tags in the document. For instance tags might be used for
+    styles.
+
+    If you want to serialise and deserialise this datastructure, you can use the
+    [Ast.t] type together with the [of_ast] and [to_ast] functions. *)
 type +'tag t
 
 (** {1 Basic combinators} *)
@@ -191,20 +195,14 @@ val to_fmt_with_tags :
   -> tag_handler:(Format.formatter -> 'tag -> 'tag 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 -> 'tag -> unit) -> 'tag -> 'tag t
-
 (** {1 Ast} *)
 
 module Ast : sig
-  (** Stable representation useful for serialization *)
-  type 'tag t =
+  (** Stable representation of [Pp.t] useful for serialization *)
+
+  (** Stable abstract syntax tree for [Pp.t] that can be used for serialization
+      and deserialization. *)
+  type +'tag t =
     | Nop
     | Seq of 'tag t * 'tag t
     | Concat of 'tag t * 'tag t list
@@ -221,16 +219,13 @@ module Ast : sig
     | Tag of 'tag * 'tag t
 end
 
-(** [of_ast t] [Ast.t] to [Pp.t] *)
+(** [of_ast t] converts an [Ast.t] to a [Pp.t]. *)
 val of_ast : 'tag Ast.t -> 'tag t
 
-(** [to_ast t] will try to convert [t] to [Ast.t]. When [t] contains values
-    constructed with [of_fmt], this function will fail and return [Error ()] *)
-val to_ast : 'tag t -> ('tag Ast.t, unit) result
+(** [to_ast t] converts a [Pp.t] to an [Ast.t]. *)
+val to_ast : 'tag t -> 'tag Ast.t
 
 (** {1 Comparison} *)
 
-(** [compare cmp x y] compares [x] and [y] using [cmp] to compare tags.
-
-    @raise Invalid_argument if two [of_fmt] values are compared. *)
+(** [compare cmp x y] compares [x] and [y] using [cmp] to compare tags. *)
 val compare : ('tag -> 'tag -> int) -> 'tag t -> 'tag t -> int
diff --git a/test/tests.ml b/test/tests.ml
index 857281d..42aeaf4 100644
--- a/test/tests.ml
+++ b/test/tests.ml
@@ -209,19 +209,6 @@ 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 |}]
-
 let%expect_test "comparison" =
   let x = error_example_1
   and y = Pp.hovbox ~indent:2 (xs 200) in