Merge pull request #6 from ocaml-dune/add-ast

Add Pp.Ast

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.14.2
+version=0.17.0
 break-separators=before
 dock-collection-brackets=false
 break-sequences=true

CHANGES.md

@@ -4,6 +4,8 @@ Next
 - Add `of_fmt` to compose with existing pretty printers written in `Format`
   (#1).
 
+- Add `Ast` sub-module to expose a stable representation for serialization. (#6)
+
 1.0.1
 -----
 

src/pp.ml

@@ -6,6 +6,24 @@ end
 
 module String = StringLabels
 
+module Ast = struct
+  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
+end
+
 type +'a t =
   | Nop
   | Seq of 'a t * 'a t
@@ -23,6 +41,43 @@ type +'a t =
   | Tag of 'a * 'a t
   | Format of (Format.formatter -> unit)
 
+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 rec map_tags t ~f =
   match t with
   | Nop -> Nop
@@ -53,7 +108,7 @@ let rec filter_map_tags t ~f =
     let t = filter_map_tags t ~f in
     match f tag with
     | None -> t
-    | Some tag -> Tag (tag, t) )
+    | Some tag -> Tag (tag, t))
   | Format f -> Format f
 
 module Render = struct
@@ -169,10 +224,10 @@ let chain l ~f =
             box ~indent:3
               (seq
                  (verbatim
-                    ( if i = 0 then
+                    (if i = 0 then
                       "   "
                     else
-                      "-> " ))
+                      "-> "))
                  (f x)))))
 
 module O = struct

src/pp.mli

@@ -177,9 +177,35 @@ val to_fmt_with_tags :
 
 (** 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.
-*)
+    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
+
+(** {1 Ast} *)
+
+module Ast : sig
+  (** Stable representation useful for serialization *)
+  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
+end
+
+(** [of_ast t] [Ast.t] to [Pp.t] *)
+val of_ast : 'a Ast.t -> 'a 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 : 'a t -> ('a Ast.t, unit) result

test/tests.ml

@@ -159,7 +159,7 @@ let%expect_test _ =
 let%expect_test _ =
   print
     (Pp.vbox
-       ( Pp.box (Pp.text "Error: something went wrong!")
+       (Pp.box (Pp.text "Error: something went wrong!")
        ++ Pp.cut
        ++ Pp.box (Pp.text "Here are a few things you can do:")
        ++ Pp.cut
@@ -180,7 +180,7 @@ let%expect_test _ =
                    ; "take a break from your keyboard"
                    ; "clear your head and try again"
                    ]
-            ] ));
+            ]));
   [%expect
     {|
     Error: something went wrong!
@@ -200,24 +200,24 @@ let%expect_test _ =
 let%expect_test _ =
   print
     (Pp.hovbox ~indent:2
-       ( Array.make 50 (Pp.char 'x')
+       (Array.make 50 (Pp.char 'x')
        |> Array.to_list
        |> Pp.concat
-            ~sep:(Pp.custom_break ~fits:("", 2, "") ~breaks:(" \\", -1, "")) ));
+            ~sep:(Pp.custom_break ~fits:("", 2, "") ~breaks:(" \\", -1, ""))));
   [%expect
     {|
 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 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{|
+  print
+    (Pp.text "hello" ++ Pp.newline
+    ++ Pp.vbox (Pp.of_fmt pp_pair (1, 2))
+    ++ Pp.space ++ Pp.text "foo");
+  [%expect {|
     hello
     (1,
     2)