Pp: rename wrap to ext; more doc, more combinators

src/pp/containers_pp.ml

@@ -73,7 +73,7 @@ let group d : t =
   | Group _ -> d
   | _ -> { view = Group d; wfl = d.wfl }
 
-let wrap ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl }
+let ext ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl }
 let ( ^ ) = append
 let text_sub_ s i len : t = { view = Text_sub (s, i, len); wfl = len }
 
@@ -317,6 +317,7 @@ let bool b =
 let int x : t = text (string_of_int x)
 let float x : t = text (string_of_float x)
 let float_hex x : t = textpf "%h" x
+let text_quoted s : t = text (Printf.sprintf "%S" s)
 
 let append_l ?(sep = nil) l =
   let rec loop = function
@@ -350,6 +351,20 @@ let of_list ?(sep = nil) f l =
   in
   loop l
 
+let of_seq ?(sep = nil) f seq : t =
+  let rec loop first seq =
+    match seq () with
+    | Seq.Nil -> nil
+    | Seq.Cons (x, tl) ->
+      let x = f x in
+      (if first then
+        x
+      else
+        sep ^ x)
+      ^ loop false tl
+  in
+  loop true seq
+
 let bracket l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
 let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
 let sexp_apply a l : t = sexp_l (text a :: l)

src/pp/containers_pp.mli

@@ -55,6 +55,8 @@ val newline : t
 val nl : t
 (** Alias for {!newline} *)
 
+(** {2 Output device} *)
+
 (** Arbitrary output.
 
     This is used for user-provided output. *)
@@ -73,9 +75,14 @@ module Out : sig
   val of_buffer : Buffer.t -> t
 end
 
+(** {2 Extensibility} *)
+
 (** Extension node.
 
-    In here, we can stuff custom printer nodes. *)
+    Custom nodes can be used to add user-defined behavior to
+    the rendered output. For example, documents
+    might be annotated with ANSI-terminal colors, or
+    with HTML tags. *)
 module Ext : sig
   type 'a t = {
     pre: Out.t -> 'a -> unit;  (** Printed before the wrapped value. *)
@@ -83,18 +90,17 @@ module Ext : sig
   }
 end
 
-val wrap : 'a Ext.t -> 'a -> t -> t
-(** [wrap ext v d] wraps [d] with value [v].
+val ext : 'a Ext.t -> 'a -> t -> t
+(** [ext e v d] wraps [d] with value [v].
 
     It is a document that has the same
     shape (and size) as [d], except that additional data will
-    be output when it is rendered.
+    be output when it is rendered using extension [e].
 
-    Let [(module Ext)] be [ext], and [out]
-    be the output buffer/stream for rendering.
+    When this is rendered, first [e.pre out v] is called;
+    then [d] is printed; then [e.post out v] is called.
+    Here [out] is the output buffer/stream for rendering.
 
-    When this is rendered, first [Ext.pre out v] is called;
-    then [d] is printed; then [Exp.post out v] is called.
 *)
 
 (** {2 Pretty print and rendering} *)
@@ -127,8 +133,9 @@ module Flatten : sig
 end
 
 val pp : Format.formatter -> t -> unit
+(** Pretty-print, using {!Pretty} and an unspecified margin. *)
 
-(** {2 Convenience functions *)
+(** {2 Convenience functions} *)
 
 module Infix : sig
   val ( ^ ) : t -> t -> t
@@ -161,11 +168,17 @@ val int : int -> t
 val float : float -> t
 val float_hex : float -> t
 
+val text_quoted : string -> t
+(** [text_quoted s] is [text (spf "%S" s)] *)
+
 val of_list : ?sep:t -> ('a -> t) -> 'a list -> t
 (** [of_list f l] maps each element of [l] to a document
     and concatenates them.
     @param sep separator inserted between elements (default [nil]) *)
 
+val of_seq : ?sep:t -> ('a -> t) -> 'a Seq.t -> t
+(** Same as {!of_list} but with sequences. *)
+
 val bracket : string -> t -> string -> t
 (** [bracket l d r] groups [d], indented, between brackets [l] and [r] *)
 

src/pp/dune

@@ -4,4 +4,4 @@
   (public_name containers.pp)
   (synopsis "Pretty printer for Containers")
   (flags :standard)
-  (libraries containers))
+  (libraries containers seq))

tests/core/t_pp.ml

@@ -51,6 +51,6 @@ let () =
     "(foo\n bar\n <coucou>(g 42 10)</coucou>)"
     (let d =
        sexp_apply "foo"
-         [ text "bar"; wrap ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ]
+         [ text "bar"; ext ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ]
      in
      Pretty.to_string ~width:10 d)