swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

72
unikernel/duniverse/pp/.github/workflows/ci.yml vendored Normal file
View file

@ -0,0 +1,72 @@
name: CI
on:
pull_request:
push:
jobs:
build:
strategy:
fail-fast: false
matrix:
os:
- macos-latest
- ubuntu-latest
- windows-latest
ocaml-compiler:
- 5.2.x
- 4.14.x
- 4.13.x
include:
# OCaml 4.12.x: skipping windows (fail)
- ocaml-compiler: 4.12.x
os: ubuntu-latest
- ocaml-compiler: 4.12.x
os: macos-latest
# OCaml 4.11.x: skipping macos & windows (fail)
- ocaml-compiler: 4.11.x
os: ubuntu-latest
# OCaml 4.10.x: skipping windows (fail)
- ocaml-compiler: 4.10.x
os: ubuntu-latest
- ocaml-compiler: 4.10.x
os: macos-latest
# OCaml 4.08.x: skipping macos & windows (fail)
# Keep the minimal version of OCaml in sync in here and `dune-project`
- ocaml-compiler: 4.08.x
os: ubuntu-latest
runs-on: ${{ matrix.os }}
steps:
- name: Set git to use LF
run: |
git config --global core.autocrlf false
git config --global core.eol lf
git config --global core.ignorecase false
- name: Checkout code
uses: actions/checkout@v4
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
- name: Install dependencies
run: opam install . --deps-only --with-doc --with-test --with-dev-setup
- name: Build
run: opam exec -- dune build
- name: Run tests
run: opam exec -- dune runtest
- name: Check for uncommitted changes
run: git diff --exit-code
- name: Lint fmt
uses: ocaml/setup-ocaml/lint-fmt@v3
- name: Lint doc
uses: ocaml/setup-ocaml/lint-doc@v3

4
unikernel/duniverse/pp/.gitignore vendored Normal file
View file

@ -0,0 +1,4 @@
_opam
_build
*.install
.merlin

19
unikernel/duniverse/pp/.ocamlformat Normal file
View file

@ -0,0 +1,19 @@
version=0.26.2
break-separators=before
dock-collection-brackets=false
break-sequences=true
doc-comments=before
field-space=loose
let-and=sparse
sequence-style=terminator
type-decl=sparse
wrap-comments=true
if-then-else=k-r
let-and=sparse
space-around-records
space-around-lists
space-around-arrays
cases-exp-indent=2
break-cases=all
indicate-nested-or-patterns=unsafe-no
parse-docstrings=true

56
unikernel/duniverse/pp/CHANGES.md Normal file
View file

