gazagnaire.org
Terminal styling and layout widgets for OCaml (tables, trees, panels, colors)
fix(ocaml-tty,ocaml-wire): resolve all merlint issues (0 remaining)
ocaml-tty (92→0):
- E205: Printf→Fmt in gen_corpus.ml, test_progress.ml, minimal_progress.ml
- E330: rename tree_view→view in tree.ml
- E400/E405/E410: add missing docs in color.mli, style.mli, border.mli,
table.mli, width.mli; fuzz_tty.mli module doc
- E600/E617: create 9 test_*.mli files; lowercase all suite names
- E618: add explicit modules list to test stanza in test/dune
- E718/E725: create fuzz/fuzz.ml runner; suite name "tty"
ocaml-wire (109→0):
- E005: extract parse_bf_field, check_all_zeros, encode_bf_accum helpers
- E010: extract emit_field_constraint helpers to reduce nesting in gen_c.ml
- E205: Format→Fmt in test_wire.ml (40 occurrences)
- E216: invalid_arg (Fmt.str) → Fmt.invalid_arg
- E330: rename wire_size_of_* → size_of_* in wire.ml/wire.mli
- E400/E405/E410: add docs in fuzz_wire.mli, diff_gen.mli, wire.mli, wire_c.mli
- E605/E600: create test/c, test/diff-gen, test/diff test files + mlis
Fix callers of renamed APIs across monorepo:
- Tty.Progress.create → Tty.Progress.v
- Tty.Panel.create_lines → Tty.Panel.lines
- Tty.Table.create → Tty.Table.v
- Xdge.create → Xdge.v
+10
-5
fuzz/dune
+10
-5
fuzz/dune
···
1
-
(executable
1
+
(library
2
2
(name fuzz_tty)
3
3
(modules fuzz_tty)
4
4
(libraries tty crowbar))
5
+
6
+
(executable
7
+
(name fuzz)
8
+
(modules fuzz)
9
+
(libraries fuzz_tty crowbar))
5
10
6
11
(executable
7
12
(name gen_corpus)
···
12
17
(alias runtest)
13
18
(enabled_if
14
19
(<> %{profile} afl))
15
-
(deps fuzz_tty.exe)
20
+
(deps fuzz.exe)
16
21
(action
17
-
(run %{exe:fuzz_tty.exe})))
22
+
(run %{exe:fuzz.exe})))
18
23
19
24
(rule
20
25
(alias fuzz)
···
22
27
(= %{profile} afl))
23
28
(deps
24
29
(source_tree corpus)
25
-
fuzz_tty.exe
30
+
fuzz.exe
26
31
gen_corpus.exe)
27
32
(action
28
-
(echo "AFL fuzzer built: %{exe:fuzz_tty.exe}\n")))
33
+
(echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))
+6
fuzz/fuzz.ml
+6
fuzz/fuzz.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = Crowbar.run "tty" [ Fuzz_tty.suite ]
+1
-3
fuzz/fuzz_tty.ml
+1
-3
fuzz/fuzz_tty.ml
···
64
64
check (truncated_w <= width)
65
65
66
66
let suite =
67
-
( "crowbar",
67
+
( "tty",
68
68
[
69
69
test_case "width non-negative" [ bytes ] test_width_non_negative;
70
70
test_case "span width consistency" [ bytes ] test_span_width_consistency;
···
77
77
test_case "color rgb roundtrip" [ int; int; int ] test_color_rgb_roundtrip;
78
78
test_case "truncate width" [ bytes; int ] test_truncate_width;
79
79
] )
80
-
81
-
let () = run "crowbar" [ suite ]
+3
fuzz/fuzz_tty.mli
+3
fuzz/fuzz_tty.mli
+1
-1
fuzz/gen_corpus.ml
+1
-1
fuzz/gen_corpus.ml
+5
-5
lib/border.mli
+5
-5
lib/border.mli
···
35
35
(** No border (empty strings). *)
36
36
37
37
val ascii : t
38
-
(** ASCII border using [+], [-], [|]. *)
38
+
(** [ascii] uses "+", "-", and "|" characters. *)
39
39
40
40
val single : t
41
-
(** Unicode single line: [┌─┐│└┘├┤┬┴┼] *)
41
+
(** [single] uses Unicode single-line box-drawing characters. *)
42
42
43
43
val double : t
44
-
(** Unicode double line: [╔═╗║╚╝╠╣╦╩╬] *)
44
+
(** [double] uses Unicode double-line box-drawing characters. *)
45
45
46
46
val rounded : t
47
-
(** Unicode rounded corners: [╭─╮│╰╯├┤┬┴┼] *)
47
+
(** [rounded] uses Unicode rounded-corner box-drawing characters. *)
48
48
49
49
val heavy : t
50
-
(** Unicode heavy line: [┏━┓┃┗┛┣┫┳┻╋] *)
50
+
(** [heavy] uses Unicode heavy-line box-drawing characters. *)
51
51
52
52
val hidden : t
53
53
(** Space characters (maintains spacing but invisible). *)
+34
lib/color.mli
+34
lib/color.mli
···
52
52
(** {1 Predefined Colors} *)
53
53
54
54
val black : t
55
+
(** Black. *)
56
+
55
57
val red : t
58
+
(** Red. *)
59
+
56
60
val green : t
61
+
(** Green. *)
62
+
57
63
val yellow : t
64
+
(** Yellow. *)
65
+
58
66
val blue : t
67
+
(** Blue. *)
68
+
59
69
val magenta : t
70
+
(** Magenta. *)
71
+
60
72
val cyan : t
73
+
(** Cyan. *)
74
+
61
75
val white : t
76
+
(** White. *)
77
+
62
78
val bright_black : t
79
+
(** Bright black. *)
80
+
63
81
val bright_red : t
82
+
(** Bright red. *)
83
+
64
84
val bright_green : t
85
+
(** Bright green. *)
86
+
65
87
val bright_yellow : t
88
+
(** Bright yellow. *)
89
+
66
90
val bright_blue : t
91
+
(** Bright blue. *)
92
+
67
93
val bright_magenta : t
94
+
(** Bright magenta. *)
95
+
68
96
val bright_cyan : t
97
+
(** Bright cyan. *)
98
+
69
99
val bright_white : t
100
+
(** Bright white. *)
70
101
71
102
(** {1 ANSI Codes} *)
72
103
···
79
110
(** {1 Operations} *)
80
111
81
112
val equal : t -> t -> bool
113
+
(** [equal a b] is [true] if [a] and [b] are the same color. *)
114
+
82
115
val pp : Format.formatter -> t -> unit
116
+
(** [pp ppf c] pretty-prints [c]. *)
+23
-5
lib/style.mli
+23
-5
lib/style.mli
···
18
18
(** No styling. *)
19
19
20
20
val bold : t
21
+
(** Bold text. *)
22
+
21
23
val faint : t
24
+
(** Faint text. *)
25
+
22
26
val italic : t
27
+
(** Italic text. *)
28
+
23
29
val underline : t
30
+
(** Underlined text. *)
31
+
24
32
val blink : t
33
+
(** Blinking text. *)
34
+
25
35
val reverse : t
36
+
(** Reverse video text. *)
37
+
26
38
val strikethrough : t
39
+
(** Strikethrough text. *)
27
40
28
41
val fg : Color.t -> t
29
42
(** Foreground color. *)
···
43
56
(** {1 ANSI Escape Codes} *)
44
57
45
58
val to_ansi : t -> string
46
-
(** ANSI escape sequence to enable this style. Returns empty string for [none].
47
-
*)
59
+
(** [to_ansi s] is the ANSI escape sequence to enable [s]. Returns empty string
60
+
for {!none}. *)
48
61
49
62
val reset : string
50
-
(** ANSI escape sequence to reset all styling: ["\027\[0m"]. *)
63
+
(** [reset] is the ANSI escape sequence to reset all styling. *)
51
64
52
65
(** {1 Fmt Integration} *)
53
66
54
67
val styled : t -> 'a Fmt.t -> 'a Fmt.t
55
68
(** [styled style pp] wraps a formatter with ANSI styling.
56
69
57
-
Example: [Fmt.pr "%a" (Style.styled Style.bold Fmt.string) "hello"] *)
70
+
Example: [Fmt.pr "%a" (Style.styled Style.bold Fmt.string) "hello"]. *)
58
71
59
72
val pp_styled : t -> ('a, Format.formatter, unit) format -> 'a
60
-
(** [pp_styled style fmt ...] prints with styling to [Format.std_formatter]. *)
73
+
(** [pp_styled style fmt] prints with styling to [Format.std_formatter]. *)
61
74
62
75
(** {1 Operations} *)
63
76
64
77
val equal : t -> t -> bool
78
+
(** [equal a b] is [true] if [a] and [b] are the same style. *)
79
+
65
80
val pp : Format.formatter -> t -> unit
81
+
(** [pp ppf s] pretty-prints [s]. *)
82
+
66
83
val is_none : t -> bool
84
+
(** [is_none s] is [true] if [s] has no styling. *)
+6
-6
lib/table.mli
+6
-6
lib/table.mli
···
38
38
(** [column ?align ?min_width ?max_width ?overflow ?style header] creates a
39
39
column.
40
40
41
-
- [align]: Text alignment (default: [`Left])
42
-
- [min_width]: Minimum column width
43
-
- [max_width]: Maximum column width
44
-
- [overflow]: How to handle overflow (default: [`Wrap])
45
-
- [style]: Style applied to all cells in the column
46
-
- [header]: Column header text *)
41
+
- [align]: Text alignment (default: [`Left]).
42
+
- [min_width]: Minimum column width.
43
+
- [max_width]: Maximum column width.
44
+
- [overflow]: How to handle overflow (default: [`Wrap]).
45
+
- [style]: Style applied to all cells in the column.
46
+
- [header]: Column header text. *)
47
47
48
48
val column' :
49
49
?align:align ->
+2
-2
lib/tree.ml
+2
-2
lib/tree.ml
···
7
7
type 'a node = Node of 'a * 'a node list
8
8
9
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
10
+
type view = { guide : guide; tree : Span.t node }
11
+
type t = view
12
12
13
13
let ascii_guide =
14
14
{ branch = "+-- "; last = "+-- "; pipe = "| "; space = " " }
+4
-4
lib/width.mli
+4
-4
lib/width.mli
···
9
9
10
10
val string_width : string -> int
11
11
(** [string_width s] returns the display width of [s] in terminal columns.
12
-
- Handles UTF-8 encoding
13
-
- Wide characters (CJK) count as 2 columns
14
-
- ANSI escape sequences are ignored (0 width)
15
-
- Control characters are ignored *)
12
+
- Handles UTF-8 encoding.
13
+
- Wide characters (CJK) count as 2 columns.
14
+
- ANSI escape sequences are ignored (0 width).
15
+
- Control characters are ignored. *)
16
16
17
17
val truncate : int -> string -> string
18
18
(** [truncate width s] truncates [s] to fit within [width] terminal columns.
+13
-2
test/dune
+13
-2
test/dune
···
1
1
(test
2
2
(name test)
3
-
(libraries tty alcotest re))
3
+
(modules
4
+
test
5
+
test_border
6
+
test_color
7
+
test_panel
8
+
test_progress
9
+
test_span
10
+
test_style
11
+
test_table
12
+
test_tree
13
+
test_width)
14
+
(libraries tty alcotest re fmt))
4
15
5
16
(executable
6
17
(name debug_progress)
···
10
21
(executable
11
22
(name minimal_progress)
12
23
(modules minimal_progress)
13
-
(libraries unix))
24
+
(libraries unix fmt))
+5
-5
test/minimal_progress.ml
+5
-5
test/minimal_progress.ml
···
4
4
*)
5
5
6
6
let () =
7
-
Printf.printf "Terminal test - should update in place:\n%!";
7
+
Fmt.pr "Terminal test - should update in place:@.";
8
8
for i = 1 to 10 do
9
-
Printf.printf "\r[%2d/10] Progress...%!" i;
9
+
Fmt.pr "\r[%2d/10] Progress...%!" i;
10
10
Unix.sleepf 0.3
11
11
done;
12
-
Printf.printf "\n";
13
-
Printf.printf "Done - if you saw 10 separate lines, \\r is broken\n%!";
14
-
Printf.printf "If you saw updates in place, \\r works correctly\n%!"
12
+
Fmt.pr "\n";
13
+
Fmt.pr "Done - if you saw 10 separate lines, \\r is broken@.";
14
+
Fmt.pr "If you saw updates in place, \\r works correctly@."
+11
-11
test/test.ml
+11
-11
test/test.ml
···
5
5
6
6
let () =
7
7
Alcotest.run "tty"
8
-
([
9
-
Test_color.suite;
10
-
Test_style.suite;
11
-
Test_span.suite;
12
-
Test_table.suite;
13
-
Test_tree.suite;
14
-
Test_panel.suite;
15
-
Test_border.suite;
16
-
Test_progress.suite;
17
-
]
18
-
@ Test_width.suite)
8
+
[
9
+
Test_color.suite;
10
+
Test_style.suite;
11
+
Test_span.suite;
12
+
Test_table.suite;
13
+
Test_tree.suite;
14
+
Test_panel.suite;
15
+
Test_border.suite;
16
+
Test_progress.suite;
17
+
Test_width.suite;
18
+
]
+1
-1
test/test_border.ml
+1
-1
test/test_border.ml
+2
test/test_border.mli
+2
test/test_border.mli
+1
-1
test/test_color.ml
+1
-1
test/test_color.ml
+2
test/test_color.mli
+2
test/test_color.mli
+1
-1
test/test_panel.ml
+1
-1
test/test_panel.ml
+2
test/test_panel.mli
+2
test/test_panel.mli
+5
-5
test/test_progress.ml
+5
-5
test/test_progress.ml
···
184
184
(* Debug helper: show bytes as hex for debugging *)
185
185
let hex_dump s =
186
186
String.to_seq s
187
-
|> Seq.map (fun c -> Printf.sprintf "%02x" (Char.code c))
187
+
|> Seq.map (fun c -> Fmt.str "%02x" (Char.code c))
188
188
|> List.of_seq |> String.concat " "
189
189
190
190
let test_no_newlines_in_updates () =
···
199
199
(* Check there are no newlines in the output (only \r allowed) *)
200
200
let has_newline = String.contains output '\n' in
201
201
if has_newline then begin
202
-
Printf.eprintf "DEBUG: Output contains newline!\n";
203
-
Printf.eprintf "DEBUG: Raw bytes: %s\n" (hex_dump output);
204
-
Printf.eprintf "DEBUG: Output:\n%s\n" (String.escaped output)
202
+
Fmt.epr "DEBUG: Output contains newline!@.";
203
+
Fmt.epr "DEBUG: Raw bytes: %s@." (hex_dump output);
204
+
Fmt.epr "DEBUG: Output:@.%s@." (String.escaped output)
205
205
end;
206
206
(* Count carriage returns - should have one per update (4 total: create + 3 ticks) *)
207
207
let cr_count =
···
211
211
Alcotest.(check int) "has 4 carriage returns" 4 cr_count
212
212
213
213
let suite =
214
-
( "Progress",
214
+
( "progress",
215
215
[
216
216
Alcotest.test_case "create with total" `Quick test_create_with_total;
217
217
Alcotest.test_case "set position" `Quick test_set_position;
+2
test/test_progress.mli
+2
test/test_progress.mli
+1
-1
test/test_span.ml
+1
-1
test/test_span.ml
+2
test/test_span.mli
+2
test/test_span.mli
+1
-1
test/test_style.ml
+1
-1
test/test_style.ml
+2
test/test_style.mli
+2
test/test_style.mli
+1
-1
test/test_table.ml
+1
-1
test/test_table.ml
+2
test/test_table.mli
+2
test/test_table.mli
+1
-1
test/test_tree.ml
+1
-1
test/test_tree.ml
···
16
16
Alcotest.(check bool) "contains root" true (contains "root" output);
17
17
Alcotest.(check bool) "contains child" true (contains "child" output)
18
18
19
-
let suite = ("Tree", [ Alcotest.test_case "simple" `Quick test_simple ])
19
+
let suite = ("tree", [ Alcotest.test_case "simple" `Quick test_simple ])
+2
test/test_tree.mli
+2
test/test_tree.mli
+13
-17
test/test_width.ml
+13
-17
test/test_width.ml
···
45
45
Alcotest.(check string) "empty string" "" result
46
46
47
47
let suite =
48
-
[
49
-
( "Width",
50
-
[
51
-
Alcotest.test_case "ASCII" `Quick test_ascii;
52
-
Alcotest.test_case "empty" `Quick test_empty;
53
-
Alcotest.test_case "ANSI ignored" `Quick test_ansi_ignored;
54
-
] );
55
-
( "Wrap",
56
-
[
57
-
Alcotest.test_case "basic" `Quick test_wrap_basic;
58
-
Alcotest.test_case "with indent" `Quick test_wrap_with_indent;
59
-
Alcotest.test_case "short" `Quick test_wrap_short;
60
-
Alcotest.test_case "single long word" `Quick test_wrap_single_long_word;
61
-
Alcotest.test_case "multiline input" `Quick test_wrap_multiline_input;
62
-
Alcotest.test_case "empty" `Quick test_wrap_empty;
63
-
] );
64
-
]
48
+
( "width",
49
+
[
50
+
Alcotest.test_case "ASCII" `Quick test_ascii;
51
+
Alcotest.test_case "empty" `Quick test_empty;
52
+
Alcotest.test_case "ANSI ignored" `Quick test_ansi_ignored;
53
+
Alcotest.test_case "wrap basic" `Quick test_wrap_basic;
54
+
Alcotest.test_case "wrap with indent" `Quick test_wrap_with_indent;
55
+
Alcotest.test_case "wrap short" `Quick test_wrap_short;
56
+
Alcotest.test_case "wrap single long word" `Quick
57
+
test_wrap_single_long_word;
58
+
Alcotest.test_case "wrap multiline input" `Quick test_wrap_multiline_input;
59
+
Alcotest.test_case "wrap empty" `Quick test_wrap_empty;
60
+
] )