diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml index 467020d7..36a78bbc 100644 --- a/src/pp/containers_pp.ml +++ b/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) diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli index 5e29c968..1501fcbc 100644 --- a/src/pp/containers_pp.mli +++ b/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] *) diff --git a/src/pp/dune b/src/pp/dune index 2220457c..fbf9d1fb 100644 --- a/src/pp/dune +++ b/src/pp/dune @@ -4,4 +4,4 @@ (public_name containers.pp) (synopsis "Pretty printer for Containers") (flags :standard) - (libraries containers)) + (libraries containers seq)) diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml index 958c8190..ca4f2f86 100644 --- a/tests/core/t_pp.ml +++ b/tests/core/t_pp.ml @@ -51,6 +51,6 @@ let () = "(foo\n bar\n (g 42 10))" (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)