@ -0,0 +1,56 @@
2.0.0
-----
- Prepare release (#21, @mbarbin)
- Upgrade to `ocamlformat.0.26.2`.
- Fmt the code
- Add CI badge to README
- Upgrade GitHub workflow actions dependencies (checkout@v4, setup-ocaml@v3)
- Add more validation steps in CI
- Add `ocamlformat` as dev-setup dependency
- Add `Pp.verbatimf`. (#18, @mbarbin)
- Add `Pp.paragraph` and `Pp.paragraphf` (#19, @Alizter)
- Remove `of_fmt` constructor. (#17, @Alizter)
1.2.0
-----
- Add `Pp.compare` (#9, @Alizter)
1.1.2
-----
- Add `of_fmt` to compose with existing pretty printers written in `Format`
(#1, @Drup).
- Use a tail-recursive `List.map` to fix a stack overflow issue (#3,
@emillon)
- Add `Pp.custom_break` (#4, @gpetiot)
- Add `Ast` sub-module to expose a stable representation for
serialization, allowing to do the rendering in another process (#6,
@rgrinberg)
1.1.1
-----
Replaced by 1.1.2 because of wrong URLs in opam file.
1.1.0
-----
Replaced by 1.1.1 because of missing changelog entries.
1.0.1
-----
- Fix compat with OCaml 4.04
1.0.0
-----
- Initial release

21
unikernel/duniverse/pp/LICENSE.md Normal file
View file

@ -0,0 +1,21 @@
The MIT License
Copyright (c) 2016 Jane Street Group, LLC <opensource@janestreet.com>
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

28
unikernel/duniverse/pp/Makefile Normal file
View file

@ -0,0 +1,28 @@
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
default:
dune build
test:
dune runtest
install:
dune install $(INSTALL_ARGS)
uninstall:
dune uninstall $(INSTALL_ARGS)
reinstall: uninstall install
clean:
dune clean
release:
dune-release tag
dune-release distrib --skip-build --skip-lint --skip-tests -n pp
# See https://github.com/ocamllabs/dune-release/issues/206
DUNE_RELEASE_DELEGATE=github-dune-release-delegate dune-release publish distrib --verbose -n pp
dune-release opam pkg -n pp
dune-release opam submit -n pp
.PHONY: default install uninstall reinstall clean test

185
unikernel/duniverse/pp/README.md Normal file
View file

@ -0,0 +1,185 @@
Pp - Pretty printing
====================
[![CI Status](https://github.com/ocaml-dune/pp/workflows/CI/badge.svg)](https://github.com/ocaml-dune/pp/actions/workflows/ci.yml)
This library provides a lean alternative to the [Format][format]
module of the OCaml standard library. It aims to make it easy for
users to do the right thing. If you have tried `Format` before but
find its API complicated and difficult to use, then `Pp` might be a
good choice for you.
`Pp` uses the same concepts of boxes and break hints, and the final
rendering is done to formatter from the `Format` module. However it
defines its own algebra which I personaly find easier to work with and
reason about. No previous knowledge is required to start using this
library, however the various guides for the `Format` module such as
[this one][format-guide] should be applicable to `Pp` as well.
Examples
--------
```ocaml
# #require "pp";;
# let print pp = Format.printf "%a@." Pp.to_fmt pp;;
val print : 'a Pp.t -> unit = <fun>
# print (Pp.enumerate (List.init 10 Fun.id) ~f:(Pp.textf "%d"));;
- 0
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
# print (Pp.box ~indent:2 (Pp.text
"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed \
do eiusmod tempor incididunt ut labore et dolore magna \
aliqua. Ut enim ad minim veniam, quis nostrud exercitation \
ullamco laboris nisi ut aliquip ex ea commodo \
consequat. Duis aute irure dolor in reprehenderit in \
voluptate velit esse cillum dolore eu fugiat nulla \
pariatur. Excepteur sint occaecat cupidatat non proident, \
sunt in culpa qui officia deserunt mollit anim id est \
laborum."));;
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor
incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis
nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore
eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident,
sunt in culpa qui officia deserunt mollit anim id est laborum.
- : unit = ()
# print
(Pp.vbox
( Pp.box (Pp.text "Error: something went wrong!")
++ Pp.cut
++ Pp.box (Pp.text "Here are a few things you can do:")
++ Pp.cut
++ Pp.enumerate ~f:Fun.id
[ Pp.text
"read the documentation, double check the way you are using \
this software to make sure you are not doing something wrong, \
and hopefully fix the problem on your side and move on"
; Pp.text
"strace furiously the program to try and understand why \
exactly it is trying to do what it is doing"
; Pp.text "report an issue upstream"
; Pp.text "if all else fails"
++ Pp.cut
++ Pp.enumerate ~f:Pp.text
[ "scream loudly at your computer"
; "take a break from your keyboard"
; "clear your head and try again"
]
] ));;
Error: something went wrong!
Here are a few things you can do:
- read the documentation, double check the way you are using this software to
make sure you are not doing something wrong, and hopefully fix the problem on
your side and move on
- strace furiously the program to try and understand why exactly it is trying
to do what it is doing
- report an issue upstream
- if all else fails
- scream loudly at your computer
- take a break from your keyboard
- clear your head and try again
- : unit = ()
```
Resources
---------
As mentioned earlier, [this Format guide][format-guide] can be a good
starting point to understand the pretty-printing mechanics of `Pp`.
Additionally, [Format Unraveled][format-unraveled] is a great resource
for understanding the core mental model of `Format`. And since `Pp`
uses the same concepts as `Format`, it can be a good resource for `Pp`
too.
Note that the Format Unraveled paper discuss some limitations of
`Format` that are due to the fact that it never has the full document
in-memory before rendering it. This does not apply to `Pp` since `Pp`
clearly always construct the full document in-memory. However, since
right now the only way to render a `Pp.t` is via the `Format` module,
the same limitations that apply to `Format` apply to `Pp` as well. We
might add another renderer in the future that does not have these
limitations if there is sufficient incentive to do so.
History
-------
This library comes from the [dune build system][dune]. Initially, to
construct the various messages displayed to the user on the terminal,
dune was mostly using the `Format` module, and in particular the
`Format.fprintf` style format strings. The `Format` API, its concepts
and printf-like format strings are quite complicated and not easy to
grasp at all. It requires quite a bit of learning and practice before
one can be fluent with `Format`.
What is more, it is well known that programmers absolutely "love"
spending time writing good error messages. Hint: this is sarcastic.
The result of all this was terrible and most messages printed by DUne
where badly formatted. So to remedy to the situation we introduced a
`Pp` module in `stdune`, the mini-standard library inside Dune. `Pp`
is completely detached from `Format`, and there is no mention of
`formatter` until the rendering stage. While in the `Pp` world, all we
do is construct a document with various formatting hints.
In the end, the API of `Pp` just makes it easy for someone to do the
right thing. And this makes all the difference. Since then, it has
been easy to construct well formatted error messages for Dune and the
formatting of existing error messages has generally improved.
Once `Pp` was mature enough, we extracted it into its own library so
that it can benefit others.
Interoperability
----------------
It is easy to integrate `Pp` with `Format`. For that, simply use the
`Pp.to_fmt` function. For instance, if you have a value `pp` of type
`_ Pp.t` you can do:
```ocaml
Format.fprintf "... %a ..." Pp.to_fmt pp
```
If you are familiar with the [fmt library][fmt], `Pp.to_fmt` basically
allows you to go from a `'a Pp.t` to a `'a Fmt.t`. The opposite is not
possible; it is not possible to inject arbitrary side-effecting
formatting functions into a `Pp.t`.
If you want to convert `Pp` tags fot `Format` tags, you can use the
function `Pp.to_fmt_with_tags`.
Comparison with other libraries
-------------------------------
This is not an in-depth comparison as I haven't used these libraries
much myself, so this is to be taken with a grain of salt. The below is
basically what I can tell from a quick look at their API. If you know
more and would like to contribute to this comparison, please do so by
opening a PR :)
### Comparison with fmt
The main difference with [fmt][fmt] is that `Fmt.t` is am alias for
`Format.formatter -> 'a -> unit`, while `Pp.t` is an abstract type.
### Comparison with easy-format
The [easy-format library][easy-format] looks much higher-level than
`Pp`. `Pp` still works with boxes and break hints like the `Format`
module, while `easy-format` works with atoms, lists and labelled
nodes.
[format]: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Format.html
[format-unraveled]: https://hal.archives-ouvertes.fr/hal-01503081/file/format-unraveled.pdf
[dune]: https://dune.build
[fmt]: https://erratique.ch/software/fmt
[format-guide]: http://caml.inria.fr/resources/doc/guides/format.en.html
[easy-format]: https://github.com/mjambon/easy-format

41
unikernel/duniverse/pp/dune-project Normal file
View file

@ -0,0 +1,41 @@
(lang dune 2.8)
(name pp)
(version 2.0.0)
(license MIT)
(maintainers "Jeremie Dimino <jeremie@dimino.org>")
(authors
"Jane Street Group, LLC <opensource@janestreet.com>"
"Jeremie Dimino <jeremie@dimino.org>")
(source (github ocaml-dune/pp))
(documentation "https://ocaml-dune.github.io/pp/")
(generate_opam_files true)
(package
(name pp)
(depends
(ocaml (>= 4.08))
(ppx_expect :with-test)
(ocamlformat
(and
:with-dev-setup
(= 0.26.2))))
(synopsis "Pretty-printing library")
(description "
This library provides a lean alternative to the Format [1] module of
the OCaml standard library. It aims to make it easy for users to do
the right thing. If you have tried Format before but find its API
complicated and difficult to use, then Pp might be a good choice for
you.
Pp uses the same concepts of boxes and break hints, and the final
rendering is done to formatter from the Format module. However it
defines its own algebra which some might find easier to work with and
reason about. No previous knowledge is required to start using this
library, however the various guides for the Format module such as this
one [2] should be applicable to Pp as well.
[1]: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Format.html
[2]: http://caml.inria.fr/resources/doc/guides/format.en.html
"))

53
unikernel/duniverse/pp/pp.opam Normal file
View file

@ -0,0 +1,53 @@
version: "2.0.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Pretty-printing library"
description: """
This library provides a lean alternative to the Format [1] module of
the OCaml standard library. It aims to make it easy for users to do
the right thing. If you have tried Format before but find its API
complicated and difficult to use, then Pp might be a good choice for
you.
Pp uses the same concepts of boxes and break hints, and the final
rendering is done to formatter from the Format module. However it
defines its own algebra which some might find easier to work with and
reason about. No previous knowledge is required to start using this
library, however the various guides for the Format module such as this
one [2] should be applicable to Pp as well.
[1]: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Format.html
[2]: http://caml.inria.fr/resources/doc/guides/format.en.html
"""
maintainer: ["Jeremie Dimino <jeremie@dimino.org>"]
authors: [
"Jane Street Group, LLC <opensource@janestreet.com>"
"Jeremie Dimino <jeremie@dimino.org>"
]
license: "MIT"
homepage: "https://github.com/ocaml-dune/pp"
doc: "https://ocaml-dune.github.io/pp/"
bug-reports: "https://github.com/ocaml-dune/pp/issues"
depends: [
"dune" {>= "2.8"}
"ocaml" {>= "4.08"}
"ppx_expect" {with-test}
"ocamlformat" {with-dev-setup & = "0.26.2"}
"odoc" {with-doc}
]
build: [
["dune" "subst"] {dev}
[
"dune"
"build"
"-p"
name
"-j"
jobs
"@install"
"@runtest" {with-test}
"@doc" {with-doc}
]
]
dev-repo: "git+https://github.com/ocaml-dune/pp.git"

2
unikernel/duniverse/pp/src/dune Normal file
View file

@ -0,0 +1,2 @@
(library
(public_name pp))

252
unikernel/duniverse/pp/src/pp.ml Normal file
View file

@ -0,0 +1,252 @@
module List = struct
include ListLabels
let map ~f t = rev (rev_map ~f t)
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
include Ast
let of_ast = Fun.id
let to_ast = Fun.id
type ('a, 'tag) format_string = ('a, unit, string, 'tag t) format4
let rec map_tags t ~f =
match t with
| Nop -> Nop
| Seq (a, b) -> Seq (map_tags a ~f, map_tags b ~f)
| Concat (sep, l) -> Concat (map_tags sep ~f, List.map l ~f:(map_tags ~f))
| Box (indent, t) -> Box (indent, map_tags t ~f)
| Vbox (indent, t) -> Vbox (indent, map_tags t ~f)
| Hbox t -> Hbox (map_tags t ~f)
| Hvbox (indent, t) -> Hvbox (indent, map_tags t ~f)
| Hovbox (indent, t) -> Hovbox (indent, map_tags t ~f)
| (Verbatim _ | Char _ | Break _ | Newline | Text _) as t -> t
| Tag (tag, t) -> Tag (f tag, map_tags t ~f)
let rec filter_map_tags t ~f =
match t with
| Nop -> Nop
| Seq (a, b) -> Seq (filter_map_tags a ~f, filter_map_tags b ~f)
| Concat (sep, l) ->
Concat (filter_map_tags sep ~f, List.map l ~f:(filter_map_tags ~f))
| Box (indent, t) -> Box (indent, filter_map_tags t ~f)
| Vbox (indent, t) -> Vbox (indent, filter_map_tags t ~f)
| Hbox t -> Hbox (filter_map_tags t ~f)
| Hvbox (indent, t) -> Hvbox (indent, filter_map_tags t ~f)
| Hovbox (indent, t) -> Hovbox (indent, filter_map_tags t ~f)
| (Verbatim _ | Char _ | Break _ | Newline | Text _) as t -> t
| Tag (tag, t) -> (
let t = filter_map_tags t ~f in
match f tag with
| None -> t
| Some tag -> Tag (tag, t))
module Render = struct
open Format
let rec render ppf t ~tag_handler =
match t with
| Nop -> ()
| Seq (a, b) ->
render ppf ~tag_handler a;
render ppf ~tag_handler b
| Concat (_, []) -> ()
| Concat (sep, x :: l) ->
render ppf ~tag_handler x;
List.iter l ~f:(fun x ->
render ppf ~tag_handler sep;
render ppf ~tag_handler x)
| Box (indent, t) ->
pp_open_box ppf indent;
render ppf ~tag_handler t;
pp_close_box ppf ()
| Vbox (indent, t) ->
pp_open_vbox ppf indent;
render ppf ~tag_handler t;
pp_close_box ppf ()
| Hbox t ->
pp_open_hbox ppf ();
render ppf ~tag_handler t;
pp_close_box ppf ()
| Hvbox (indent, t) ->
pp_open_hvbox ppf indent;
render ppf ~tag_handler t;
pp_close_box ppf ()
| Hovbox (indent, t) ->
pp_open_hovbox ppf indent;
render ppf ~tag_handler t;
pp_close_box ppf ()
| Verbatim x -> pp_print_string ppf x
| Char x -> pp_print_char ppf x
| Break (fits, breaks) -> pp_print_custom_break ppf ~fits ~breaks
| Newline -> pp_force_newline ppf ()
| Text s -> pp_print_text ppf s
| Tag (tag, t) -> tag_handler ppf tag t
end
let to_fmt_with_tags = Render.render
let rec to_fmt ppf t =
Render.render ppf t ~tag_handler:(fun ppf _tag t -> to_fmt ppf t)
let nop = Nop
let seq a b = Seq (a, b)
let concat ?(sep = Nop) = function
| [] -> Nop
| [ x ] -> x
| l -> Concat (sep, l)
let concat_map ?(sep = Nop) l ~f =
match l with
| [] -> Nop
| [ x ] -> f x
| l -> Concat (sep, List.map l ~f)
let concat_mapi ?(sep = Nop) l ~f =
match l with
| [] -> Nop
| [ x ] -> f 0 x
| l -> Concat (sep, List.mapi l ~f)
let box ?(indent = 0) t = Box (indent, t)
let vbox ?(indent = 0) t = Vbox (indent, t)
let hbox t = Hbox t
let hvbox ?(indent = 0) t = Hvbox (indent, t)
let hovbox ?(indent = 0) t = Hovbox (indent, t)
let verbatim x = Verbatim x
let verbatimf fmt = Printf.ksprintf verbatim fmt
let char x = Char x
let custom_break ~fits ~breaks = Break (fits, breaks)
let break ~nspaces ~shift =
custom_break ~fits:("", nspaces, "") ~breaks:("", shift, "")
let space = break ~nspaces:1 ~shift:0
let cut = break ~nspaces:0 ~shift:0
let newline = Newline
let text s = Text s
let textf (fmt : ('a, 'tag) format_string) = Printf.ksprintf text fmt
let tag tag t = Tag (tag, t)
let paragraph s = hovbox (text s)
let paragraphf (fmt : ('a, 'tag) format_string) = Printf.ksprintf paragraph fmt
let enumerate l ~f =
vbox
(concat ~sep:cut
(List.map l ~f:(fun x -> box ~indent:2 (seq (verbatim "- ") (f x)))))
let chain l ~f =
vbox
(concat ~sep:cut
(List.mapi l ~f:(fun i x ->
box ~indent:3
(seq
(verbatim
(if i = 0 then
" "
else
"-> "))
(f x)))))
module O = struct
let ( ++ ) = seq
end
let compare =
let compare_both (type a b) (f : a -> a -> int) (g : b -> b -> int) (a, b)
(c, d) =
let r = f a c in
if r <> 0 then
r
else
g b d
in
(* Due to 4.08 lower bound, we need to define this here. *)
let rec compare_list a b ~cmp:f : int =
match (a, b) with
| [], [] -> 0
| [], _ :: _ -> -1
| _ :: _, [] -> 1
| x :: a, y :: b -> (
match (f x y : int) with
| 0 -> compare_list a b ~cmp:f
| ne -> ne)
in
fun compare_tag ->
let rec compare x y =
match (x, y) with
| Nop, Nop -> 0
| Nop, _ -> -1
| _, Nop -> 1
| Seq (a, b), Seq (c, d) -> compare_both compare compare (a, b) (c, d)
| Seq _, _ -> -1
| _, Seq _ -> 1
| Concat (a, b), Concat (c, d) ->
compare_both compare (compare_list ~cmp:compare) (a, b) (c, d)
| Concat _, _ -> -1
| _, Concat _ -> 1
| Box (a, b), Box (c, d) -> compare_both Int.compare compare (a, b) (c, d)
| Box _, _ -> -1
| _, Box _ -> 1
| Vbox (a, b), Vbox (c, d) ->
compare_both Int.compare compare (a, b) (c, d)
| Vbox _, _ -> -1
| _, Vbox _ -> 1
| Hbox a, Hbox b -> compare a b
| Hbox _, _ -> -1
| _, Hbox _ -> 1
| Hvbox (a, b), Hvbox (c, d) ->
compare_both Int.compare compare (a, b) (c, d)
| Hvbox _, _ -> -1
| _, Hvbox _ -> 1
| Hovbox (a, b), Hovbox (c, d) ->
compare_both Int.compare compare (a, b) (c, d)
| Hovbox _, _ -> -1
| _, Hovbox _ -> 1
| Verbatim a, Verbatim b -> String.compare a b
| Verbatim _, _ -> -1
| _, Verbatim _ -> 1
| Char a, Char b -> Char.compare a b
| Char _, _ -> -1
| _, Char _ -> 1
| Break (a, b), Break (c, d) ->
let compare (x, y, z) (a, b, c) =
compare_both String.compare
(compare_both Int.compare String.compare)
(x, (y, z))
(a, (b, c))
in
compare_both compare compare (a, b) (c, d)
| Break _, _ -> -1
| _, Break _ -> 1
| Newline, Newline -> 0
| Newline, _ -> -1
| _, Newline -> 1
| Text a, Text b -> String.compare a b
| Text _, _ -> -1
| _, Text _ -> 1
| Tag (a, b), Tag (c, d) -> compare_both compare_tag compare (a, b) (c, d)
in
compare

234
unikernel/duniverse/pp/src/pp.mli Normal file
View file

@ -0,0 +1,234 @@
(** Pretty-printing. *)
(** ['tag t] represents a document that is not yet rendered. The argument ['tag]
is the type of tags in the document. For instance tags might be used for
styles.
If you want to serialise and deserialise this datastructure, you can use the
[Ast.t] type together with the [of_ast] and [to_ast] functions. *)
type +'tag t
(** {1 Basic combinators} *)
(** A pretty printer that prints nothing *)
val nop : 'tag t
(** [seq x y] prints [x] and then [y] *)
val seq : 'tag t -> 'tag t -> 'tag t
(** [concat ?sep l] prints elements in [l] separated by [sep]. [sep] defaults to
[nop]. *)
val concat : ?sep:'tag t -> 'tag t list -> 'tag t
(** Convenience function for [List.map] followed by [concat]. *)
val concat_map : ?sep:'tag t -> 'a list -> f:('a -> 'tag t) -> 'tag t
(** Convenience function for [List.mapi] followed by [concat]. *)
val concat_mapi : ?sep:'tag t -> 'a list -> f:(int -> 'a -> 'tag t) -> 'tag t
(** An indivisible block of text. *)
val verbatim : string -> 'tag t
(** Same as [verbatim] but take a format string as argument. *)
val verbatimf : ('a, unit, string, 'tag t) format4 -> 'a
(** A single character. *)
val char : char -> 'tag t
(** Print a bunch of text. The line may be broken at any spaces in the text. *)
val text : string -> 'tag t
(** Same as [text] but take a format string as argument. *)
val textf : ('a, unit, string, 'tag t) format4 -> 'a
(** {1 Break hints} *)
(** [space] instructs the pretty-printing algorithm that the line may be broken
at this point. If the algorithm decides not to break the line, a single
space will be printed instead.
So for instance [verbatim "x" ++ space ++ verbatim "y"] might produce "x y"
or "x\n<indentation>y". *)
val space : 'tag t
(** [cut] instructs the pretty-printing algorithm that the line may be broken at
this point. If the algorithm decides not to break the line, nothing is
printed instead.
So for instance [verbatim "x" ++ space ++ verbatim "y"] might produce "xy"
or "x\n<indentation>y". *)
val cut : 'tag t
(** [break] is a generalisation of [space] and [cut]. It also instructs the
pretty-printing algorithm that the line may be broken at this point. If it
ends up being broken, [shift] will be added to the indentation level,
otherwise [nspaces] spaces will be printed. [shift] can be negative, in
which case the indentation will be reduced. *)
val break : nspaces:int -> shift:int -> 'tag t
(** [custom_break ~fits:(a, b, c) ~breaks:(x, y, z)] is a generalisation of
[break]. It also instructs the pretty-printing algorithm that the line may
be broken at this point. If it ends up being broken, [x] is printed, the
line breaks, [y] will be added to the indentation level and [z] is printed,
otherwise [a] will be printed, [b] spaces are printed and then [c] is
printed. The indentation [y] can be negative, in which case the indentation
will be reduced. *)
val custom_break :
fits:string * int * string -> breaks:string * int * string -> 'tag t
(** Force a newline to be printed. Usage is discourage since it breaks printing
with boxes. If you need to add breaks to your text, put your items into
[box]es and [concat] with a separating [space] afterwhich wrapping it in a
[vbox]. *)
val newline : 'tag t
(** {1 Boxes} *)
(** Boxes are the basic components to control the layout of the text. Break
hints such as [space] and [cut] may cause the line to be broken, depending
on the splitting rules. Whenever a line is split, the rest of the material
printed in the box is indented with [indent].
You can think of a box with indentation as something with this shape:
{v
######################### <- first line
<indent>#################
<indent>#################
<indent>#################
<indent>#################
v}
And the top left corner of this shape is anchored where the box was
declared. So for instance, the following document:
{[
Pp.verbatim "....." ++ Pp.box ~indent:2 (Pp.text "some long ... text")
]}
would produce:
{v
.....some long ...
text
v} *)
(** Try to put as much as possible on each line. Additionally, a break hint
always break the line if the breaking would reduce the indentation level
inside the box ([break] with negative [shift] value). *)
val box : ?indent:int -> 'tag t -> 'tag t
(** Always break the line when encountering a break hint. *)
val vbox : ?indent:int -> 'tag t -> 'tag t
(** Print everything on one line, no matter what *)
val hbox : 'tag t -> 'tag t
(** If possible, print everything on one line. Otherwise, behave as a [vbox] *)
val hvbox : ?indent:int -> 'tag t -> 'tag t
(** Try to put as much as possible on each line. Basically the same as [box] but
without the rule about breaks with negative [shift] value. *)
val hovbox : ?indent:int -> 'tag t -> 'tag t
(** {1 Tags} *)
(** Tags are arbitrary pieces of information attached to a document. They can be
used to add styles to pretty-printed text, for instance to print to the
terminal with colors. *)
(** [tag x t] Tag the material printed by [t] with [x] *)
val tag : 'tag -> 'tag t -> 'tag t
(** Convert tags in a documents *)
val map_tags : 'from_tag t -> f:('from_tag -> 'to_tag) -> 'to_tag t
(** Convert tags in a documents, possibly removing some tags. *)
val filter_map_tags :
'from_tag t -> f:('from_tag -> 'to_tag option) -> 'to_tag t
(** {1 Convenience functions} *)
(** [paragraph s] is [hovbox (text s)]. This is useful to preserve the structure
of a paragraph of text without worrying about it being broken by a [vbox]. *)
val paragraph : string -> 'tag t
(** [paragraphf s] is [textf s] followed by a [hovbox]. The [textf] version of
[paragraph]. *)
val paragraphf : ('a, unit, string, 'tag t) format4 -> 'a
(** [enumerate l ~f] produces an enumeration of the form:
{v
- item1
- item2
- item3
...
v} *)
val enumerate : 'a list -> f:('a -> 'tag t) -> 'tag t
(** [chain l ~f] is used to print a succession of items that follow each other.
It produces an output of this form:
{v
item1
-> item2
-> item3
...
v} *)
val chain : 'a list -> f:('a -> 'tag t) -> 'tag t
(** {1 Operators} *)
module O : sig
(** Infix operators for [Pp.t] *)
(** Same as [seq] *)
val ( ++ ) : 'tag t -> 'tag t -> 'tag t
end
(** {1 Rendering} *)
(** Render a document to a classic formatter *)
val to_fmt : Format.formatter -> 'tag t -> unit
val to_fmt_with_tags :
Format.formatter
-> 'tag t
-> tag_handler:(Format.formatter -> 'tag -> 'tag t -> unit)
-> unit
(** {1 Ast} *)
module Ast : sig
(** Stable representation of [Pp.t] useful for serialization *)
(** Stable abstract syntax tree for [Pp.t] that can be used for serialization
and deserialization. *)
type +'tag t =
| Nop
| Seq of 'tag t * 'tag t
| Concat of 'tag t * 'tag t list
| Box of int * 'tag t
| Vbox of int * 'tag t
| Hbox of 'tag t
| Hvbox of int * 'tag t
| Hovbox of int * 'tag t
| Verbatim of string
| Char of char
| Break of (string * int * string) * (string * int * string)
| Newline
| Text of string
| Tag of 'tag * 'tag t
end
(** [of_ast t] converts an [Ast.t] to a [Pp.t]. *)
val of_ast : 'tag Ast.t -> 'tag t
(** [to_ast t] converts a [Pp.t] to an [Ast.t]. *)
val to_ast : 'tag t -> 'tag Ast.t
(** {1 Comparison} *)
(** [compare cmp x y] compares [x] and [y] using [cmp] to compare tags. *)
val compare : ('tag -> 'tag -> int) -> 'tag t -> 'tag t -> int

6
unikernel/duniverse/pp/test/dune Normal file
View file

@ -0,0 +1,6 @@
(library
(name pp_tests)
(libraries pp)
(inline_tests)
(preprocess
(pps ppx_expect)))

333
unikernel/duniverse/pp/test/tests.ml Normal file
View file

@ -0,0 +1,333 @@
open StdLabels
open Pp.O
let print pp = Format.printf "%a@." Pp.to_fmt pp
let many n pp = Array.make n pp |> Array.to_list |> Pp.concat ~sep:Pp.space
let xs n = many n (Pp.char 'x')
let ys n = many n (Pp.char 'y')
let%expect_test _ =
let hello_xs n = Pp.text "Hello" ++ Pp.space ++ xs n in
print (Pp.box ~indent:2 (hello_xs 200));
[%expect
{|
Hello 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 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 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
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
|}];
print (Pp.hbox (hello_xs 50));
[%expect
{|
Hello 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
|}];
print (Pp.vbox ~indent:2 (hello_xs 5));
[%expect {|
Hello
x
x
x
x
x
|}];
print (Pp.hvbox ~indent:2 (hello_xs 5));
[%expect {|
Hello x x x x x
|}];
print (Pp.hvbox ~indent:2 (hello_xs 50));
[%expect
{|
Hello
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
|}];
print (Pp.hovbox ~indent:2 (hello_xs 200));
[%expect
{|
Hello 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 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 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
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%expect_test "verbatimf" =
print (Pp.verbatimf "ident%d" 42);
[%expect {| ident42 |}]
(* Difference between box and hovbox *)
let%expect_test _ =
let pp f = f (xs 50 ++ Pp.break ~nspaces:2 ~shift:(-1) ++ xs 10) in
print (pp (Pp.box ~indent:2));
[%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
x x x x x x x x x x
|}];
print (pp (Pp.hovbox ~indent:2));
[%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 x x x x x x x x x x
|}]
let enum_x_and_y = Pp.enumerate [ xs; ys ] ~f:(fun f -> f 50)
let%expect_test _ =
print enum_x_and_y;
[%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
- y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y
y y y y y y y y y y y y
|}]
let%expect_test _ =
print
(Pp.enumerate
[ Pp.enumerate [ "abc"; "def" ] ~f:Pp.text; enum_x_and_y ]
~f:(fun x -> x));
[%expect
{|
- - abc
- def
- - 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
- y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y
y y y y y y y y y y y y y
|}]
let%expect_test _ =
print (Pp.verbatim "....." ++ Pp.box ~indent:2 (xs 50));
[%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 error_example_1 =
Pp.vbox
(Pp.box (Pp.text "Error: something went wrong!")
++ Pp.cut
++ Pp.box (Pp.text "Here are a few things you can do:")
++ Pp.cut
++ Pp.enumerate
~f:(fun x -> x)
[ Pp.text
"read the documentation, double check the way you are using this \
software to make sure you are not doing something wrong, and \
hopefully fix the problem on your side and move on"
; Pp.text
"strace furiously the program to try and understand why exactly \
it is trying to do what it is doing"
; Pp.text "report an issue upstream"
; Pp.text "if all else fails"
++ Pp.cut
++ Pp.enumerate ~f:Pp.text
[ "scream loudly at your computer"
; "take a break from your keyboard"
; "clear your head and try again"
]
])
let%expect_test _ =
print error_example_1;
[%expect
{|
Error: something went wrong!
Here are a few things you can do:
- read the documentation, double check the way you are using this software to
make sure you are not doing something wrong, and hopefully fix the problem
on your side and move on
- strace furiously the program to try and understand why exactly it is trying
to do what it is doing
- report an issue upstream
- if all else fails
- scream loudly at your computer
- take a break from your keyboard
- clear your head and try again |}]
(* Wrap the formatted lines *)
let%expect_test _ =
print
(Pp.hovbox ~indent:2
(Array.make 50 (Pp.char 'x')
|> Array.to_list
|> Pp.concat
~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%expect_test "comparison" =
let x = error_example_1
and y = Pp.hovbox ~indent:2 (xs 200) in
let print x = Printf.printf "comparison result: %d\n" x in
print (Pp.compare (fun _ _ -> 0) x y);
print (Pp.compare (fun _ _ -> 0) x x);
print (Pp.compare (fun _ _ -> 0) y x);
[%expect
{|
comparison result: -1
comparison result: 0
comparison result: 1 |}]
(* The differnces between [Pp.paragraph], [Pp.text], [Pp.verbatim] and box +
[Pp.text] when inside a [Pp.vbox]. *)
let%expect_test "paragraph" =
let lorem =
"Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum \
euismod, nisl eget aliquam ultricies."
in
let seperator text _ =
Pp.vbox
@@ Pp.seq Pp.space
(Pp.hbox
@@ Pp.textf "-< %s >-%s" text
(String.init (20 - String.length text) ~f:(fun _ -> '-')))
in
print @@ Pp.vbox
@@ Pp.concat_map ~sep:Pp.space
~f:(fun f -> f lorem)
[ seperator "verbatim"
; Pp.verbatim
; seperator "text"
; Pp.text
; seperator "paragraph"
; Pp.paragraph
; seperator "hovbox + text"
; (fun x -> Pp.hovbox (Pp.text x))
; seperator "hvbox + text"
; (fun x -> Pp.hvbox (Pp.text x))
; seperator "hbox + text"
; (fun x -> Pp.hbox (Pp.text x))
; seperator "vbox + text"
; (fun x -> Pp.vbox (Pp.text x))
; seperator "box + text"
; (fun x -> Pp.box (Pp.text x))
];
[%expect
{|
-< verbatim >-------------
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum euismod, nisl eget aliquam ultricies.
-< text >-----------------
Lorem
ipsum
dolor
sit
amet,
consectetur
adipiscing
elit.
Vestibulum
euismod,
nisl
eget
aliquam
ultricies.
-< paragraph >------------
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum euismod,
nisl eget aliquam ultricies.
-< hovbox + text >--------
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum euismod,
nisl eget aliquam ultricies.
-< hvbox + text >---------
Lorem
ipsum
dolor
sit
amet,
consectetur
adipiscing
elit.
Vestibulum
euismod,
nisl
eget
aliquam
ultricies.
-< hbox + text >----------
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum euismod, nisl eget aliquam ultricies.
-< vbox + text >----------
Lorem
ipsum
dolor
sit
amet,
consectetur
adipiscing
elit.
Vestibulum
euismod,
nisl
eget
aliquam
ultricies.
-< box + text >-----------
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vestibulum euismod,
nisl eget aliquam ultricies. |}]
let%expect_test "paragraphf" =
print (Pp.paragraphf "Hello World%s" "!");
[%expect {| Hello World! |}]