Skip to content

Commit f84c597

Browse files
jeremiediminojeremiedimino
committed
initial import
Signed-off-by: Jeremie Dimino <[email protected]>
0 parents  commit f84c597

File tree

11 files changed

+467
-0
lines changed

11 files changed

+467
-0
lines changed

‎.gitignore

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
_opam
2+
_build
3+
*.install
4+
.merlin

‎.ocamlformat

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
version=0.13.0
2+
break-separators=before
3+
dock-collection-brackets=false
4+
break-sequences=true
5+
doc-comments=before
6+
field-space=loose
7+
let-and=sparse
8+
sequence-style=terminator
9+
type-decl=sparse
10+
wrap-comments=true
11+
if-then-else=k-r
12+
let-and=sparse
13+
space-around-records
14+
space-around-lists
15+
space-around-arrays
16+
cases-exp-indent=2
17+
break-cases=all
18+
indicate-nested-or-patterns=unsafe-no
19+
parse-docstrings=true

‎LICENSE.md

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
The MIT License
2+
3+
Copyright (c) 2016 Jane Street Group, LLC <[email protected]>
4+
5+
Permission is hereby granted, free of charge, to any person obtaining a copy
6+
of this software and associated documentation files (the "Software"), to deal
7+
in the Software without restriction, including without limitation the rights
8+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+
copies of the Software, and to permit persons to whom the Software is
10+
furnished to do so, subject to the following conditions:
11+
12+
The above copyright notice and this permission notice shall be included in all
13+
copies or substantial portions of the Software.
14+
15+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21+
SOFTWARE.

‎Makefile

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
2+
3+
default:
4+
dune build
5+
6+
test:
7+
dune runtest
8+
9+
install:
10+
dune install $(INSTALL_ARGS)
11+
12+
uninstall:
13+
dune uninstall $(INSTALL_ARGS)
14+
15+
reinstall: uninstall install
16+
17+
clean:
18+
dune clean
19+
20+
.PHONY: default install uninstall reinstall clean

