Pretty example
このコミットが含まれているのは:
コミット
6d46dfc677
3
Makefile
3
Makefile
|
@ -15,6 +15,9 @@ run-reranger:
|
|||
run-stress:
|
||||
dune exec examples/stress.bc
|
||||
|
||||
run-pretty:
|
||||
dune exec examples/pretty.bc
|
||||
|
||||
run-stress.exe:
|
||||
dune exec examples/stress.exe
|
||||
|
||||
|
|
|
@ -17,3 +17,9 @@
|
|||
(name stress)
|
||||
(modules stress)
|
||||
(libraries notty notty.unix nottui nottui-widgets))
|
||||
|
||||
(executable
|
||||
(name pretty)
|
||||
(modules pretty)
|
||||
(libraries nottui-pretty notty notty.unix nottui nottui-widgets))
|
||||
|
||||
|
|
|
@ -0,0 +1,32 @@
|
|||
module P = Nottui_pretty
|
||||
|
||||
let string ?attr text = P.ui (Nottui_widgets.string ?attr text)
|
||||
|
||||
let (^^) = P.(^^)
|
||||
let (^/^) a b = P.(a ^^ break 1 ^^ b)
|
||||
|
||||
|
||||
let doc =
|
||||
List.fold_left (^^) P.empty [
|
||||
P.group (string "This" ^/^ string "is" ^/^ string "pretty.");
|
||||
P.hardline; P.ui (Nottui.Ui.void 0 1); P.hardline;
|
||||
P.group (P.group (string "This" ^/^ string "is") ^/^ string "pretty.");
|
||||
P.hardline; P.ui (Nottui.Ui.void 0 1); P.hardline;
|
||||
P.group (string "This" ^/^ P.group (string "is" ^/^ string "pretty."));
|
||||
]
|
||||
|
||||
let varying_width f =
|
||||
let width = Lwd.var 0 in
|
||||
Lwd.map'
|
||||
(f (Lwd.get width))
|
||||
(fun ui ->
|
||||
Nottui.Ui.size_sensor
|
||||
(fun w _ -> if Lwd.peek width <> w then Lwd.set width w)
|
||||
(Nottui.Ui.resize ~sw:1 ~sh:1 ~w:0 ui))
|
||||
|
||||
let () =
|
||||
Nottui.Ui_loop.run (
|
||||
Nottui_widgets.h_pane
|
||||
(varying_width (Lwd.map (fun width -> P.pretty width doc)))
|
||||
(Lwd.pure Nottui.Ui.empty)
|
||||
)
|
|
@ -354,33 +354,29 @@ let rec pretty (rem: int) (wid : int) = function
|
|||
prefix = s.prefix; body; suffix;
|
||||
}
|
||||
end
|
||||
| Group t ->
|
||||
begin match nonflat_cache t.cache rem wid with
|
||||
| Some ui -> ui
|
||||
| None ->
|
||||
let flat = t.req <= rem in
|
||||
let result =
|
||||
if flat then
|
||||
match pretty_flat t.doc with
|
||||
| Flat_line ui ->
|
||||
Nonflat_line { min_rem = t.req; max_rem = max_int; ui }
|
||||
| Flat_span ui ->
|
||||
Nonflat_span {
|
||||
min_rem = t.req; max_rem = max_int;
|
||||
min_wid = min_int; max_wid = max_int;
|
||||
prefix = ui.prefix;
|
||||
body = ui.body;
|
||||
suffix = ui.suffix;
|
||||
}
|
||||
else
|
||||
match pretty rem wid t.doc with
|
||||
| Nonflat_line ui ->
|
||||
Nonflat_line {ui with max_rem = t.req}
|
||||
| Group t as self ->
|
||||
begin if t.req <= rem then
|
||||
match pretty_flat self with
|
||||
| Flat_line ui ->
|
||||
Nonflat_line { min_rem = t.req; max_rem = max_int; ui }
|
||||
| Flat_span ui ->
|
||||
Nonflat_span {
|
||||
min_rem = t.req; max_rem = max_int;
|
||||
min_wid = min_int; max_wid = max_int;
|
||||
prefix = ui.prefix;
|
||||
body = ui.body;
|
||||
suffix = ui.suffix;
|
||||
}
|
||||
else match nonflat_cache t.cache rem wid with
|
||||
| Some ui -> ui
|
||||
| None ->
|
||||
let result = match pretty rem wid t.doc with
|
||||
| Nonflat_line ui -> Nonflat_line {ui with max_rem = t.req}
|
||||
| Nonflat_span ui ->
|
||||
Nonflat_span {ui with max_rem = t.req}
|
||||
in
|
||||
t.cache <- Cache result;
|
||||
result
|
||||
Nonflat_span {ui with max_rem = mini t.req ui.max_rem}
|
||||
in
|
||||
t.cache <- Cache result;
|
||||
result
|
||||
end
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
|
|
|
@ -0,0 +1,25 @@
|
|||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
synopsis: "A pretty-printer based on PPrint rendering UIs"
|
||||
description: "TODO"
|
||||
maintainer: ["fred@tarides.com"]
|
||||
authors: ["Frédéric Bour"]
|
||||
license: "MIT"
|
||||
homepage: "https://github.com/let-def/lwd"
|
||||
bug-reports: "https://github.com/let-def/lwd/issues"
|
||||
depends: ["dune" "notty" "lwt" "nottui"]
|
||||
build: [
|
||||
["dune" "subst"] {pinned}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "git+https://github.com/let-def/lwd.git"
|
読み込み中…
新しいイシューから参照