Skip to content

Commit

Permalink
feat pp: add a bunch of extensions
Browse files Browse the repository at this point in the history
thanks to @grayswandyr
  • Loading branch information
c-cube committed Aug 19, 2024
1 parent 02ac5bd commit 65fc920
Show file tree
Hide file tree
Showing 2 changed files with 117 additions and 0 deletions.
55 changes: 55 additions & 0 deletions src/pp/containers_pp.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
module B = Buffer
module Int_map = Map.Make (CCInt)

type 'a iter = ('a -> unit) -> unit

module Out = struct
type t = {
char: char -> unit;
Expand Down Expand Up @@ -464,11 +466,64 @@ let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r)
let bracket2 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)
let surround ?(width = 1) l b r = group (l ^ nest width b ^ r)
module Char = struct
let bang = char '!'
let at = char '@'
let hash = char '#'
let dollar = char '$'
let tilde = char '~'
let backquote = char '`'
let percent = char '%'
let caret = char '^'
let ampersand = char '&'
let star = char '*'
let minus = char '-'
let underscore = char '_'
let plus = char '+'
let equal = char '='
let pipe = char '|'
let slash = char '/'
let backslash = char '\\'
let colon = char ':'
let semi = char ';'
let guillemet = char '"'
let quote = char '\''
let comma = char ','
let dot = char '.'
let question = char '?'
let lparen = char '('
let rparen = char ')'
let lbrace = char '{'
let rbrace = char '}'
let lbracket = char '['
let rbracket = char ']'
let langle = char '<'
let rangle = char '>'
end
module Dump = struct
let list l : t =
let sep = char ';' ^ nl in
group (char '[' ^ nest 1 (fill sep l) ^ char ']')
let parens d = surround Char.lparen d Char.rparen
let braces d = surround Char.lbrace d Char.rbrace
let brackets d = surround Char.lbracket d Char.rbracket
let angles d = surround Char.langle d Char.rangle
let of_iter ?(sep = nil) g it =
let r = ref nil in
it (fun elt -> r := !r ^ sep ^ g elt);
!r
let of_array ?(sep = nil) g arr =
let r = ref nil in
for i = 0 to Array.length arr - 1 do
r := !r ^ sep ^ g arr.(i)
done;
!r
end
module Term_color = struct
Expand Down
62 changes: 62 additions & 0 deletions src/pp/containers_pp.mli
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,8 @@

(** {2 Core} *)

type 'a iter = ('a -> unit) -> unit

type t
(** The type of documents *)

Expand Down Expand Up @@ -256,6 +258,26 @@ val sexp_l : t list -> t
(** Printers that correspond closely to OCaml's syntax. *)
module Dump : sig
val list : t list -> t

val of_iter : ?sep:t -> ('a -> t) -> 'a iter -> t
(** @since NEXT_RELEASE *)

val of_array : ?sep:t -> ('a -> t) -> 'a array -> t
(** @since NEXT_RELEASE *)

val parens : t -> t
(** @since NEXT_RELEASE *)

val braces : t -> t
(** @since NEXT_RELEASE *)

val brackets : t -> t
(** Adds '[' ']' around the term
@since NEXT_RELEASE *)

val angles : t -> t
(** Adds '<' '>' around the term
@since NEXT_RELEASE *)
end

(** Simple colors in terminals *)
Expand All @@ -282,3 +304,43 @@ module Term_color : sig
val color : color -> t -> t
val style_l : style list -> t -> t
end

(** @since NEXT_RELEASE *)
module Char : sig
val bang : t
val at : t
val hash : t
val dollar : t
val tilde : t
val backquote : t
val percent : t
val caret : t
val ampersand : t
val star : t
val minus : t
val underscore : t
val plus : t
val equal : t
val pipe : t
val slash : t
val backslash : t
val colon : t
val semi : t
val guillemet : t
val quote : t
val comma : t
val dot : t
val question : t
val lparen : t
val rparen : t
val lbrace : t
val rbrace : t
val lbracket : t
val rbracket : t
val langle : t
val rangle : t
end

val surround : ?width:int -> t -> t -> t -> t
(** Generalization of {!bracket}
@since NEXT_RELEASE *)

0 comments on commit 65fc920

Please sign in to comment.