‎dune-project

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
(lang dune 2.0)
2+
(name pp)
3+
4+
(license MIT)
5+
(maintainers "Jeremie Dimino <[email protected]>")
6+
(authors
7+
"Jane Street Group, LLC <[email protected]>"
8+
"Jeremie Dimino <[email protected]>")
9+
(source (github diml/pp))
10+
(documentation "https://diml.github.io/pp/")
11+
12+
(generate_opam_files true)
13+
14+
(package
15+
(name pp)
16+
(depends
17+
(ocaml (>= 4.04.0))
18+
(ppx_expect :with-test))
19+
(synopsis "Pretty-printing")
20+
(description "
21+
This library provides minimal support for Canonical S-expressions
22+
[1]. Canonical S-expressions are a binary encoding of S-expressions
23+
that is super simple and well suited for communication between
24+
programs.
25+
26+
This library only provides a few helpers for simple applications. If
27+
you need more advanced support, such as parsing from more fancy input
28+
sources, you should consider copying the code of this library given
29+
how simple parsing S-expressions in canonical form is.
30+
31+
To avoid a dependency on a particular S-expression library, the only
32+
module of this library is parameterised by the type of S-expressions.
33+
34+
[1] https://en.wikipedia.org/wiki/Canonical_S-expressions
35+
"))

‎pp.opam

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
# This file is generated by dune, edit dune-project instead
2+
opam-version: "2.0"
3+
synopsis: "Pretty-printing"
4+
description: """
5+
6+
This library provides minimal support for Canonical S-expressions
7+
[1]. Canonical S-expressions are a binary encoding of S-expressions
8+
that is super simple and well suited for communication between
9+
programs.
10+
11+
This library only provides a few helpers for simple applications. If
12+
you need more advanced support, such as parsing from more fancy input
13+
sources, you should consider copying the code of this library given
14+
how simple parsing S-expressions in canonical form is.
15+
16+
To avoid a dependency on a particular S-expression library, the only
17+
module of this library is parameterised by the type of S-expressions.
18+
19+
[1] https://en.wikipedia.org/wiki/Canonical_S-expressions
20+
"""
21+
maintainer: ["Jeremie Dimino <[email protected]>"]
22+
authors: [
23+
"Jane Street Group, LLC <[email protected]>"
24+
"Jeremie Dimino <[email protected]>"
25+
]
26+
license: "MIT"
27+
homepage: "https://github.com/diml/pp"
28+
doc: "https://diml.github.io/pp/"
29+
bug-reports: "https://github.com/diml/pp/issues"
30+
depends: [
31+
"dune" {>= "2.0"}
32+
"ocaml" {>= "4.04.0"}
33+
"ppx_expect" {with-test}
34+
]
35+
build: [
36+
["dune" "subst"] {pinned}
37+
[
38+
"dune"
39+
"build"
40+
"-p"
41+
name
42+
"-j"
43+
jobs
44+
"@install"
45+
"@runtest" {with-test}
46+
"@doc" {with-doc}
47+
]
48+
]
49+
dev-repo: "git+https://github.com/diml/pp.git"

‎src/dune

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
(library
2+
(public_name pp))

‎src/pp.ml

Lines changed: 168 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,168 @@
1+
module List = Stdlib.ListLabels
2+
module String = Stdlib.StringLabels
3+
4+
type +'a t =
5+
| Nop
6+
| Seq of 'a t * 'a t
7+
| Concat of 'a t * 'a t list
8+
| Box of int * 'a t
9+
| Vbox of int * 'a t
10+
| Hbox of 'a t
11+
| Hvbox of int * 'a t
12+
| Hovbox of int * 'a t
13+
| Verbatim of string
14+
| Char of char
15+
| Break of int * int
16+
| Newline
17+
| Text of string
18+
| Tag of 'a * 'a t
19+
20+
let rec map_tags t ~f =
21+
match t with
22+
| Nop -> Nop
23+
| Seq (a, b) -> Seq (map_tags a ~f, map_tags b ~f)
24+
| Concat (sep, l) -> Concat (map_tags sep ~f, List.map l ~f:(map_tags ~f))
25+
| Box (indent, t) -> Box (indent, map_tags t ~f)
26+
| Vbox (indent, t) -> Vbox (indent, map_tags t ~f)
27+
| Hbox t -> Hbox (map_tags t ~f)
28+
| Hvbox (indent, t) -> Hvbox (indent, map_tags t ~f)
29+
| Hovbox (indent, t) -> Hovbox (indent, map_tags t ~f)
30+
| (Verbatim _ | Char _ | Break _ | Newline | Text _) as t -> t
31+
| Tag (tag, t) -> Tag (f tag, map_tags t ~f)
32+
33+
let rec filter_map_tags t ~f =
34+
match t with
35+
| Nop -> Nop
36+
| Seq (a, b) -> Seq (filter_map_tags a ~f, filter_map_tags b ~f)
37+
| Concat (sep, l) ->
38+
Concat (filter_map_tags sep ~f, List.map l ~f:(filter_map_tags ~f))
39+
| Box (indent, t) -> Box (indent, filter_map_tags t ~f)
40+
| Vbox (indent, t) -> Vbox (indent, filter_map_tags t ~f)
41+
| Hbox t -> Hbox (filter_map_tags t ~f)
42+
| Hvbox (indent, t) -> Hvbox (indent, filter_map_tags t ~f)
43+
| Hovbox (indent, t) -> Hovbox (indent, filter_map_tags t ~f)
44+
| (Verbatim _ | Char _ | Break _ | Newline | Text _) as t -> t
45+
| Tag (tag, t) -> (
46+
let t = filter_map_tags t ~f in
47+
match f tag with
48+
| None -> t
49+
| Some tag -> Tag (tag, t) )
50+
51+
module Render = struct
52+
open Format
53+
54+
let rec render ppf t ~tag_handler =
55+
match t with
56+
| Nop -> ()
57+
| Seq (a, b) ->
58+
render ppf ~tag_handler a;
59+
render ppf ~tag_handler b
60+
| Concat (_, []) -> ()
61+
| Concat (sep, x :: l) ->
62+
render ppf ~tag_handler x;
63+
List.iter l ~f:(fun x ->
64+
render ppf ~tag_handler sep;
65+
render ppf ~tag_handler x)
66+
| Box (indent, t) ->
67+
pp_open_box ppf indent;
68+
render ppf ~tag_handler t;
69+
pp_close_box ppf ()
70+
| Vbox (indent, t) ->
71+
pp_open_vbox ppf indent;
72+
render ppf ~tag_handler t;
73+
pp_close_box ppf ()
74+
| Hbox t ->
75+
pp_open_hbox ppf ();
76+
render ppf ~tag_handler t;
77+
pp_close_box ppf ()
78+
| Hvbox (indent, t) ->
79+
pp_open_hvbox ppf indent;
80+
render ppf ~tag_handler t;
81+
pp_close_box ppf ()
82+
| Hovbox (indent, t) ->
83+
pp_open_hovbox ppf indent;
84+
render ppf ~tag_handler t;
85+
pp_close_box ppf ()
86+
| Verbatim x -> pp_print_string ppf x
87+
| Char x -> pp_print_char ppf x
88+
| Break (nspaces, shift) -> pp_print_break ppf nspaces shift
89+
| Newline -> pp_force_newline ppf ()
90+
| Text s -> pp_print_text ppf s
91+
| Tag (tag, t) -> tag_handler ppf tag t
92+
end
93+
94+
let render = Render.render
95+
96+
let rec render_ignore_tags ppf t =
97+
render ppf t ~tag_handler:(fun ppf _tag t -> render_ignore_tags ppf t)
98+
99+
let nop = Nop
100+
101+
let seq a b = Seq (a, b)
102+
103+
let concat ?(sep = Nop) = function
104+
| [] -> Nop
105+
| [ x ] -> x
106+
| l -> Concat (sep, l)
107+
108+
let concat_map ?(sep = Nop) l ~f =
109+
match l with
110+
| [] -> Nop
111+
| [ x ] -> f x
112+
| l -> Concat (sep, List.map l ~f)
113+
114+
let concat_mapi ?(sep = Nop) l ~f =
115+
match l with
116+
| [] -> Nop
117+
| [ x ] -> f 0 x
118+
| l -> Concat (sep, List.mapi l ~f)
119+
120+
let box ?(indent = 0) t = Box (indent, t)
121+
122+
let vbox ?(indent = 0) t = Vbox (indent, t)
123+
124+
let hbox t = Hbox t
125+
126+
let hvbox ?(indent = 0) t = Hvbox (indent, t)
127+
128+
let hovbox ?(indent = 0) t = Hovbox (indent, t)
129+
130+
let verbatim x = Verbatim x
131+
132+
let char x = Char x
133+
134+
let break ~nspaces ~shift = Break (nspaces, shift)
135+
136+
let space = Break (1, 0)
137+
138+
let cut = Break (0, 0)
139+
140+
let newline = Newline
141+
142+
let text s = Text s
143+
144+
let textf fmt = Printf.ksprintf text fmt
145+
146+
let tag tag t = Tag (tag, t)
147+
148+
let enumerate l ~f =
149+
vbox
150+
(concat ~sep:cut
151+
(List.map l ~f:(fun x -> box ~indent:2 (seq (verbatim "- ") (f x)))))
152+
153+
let chain l ~f =
154+
vbox
155+
(concat ~sep:cut
156+
(List.mapi l ~f:(fun i x ->
157+
box ~indent:3
158+
(seq
159+
(verbatim
160+
( if i = 0 then
161+
" "
162+
else
163+
"-> " ))
164+
(f x)))))
165+
166+
module O = struct
167+
let ( ++ ) = seq
168+
end

0 commit comments

Comments
 (0)