Terminal styling and layout widgets for OCaml (tables, trees, panels, colors)
fix(ocaml-tty,ocaml-wire): fix compilation errors from previous agent run
- tree.ml/mli: rename type 'a t → type 'a node to avoid conflict with
abstract type t (renderable tree); update of_tree and v signatures
- wire_c.ml: fix rank-2 polymorphism in emit_schema_tests by using
let pr fmt = Fmt.pf ppf fmt in (syntactic value, can be generalized)
instead of let pr = Fmt.pf ppf in (application, weak type variable)
- fuzz_tty.ml, test_table.ml, debug_progress.ml: update callers to use
Panel.v, Table.v, Progress.v after create → v rename
+57
-72
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+1
-1
fuzz/fuzz_tty.ml
+1
-1
fuzz/fuzz_tty.ml
+4
-4
lib/panel.ml
+4
-4
lib/panel.ml
···
12
12
lines : Span.t list;
13
13
}
14
14
15
-
let create ?(border = Border.rounded) ?title ?subtitle ?(padding = 1) ?width
16
-
content =
15
+
let v ?(border = Border.rounded) ?title ?subtitle ?(padding = 1) ?width content
16
+
=
17
17
let content_str = Span.to_plain_string content in
18
18
let line_strs = String.split_on_char '\n' content_str in
19
19
let lines = List.map Span.text line_strs in
20
20
{ border; title; subtitle; padding; width; lines }
21
21
22
-
let create_lines ?(border = Border.rounded) ?title ?subtitle ?(padding = 1)
23
-
?width lines =
22
+
let lines ?(border = Border.rounded) ?title ?subtitle ?(padding = 1) ?width
23
+
lines =
24
24
{ border; title; subtitle; padding; width; lines }
25
25
26
26
let render_border_char ppf border_style char =
+4
-4
lib/panel.mli
+4
-4
lib/panel.mli
···
14
14
15
15
(** {1 Construction} *)
16
16
17
-
val create :
17
+
val v :
18
18
?border:Border.t ->
19
19
?title:Span.t ->
20
20
?subtitle:Span.t ->
···
22
22
?width:int ->
23
23
Span.t ->
24
24
t
25
-
(** [create ?border ?title ?subtitle ?padding ?width content] creates a panel.
25
+
(** [v ?border ?title ?subtitle ?padding ?width content] creates a panel.
26
26
27
27
- [border]: Border style (default: {!Border.rounded}).
28
28
- [title]: Optional title displayed at the top.
···
30
30
- [padding]: Internal horizontal padding (default: 1).
31
31
- [width]: Fixed width; if not specified, auto-sized to content. *)
32
32
33
-
val create_lines :
33
+
val lines :
34
34
?border:Border.t ->
35
35
?title:Span.t ->
36
36
?subtitle:Span.t ->
···
38
38
?width:int ->
39
39
Span.t list ->
40
40
t
41
-
(** [create_lines] is like {!create} but takes multiple lines of content. *)
41
+
(** [lines] is like {!v} but takes multiple lines of content. *)
42
42
43
43
(** {1 Rendering} *)
44
44
+11
-23
lib/progress.ml
+11
-23
lib/progress.ml
···
86
86
^ (if filled < bar_width then ">" else "")
87
87
^ String.make empty ' '
88
88
89
+
let pad_to_width width s =
90
+
let w = Width.string_width s in
91
+
if w < width then s ^ String.make (width - w) ' ' else s
92
+
89
93
let render ~frame cfg s =
90
94
let pct = if s.total > 0 then min 100 (s.current * 100 / s.total) else 0 in
91
95
let counter = Fmt.str "%d/%d" s.current s.total in
···
111
115
String.make (cfg.width - visible_width) ' '
112
116
else ""
113
117
in
114
-
let colored =
115
-
Fmt.str "%s%s%s ▕%s%s%s▏ %3d%% %s%s%s %s%s" cyan spinner reset_code
116
-
green bar reset_code pct dim counter reset_code display_msg padding
117
-
in
118
-
colored
118
+
Fmt.str "%s%s%s ▕%s%s%s▏ %3d%% %s%s%s %s%s" cyan spinner reset_code green
119
+
bar reset_code pct dim counter reset_code display_msg padding
119
120
| `ASCII ->
120
121
let bar = render_bar_ascii ~bar_width:cfg.bar_width ~pct in
121
122
let spinner = spinner_ascii.(frame mod Array.length spinner_ascii) in
···
127
128
String.sub full_msg 0 (max 0 (max_msg_len - 3)) ^ "..."
128
129
else full_msg
129
130
in
130
-
let line = prefix ^ display_msg in
131
-
let line_width = Width.string_width line in
132
-
let padding =
133
-
if line_width < cfg.width then String.make (cfg.width - line_width) ' '
134
-
else ""
135
-
in
136
-
line ^ padding
131
+
pad_to_width cfg.width (prefix ^ display_msg)
137
132
| `Plain ->
138
133
(* Minimal: no spinner, no colors, just counter and message *)
139
-
let line = Fmt.str "[%3d%%] %s %s" pct counter full_msg in
140
-
let line_width = String.length line in
141
-
let padding =
142
-
if line_width < cfg.width then String.make (cfg.width - line_width) ' '
143
-
else ""
144
-
in
145
-
line ^ padding
134
+
pad_to_width cfg.width (Fmt.str "[%3d%%] %s %s" pct counter full_msg)
146
135
147
136
(** {1 Imperative Wrapper} *)
148
137
···
164
153
(* Use direct stdout when ppf is std_formatter to bypass Format line-breaking *)
165
154
let use_direct = ppf == Format.std_formatter in
166
155
if debug then
167
-
Printf.eprintf
168
-
"[PROGRESS] use_direct=%b is_tty=%b line_bytes=%d line_width=%d\n%!"
156
+
Fmt.epr "[PROGRESS] use_direct=%b is_tty=%b line_bytes=%d line_width=%d\n"
169
157
use_direct (Width.is_tty ()) (String.length line)
170
158
(Width.string_width line);
171
159
(* Use \r\027[K to: move to start of line, clear to end of line *)
···
185
173
Format.pp_set_margin ppf old_margin
186
174
end
187
175
188
-
let create ?(ppf = Format.std_formatter) ?width ?enabled ?(style = `UTF8) ~total
189
-
msg =
176
+
let v ?(ppf = Format.std_formatter) ?width ?enabled ?(style = `UTF8) ~total msg
177
+
=
190
178
let cfg = config ~ppf ?width ~style () in
191
179
let enabled = match enabled with Some e -> e | None -> Width.is_tty () in
192
180
let s = state ~total msg in
+4
-4
lib/progress.mli
+4
-4
lib/progress.mli
···
26
26
Convenient mutable wrapper that handles rendering automatically.
27
27
28
28
{[
29
-
let bar = Progress.create ~total:100 "Downloading" in
29
+
let bar = Progress.v ~total:100 "Downloading" in
30
30
for _ = 1 to 100 do
31
31
Progress.tick bar
32
32
done;
···
36
36
{2 Multi-phase Operations}
37
37
38
38
{[
39
-
let bar = Progress.create ~total:10 "Working" in
39
+
let bar = Progress.v ~total:10 "Working" in
40
40
Progress.update bar ~phase:"Fetch" ~msg:"file1.txt";
41
41
Progress.update bar ~phase:"Build" ~msg:"compiling";
42
42
Progress.finish bar
···
89
89
type t
90
90
(** Mutable progress bar handle. *)
91
91
92
-
val create :
92
+
val v :
93
93
?ppf:Format.formatter ->
94
94
?width:int ->
95
95
?enabled:bool ->
···
97
97
total:int ->
98
98
string ->
99
99
t
100
-
(** [create ~total message] creates and displays a progress bar.
100
+
(** [v ~total message] creates and displays a progress bar.
101
101
102
102
Renders immediately on creation for instant user feedback. When [enabled] is
103
103
false (or not a TTY), no output is produced. *)
+2
-2
lib/table.ml
+2
-2
lib/table.ml
···
30
30
?(style = Style.none) header =
31
31
{ header; align; min_width; max_width; overflow; style }
32
32
33
-
let create ?(border = Border.single) ?(header_style = Style.bold) columns =
33
+
let v ?(border = Border.single) ?(header_style = Style.bold) columns =
34
34
{ border; header_style; columns; rows = [] }
35
35
36
36
let add_row cells t = { t with rows = t.rows @ [ cells ] }
37
37
let add_row_strings strings t = add_row (List.map Span.text strings) t
38
38
39
39
let of_rows ?border ?header_style columns rows =
40
-
let t = create ?border ?header_style columns in
40
+
let t = v ?border ?header_style columns in
41
41
List.fold_left (fun t row -> add_row row t) t rows
42
42
43
43
let of_string_rows ?border ?header_style columns rows =
+2
-2
lib/table.mli
+2
-2
lib/table.mli
···
57
57
58
58
(** {1 Table Construction} *)
59
59
60
-
val create : ?border:Border.t -> ?header_style:Style.t -> column list -> t
61
-
(** [create ?border ?header_style columns] creates an empty table.
60
+
val v : ?border:Border.t -> ?header_style:Style.t -> column list -> t
61
+
(** [v ?border ?header_style columns] creates an empty table.
62
62
63
63
- [border]: Border style (default: {!Border.single})
64
64
- [header_style]: Style for header row (default: bold) *)
+6
-3
lib/tree.ml
+6
-3
lib/tree.ml
···
4
4
---------------------------------------------------------------------------*)
5
5
6
6
type guide = { branch : string; last : string; pipe : string; space : string }
7
-
type 'a tree = Node of 'a * 'a tree list
8
-
type t = { guide : guide; tree : Span.t tree }
7
+
type 'a node = Node of 'a * 'a node list
8
+
9
+
(* Internal record; exposed as abstract [t] in the interface *)
10
+
type tree_view = { guide : guide; tree : Span.t node }
11
+
type t = tree_view
9
12
10
13
let ascii_guide =
11
14
{ branch = "+-- "; last = "+-- "; pipe = "| "; space = " " }
···
15
18
16
19
let of_tree ?(guide = unicode_guide) tree = { guide; tree }
17
20
18
-
let make ?(guide = unicode_guide) f root =
21
+
let v ?(guide = unicode_guide) f root =
19
22
let rec render_fn node = f render_fn node in
20
23
{ guide; tree = render_fn root }
21
24
+5
-5
lib/tree.mli
+5
-5
lib/tree.mli
···
17
17
}
18
18
(** Tree guide characters. *)
19
19
20
-
type 'a tree = Node of 'a * 'a tree list (** A generic tree type. *)
20
+
type 'a node = Node of 'a * 'a node list (** A generic tree node. *)
21
21
22
22
type t
23
23
(** A renderable tree of spans. *)
···
32
32
33
33
(** {1 Construction} *)
34
34
35
-
val of_tree : ?guide:guide -> Span.t tree -> t
35
+
val of_tree : ?guide:guide -> Span.t node -> t
36
36
(** [of_tree ?guide tree] creates a renderable tree from a tree of spans.
37
37
38
38
- [guide]: Guide characters (default: {!unicode_guide}) *)
39
39
40
-
val make : ?guide:guide -> (('a -> Span.t tree) -> 'a -> Span.t tree) -> 'a -> t
41
-
(** [make ?guide f root] creates a tree by recursively applying [f].
40
+
val v : ?guide:guide -> (('a -> Span.t node) -> 'a -> Span.t node) -> 'a -> t
41
+
(** [v ?guide f root] creates a tree by recursively applying [f].
42
42
43
43
The function [f] receives a render function and the current node, and should
44
44
return a tree of spans.
···
48
48
type dir = { name : string; children : dir list }
49
49
50
50
let tree =
51
-
Tree.make
51
+
Tree.v
52
52
(fun render dir ->
53
53
Node (Span.text dir.name, List.map render dir.children))
54
54
root_dir
+3
-9
test/debug_progress.ml
+3
-9
test/debug_progress.ml
···
24
24
Printf.printf "\nDone with test 1\n\n%!";
25
25
26
26
Printf.printf "Test 2: Plain style (no spinner, no colors)\n%!";
27
-
let bar =
28
-
Tty.Progress.create ~style:`Plain ~enabled:true ~total:5 "Ticking"
29
-
in
27
+
let bar = Tty.Progress.v ~style:`Plain ~enabled:true ~total:5 "Ticking" in
30
28
for _ = 1 to 5 do
31
29
Tty.Progress.tick bar;
32
30
Unix.sleepf 0.3
···
35
33
Printf.printf "Done with test 2\n\n%!";
36
34
37
35
Printf.printf "Test 3: ASCII style (spinner, no colors)\n%!";
38
-
let bar2 =
39
-
Tty.Progress.create ~style:`ASCII ~enabled:true ~total:5 "Ticking"
40
-
in
36
+
let bar2 = Tty.Progress.v ~style:`ASCII ~enabled:true ~total:5 "Ticking" in
41
37
for _ = 1 to 5 do
42
38
Tty.Progress.tick bar2;
43
39
Unix.sleepf 0.3
···
46
42
Printf.printf "Done with test 3\n\n%!";
47
43
48
44
Printf.printf "Test 4: UTF8 style (spinner + colors)\n%!";
49
-
let bar3 =
50
-
Tty.Progress.create ~style:`UTF8 ~enabled:true ~total:5 "Ticking"
51
-
in
45
+
let bar3 = Tty.Progress.v ~style:`UTF8 ~enabled:true ~total:5 "Ticking" in
52
46
for _ = 1 to 5 do
53
47
Tty.Progress.tick bar3;
54
48
Unix.sleepf 0.3
+2
-2
test/test_panel.ml
+2
-2
test/test_panel.ml
···
8
8
let contains pattern str = Re.execp (Re.compile (Re.str pattern)) str
9
9
10
10
let test_basic () =
11
-
let panel = Panel.create (Span.text "content") in
11
+
let panel = Panel.v (Span.text "content") in
12
12
let output = Panel.to_string panel in
13
13
Alcotest.(check bool) "contains content" true (contains "content" output)
14
14
15
15
let test_with_title () =
16
-
let panel = Panel.create ~title:(Span.text "Title") (Span.text "body") in
16
+
let panel = Panel.v ~title:(Span.text "Title") (Span.text "body") in
17
17
let output = Panel.to_string panel in
18
18
Alcotest.(check bool) "contains title" true (contains "Title" output);
19
19
Alcotest.(check bool) "contains body" true (contains "body" output)
+11
-11
test/test_progress.ml
+11
-11
test/test_progress.ml
···
10
10
let with_progress_buf ?style ~total ?(width = 80) msg f =
11
11
let buf = Buffer.create 256 in
12
12
let ppf = Format.formatter_of_buffer buf in
13
-
let bar = Progress.create ~ppf ~width ~enabled:true ?style ~total msg in
13
+
let bar = Progress.v ~ppf ~width ~enabled:true ?style ~total msg in
14
14
f bar;
15
15
Format.pp_print_flush ppf ();
16
16
Buffer.contents buf
···
37
37
let test_tick () =
38
38
let buf = Buffer.create 256 in
39
39
let ppf = Format.formatter_of_buffer buf in
40
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:5 "Tick" in
40
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:5 "Tick" in
41
41
Progress.tick bar;
42
42
Progress.tick bar;
43
43
Progress.tick bar;
···
47
47
let test_message_update () =
48
48
let buf = Buffer.create 256 in
49
49
let ppf = Format.formatter_of_buffer buf in
50
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:10 "start" in
50
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:10 "start" in
51
51
Progress.set bar 5;
52
52
Progress.message bar "middle";
53
53
Format.pp_print_flush ppf ();
···
58
58
let test_finish () =
59
59
let buf = Buffer.create 256 in
60
60
let ppf = Format.formatter_of_buffer buf in
61
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:10 "Done" in
61
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:10 "Done" in
62
62
Progress.set bar 5;
63
63
Progress.finish bar;
64
64
Format.pp_print_flush ppf ();
···
68
68
let test_clear () =
69
69
let buf = Buffer.create 256 in
70
70
let ppf = Format.formatter_of_buffer buf in
71
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:10 "Clear" in
71
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:10 "Clear" in
72
72
Progress.set bar 5;
73
73
Progress.clear bar;
74
74
Format.pp_print_flush ppf ();
···
78
78
let test_disabled () =
79
79
let buf = Buffer.create 256 in
80
80
let ppf = Format.formatter_of_buffer buf in
81
-
let bar = Progress.create ~ppf ~width:80 ~enabled:false ~total:10 "Silent" in
81
+
let bar = Progress.v ~ppf ~width:80 ~enabled:false ~total:10 "Silent" in
82
82
Progress.set bar 5;
83
83
Progress.message bar "update";
84
84
Progress.finish bar;
···
130
130
let test_position_tracking () =
131
131
let buf = Buffer.create 256 in
132
132
let ppf = Format.formatter_of_buffer buf in
133
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:100 "Track" in
133
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:100 "Track" in
134
134
Alcotest.(check int) "initial position" 0 (Progress.position bar);
135
135
Progress.set bar 42;
136
136
Alcotest.(check int) "after set" 42 (Progress.position bar);
···
140
140
let test_finish_idempotent () =
141
141
let buf = Buffer.create 256 in
142
142
let ppf = Format.formatter_of_buffer buf in
143
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:10 "Idem" in
143
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:10 "Idem" in
144
144
Progress.finish bar;
145
145
let out1 = Buffer.contents buf in
146
146
Progress.finish bar;
···
161
161
let test_phase () =
162
162
let buf = Buffer.create 256 in
163
163
let ppf = Format.formatter_of_buffer buf in
164
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:10 "msg" in
164
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:10 "msg" in
165
165
Progress.update bar ~phase:"Build" ~msg:"file.ml";
166
166
Format.pp_print_flush ppf ();
167
167
let output = Buffer.contents buf in
···
171
171
let test_reset () =
172
172
let buf = Buffer.create 256 in
173
173
let ppf = Format.formatter_of_buffer buf in
174
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:5 "Phase1" in
174
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:5 "Phase1" in
175
175
Progress.tick bar;
176
176
Progress.tick bar;
177
177
Alcotest.(check int) "position before reset" 2 (Progress.position bar);
···
190
190
let test_no_newlines_in_updates () =
191
191
let buf = Buffer.create 256 in
192
192
let ppf = Format.formatter_of_buffer buf in
193
-
let bar = Progress.create ~ppf ~width:80 ~enabled:true ~total:5 "Test" in
193
+
let bar = Progress.v ~ppf ~width:80 ~enabled:true ~total:5 "Test" in
194
194
Progress.tick bar;
195
195
Progress.tick bar;
196
196
Progress.tick bar;
+1
-1
test/test_table.ml
+1
-1
test/test_table.ml
···
19
19
Alcotest.(check bool) "contains 1" true (contains "1" output)
20
20
21
21
let test_empty () =
22
-
let table = Table.(create [ column "X" ]) in
22
+
let table = Table.(v [ column "X" ]) in
23
23
let output = Table.to_string table in
24
24
Alcotest.(check bool) "contains X" true (contains "X" output)
25
25