Terminal styling and layout widgets for OCaml (tables, trees, panels, colors)
Initial commit: tty library for terminal styling and layout
- Color: ANSI, RGB, hex color support
- Style: Composable styles (bold + fg + underline)
- Span: Styled text spans with concatenation
- Width: UTF-8 aware width calculation
- Border: ASCII and Unicode box-drawing
- Table: Tables with headers and alignment
- Tree: Tree rendering with guides
- Panel: Bordered panels with titles
+2026
+17
.gitignore
+17
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
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.
+102
README.md
+102
README.md
···
1
+
# tty
2
+
3
+
Terminal styling and layout widgets for OCaml CLI applications.
4
+
5
+
## Overview
6
+
7
+
Type-safe terminal styling (colors, bold, italic) and layout widgets
8
+
(tables, trees, panels) inspired by Python's Rich and Go's Charm/lipgloss.
9
+
10
+
## Features
11
+
12
+
- **Composable styles**: `Style.(bold + fg Color.red + underline)`
13
+
- **Full color support**: ANSI 16, 256-color palette, and true color (RGB/hex)
14
+
- **Tables**: Headers, alignment, borders
15
+
- **Trees**: Directory-style tree rendering
16
+
- **Panels**: Bordered boxes with titles
17
+
- **Unicode-aware**: Proper width calculation for CJK and emoji
18
+
19
+
## Installation
20
+
21
+
```
22
+
opam install tty
23
+
```
24
+
25
+
## Usage
26
+
27
+
### Styled Text
28
+
29
+
```ocaml
30
+
open Tty
31
+
32
+
let style = Style.(bold + fg Color.green) in
33
+
Fmt.pr "%a@." (Style.styled style Fmt.string) "Success!"
34
+
```
35
+
36
+
### Tables
37
+
38
+
```ocaml
39
+
open Tty
40
+
41
+
let table = Table.(
42
+
of_rows ~border:Border.rounded
43
+
[ column "Name"; column ~align:`Right "Age" ]
44
+
[ [ Span.text "Alice"; Span.text "30" ];
45
+
[ Span.text "Bob"; Span.text "25" ] ]
46
+
) in
47
+
Table.pp Format.std_formatter table
48
+
```
49
+
50
+
### Trees
51
+
52
+
```ocaml
53
+
open Tty
54
+
55
+
let tree = Tree.of_tree (
56
+
Node (Span.text "src", [
57
+
Node (Span.text "lib", [
58
+
Node (Span.text "tty.ml", []);
59
+
]);
60
+
Node (Span.text "test", []);
61
+
])
62
+
) in
63
+
Tree.pp Format.std_formatter tree
64
+
```
65
+
66
+
### Panels
67
+
68
+
```ocaml
69
+
open Tty
70
+
71
+
let panel = Panel.create
72
+
~title:(Span.text "Status")
73
+
(Span.text "All systems operational") in
74
+
Panel.pp Format.std_formatter panel
75
+
```
76
+
77
+
## API
78
+
79
+
- `Tty.Color` - ANSI, RGB, and hex colors
80
+
- `Tty.Style` - Composable text styles
81
+
- `Tty.Span` - Styled text spans
82
+
- `Tty.Border` - Border styles (ascii, single, double, rounded, heavy)
83
+
- `Tty.Table` - Tables with headers and alignment
84
+
- `Tty.Tree` - Tree rendering with guides
85
+
- `Tty.Panel` - Bordered panels with titles
86
+
87
+
## Related Work
88
+
89
+
- [printbox](https://github.com/c-cube/printbox) - OCaml library for printing
90
+
nested boxes, tables and trees. Simpler style system (8 colors only).
91
+
- [progress](https://github.com/CraigFe/progress) - Terminal progress bars for
92
+
OCaml. Handles live display and progress reporting.
93
+
- [Rich](https://github.com/Textualize/rich) - Python library for rich text and
94
+
beautiful formatting. Primary inspiration for this library.
95
+
- [lipgloss](https://github.com/charmbracelet/lipgloss) - Go library for
96
+
terminal styling. Inspiration for composable style API.
97
+
- [notty](https://github.com/pqwy/notty) - OCaml library for declarative
98
+
terminal graphics. Lower-level, for full TUI applications.
99
+
100
+
## License
101
+
102
+
MIT License. See [LICENSE.md](LICENSE.md) for details.
+26
dune-project
+26
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name tty)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(homepage "https://tangled.org/gazagnaire.org/ocaml-tty")
11
+
(bug_reports "https://tangled.org/gazagnaire.org/ocaml-tty/issues")
12
+
13
+
(package
14
+
(name tty)
15
+
(synopsis "Terminal styling and layout widgets")
16
+
(description
17
+
"Type-safe terminal styling (colors, bold, italic) and layout widgets
18
+
(tables, trees, panels) for OCaml CLI applications. Inspired by
19
+
Python's Rich and Go's Charm/lipgloss.")
20
+
(depends
21
+
(ocaml (>= 5.1))
22
+
(fmt (>= 0.9))
23
+
(uucp (>= 15.0))
24
+
(uutf (>= 1.0))
25
+
(alcotest :with-test)
26
+
(crowbar :with-test)))
+15
fuzz/dune
+15
fuzz/dune
···
1
+
; Crowbar fuzz testing for tty
2
+
;
3
+
; To run: dune exec fuzz/fuzz_tty.exe
4
+
; With AFL: afl-fuzz -i fuzz/corpus -o fuzz/findings -- ./_build/default/fuzz/fuzz_tty.exe @@
5
+
6
+
(executable
7
+
(name fuzz_tty)
8
+
(modules fuzz_tty)
9
+
(libraries tty crowbar))
10
+
11
+
(rule
12
+
(alias fuzz)
13
+
(deps fuzz_tty.exe)
14
+
(action
15
+
(run %{exe:fuzz_tty.exe})))
+77
fuzz/fuzz_tty.ml
+77
fuzz/fuzz_tty.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Crowbar
7
+
open Tty
8
+
9
+
(* Width is always non-negative *)
10
+
let test_width_non_negative s =
11
+
let w = Width.string_width s in
12
+
check (w >= 0)
13
+
14
+
(* Span width matches underlying width *)
15
+
let test_span_width_consistency s =
16
+
let span = Span.text s in
17
+
let span_w = Span.width span in
18
+
let direct_w = Width.string_width s in
19
+
check (span_w = direct_w)
20
+
21
+
(* Span concatenation width is sum of widths *)
22
+
let test_span_concat_width s1 s2 =
23
+
let span1 = Span.text s1 in
24
+
let span2 = Span.text s2 in
25
+
let combined = Span.(span1 ++ span2) in
26
+
let w1 = Span.width span1 in
27
+
let w2 = Span.width span2 in
28
+
let w_combined = Span.width combined in
29
+
check (w_combined = w1 + w2)
30
+
31
+
(* Table rendering doesn't crash *)
32
+
let test_table_render_no_crash headers row =
33
+
if List.length headers > 0 && List.length row > 0 then (
34
+
let cols = List.map Table.column headers in
35
+
let rows = [ List.map Span.text row ] in
36
+
let table = Table.of_rows cols rows in
37
+
let _ = Table.to_string table in
38
+
check true)
39
+
else check true
40
+
41
+
(* Tree rendering doesn't crash *)
42
+
let test_tree_render_no_crash label =
43
+
let tree = Tree.of_tree (Tree.Node (Span.text label, [])) in
44
+
let _ = Tree.to_string tree in
45
+
check true
46
+
47
+
(* Panel rendering doesn't crash *)
48
+
let test_panel_render_no_crash content =
49
+
let panel = Panel.create (Span.text content) in
50
+
let _ = Panel.to_string panel in
51
+
check true
52
+
53
+
(* Color hex parsing and equality *)
54
+
let test_color_rgb_roundtrip r g b =
55
+
let r = r mod 256 in
56
+
let g = g mod 256 in
57
+
let b = b mod 256 in
58
+
let c = Color.rgb r g b in
59
+
let c2 = Color.rgb r g b in
60
+
check (Color.equal c c2)
61
+
62
+
(* Truncate never increases width *)
63
+
let test_truncate_width s width =
64
+
let width = abs width mod 1000 in
65
+
let truncated = Width.truncate width s in
66
+
let truncated_w = Width.string_width truncated in
67
+
check (truncated_w <= width)
68
+
69
+
let () =
70
+
add_test ~name:"width non-negative" [ bytes ] test_width_non_negative;
71
+
add_test ~name:"span width consistency" [ bytes ] test_span_width_consistency;
72
+
add_test ~name:"span concat width" [ bytes; bytes ] test_span_concat_width;
73
+
add_test ~name:"table render" [ list bytes; list bytes ] test_table_render_no_crash;
74
+
add_test ~name:"tree render" [ bytes ] test_tree_render_no_crash;
75
+
add_test ~name:"panel render" [ bytes ] test_panel_render_no_crash;
76
+
add_test ~name:"color rgb roundtrip" [ int; int; int ] test_color_rgb_roundtrip;
77
+
add_test ~name:"truncate width" [ bytes; int ] test_truncate_width
+156
lib/border.ml
+156
lib/border.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type chars = {
7
+
top_left : string;
8
+
top : string;
9
+
top_right : string;
10
+
left : string;
11
+
right : string;
12
+
bottom_left : string;
13
+
bottom : string;
14
+
bottom_right : string;
15
+
cross : string;
16
+
top_cross : string;
17
+
bottom_cross : string;
18
+
left_cross : string;
19
+
right_cross : string;
20
+
}
21
+
22
+
type t = { chars : chars; style : Style.t }
23
+
24
+
let none_chars =
25
+
{
26
+
top_left = "";
27
+
top = "";
28
+
top_right = "";
29
+
left = "";
30
+
right = "";
31
+
bottom_left = "";
32
+
bottom = "";
33
+
bottom_right = "";
34
+
cross = "";
35
+
top_cross = "";
36
+
bottom_cross = "";
37
+
left_cross = "";
38
+
right_cross = "";
39
+
}
40
+
41
+
let ascii_chars =
42
+
{
43
+
top_left = "+";
44
+
top = "-";
45
+
top_right = "+";
46
+
left = "|";
47
+
right = "|";
48
+
bottom_left = "+";
49
+
bottom = "-";
50
+
bottom_right = "+";
51
+
cross = "+";
52
+
top_cross = "+";
53
+
bottom_cross = "+";
54
+
left_cross = "+";
55
+
right_cross = "+";
56
+
}
57
+
58
+
let single_chars =
59
+
{
60
+
top_left = "┌";
61
+
top = "─";
62
+
top_right = "┐";
63
+
left = "│";
64
+
right = "│";
65
+
bottom_left = "└";
66
+
bottom = "─";
67
+
bottom_right = "┘";
68
+
cross = "┼";
69
+
top_cross = "┬";
70
+
bottom_cross = "┴";
71
+
left_cross = "├";
72
+
right_cross = "┤";
73
+
}
74
+
75
+
let double_chars =
76
+
{
77
+
top_left = "╔";
78
+
top = "═";
79
+
top_right = "╗";
80
+
left = "║";
81
+
right = "║";
82
+
bottom_left = "╚";
83
+
bottom = "═";
84
+
bottom_right = "╝";
85
+
cross = "╬";
86
+
top_cross = "╦";
87
+
bottom_cross = "╩";
88
+
left_cross = "╠";
89
+
right_cross = "╣";
90
+
}
91
+
92
+
let rounded_chars =
93
+
{
94
+
top_left = "╭";
95
+
top = "─";
96
+
top_right = "╮";
97
+
left = "│";
98
+
right = "│";
99
+
bottom_left = "╰";
100
+
bottom = "─";
101
+
bottom_right = "╯";
102
+
cross = "┼";
103
+
top_cross = "┬";
104
+
bottom_cross = "┴";
105
+
left_cross = "├";
106
+
right_cross = "┤";
107
+
}
108
+
109
+
let heavy_chars =
110
+
{
111
+
top_left = "┏";
112
+
top = "━";
113
+
top_right = "┓";
114
+
left = "┃";
115
+
right = "┃";
116
+
bottom_left = "┗";
117
+
bottom = "━";
118
+
bottom_right = "┛";
119
+
cross = "╋";
120
+
top_cross = "┳";
121
+
bottom_cross = "┻";
122
+
left_cross = "┣";
123
+
right_cross = "┫";
124
+
}
125
+
126
+
let hidden_chars =
127
+
{
128
+
top_left = " ";
129
+
top = " ";
130
+
top_right = " ";
131
+
left = " ";
132
+
right = " ";
133
+
bottom_left = " ";
134
+
bottom = " ";
135
+
bottom_right = " ";
136
+
cross = " ";
137
+
top_cross = " ";
138
+
bottom_cross = " ";
139
+
left_cross = " ";
140
+
right_cross = " ";
141
+
}
142
+
143
+
let none = { chars = none_chars; style = Style.none }
144
+
let ascii = { chars = ascii_chars; style = Style.none }
145
+
let single = { chars = single_chars; style = Style.none }
146
+
let double = { chars = double_chars; style = Style.none }
147
+
let rounded = { chars = rounded_chars; style = Style.none }
148
+
let heavy = { chars = heavy_chars; style = Style.none }
149
+
let hidden = { chars = hidden_chars; style = Style.none }
150
+
let with_style style border = { border with style }
151
+
152
+
let pp ppf t =
153
+
let c = t.chars in
154
+
Format.fprintf ppf "%s%s%s@." c.top_left c.top c.top_right;
155
+
Format.fprintf ppf "%s %s@." c.left c.right;
156
+
Format.fprintf ppf "%s%s%s" c.bottom_left c.bottom c.bottom_right
+62
lib/border.mli
+62
lib/border.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Border styles for panels and tables.
7
+
8
+
Provides ASCII and Unicode box-drawing character sets. *)
9
+
10
+
(** {1 Types} *)
11
+
12
+
type chars = {
13
+
top_left : string;
14
+
top : string;
15
+
top_right : string;
16
+
left : string;
17
+
right : string;
18
+
bottom_left : string;
19
+
bottom : string;
20
+
bottom_right : string;
21
+
cross : string; (** Intersection of horizontal and vertical lines *)
22
+
top_cross : string; (** T pointing down (top edge intersection) *)
23
+
bottom_cross : string; (** T pointing up (bottom edge intersection) *)
24
+
left_cross : string; (** T pointing right (left edge intersection) *)
25
+
right_cross : string; (** T pointing left (right edge intersection) *)
26
+
}
27
+
(** Box-drawing characters. *)
28
+
29
+
type t = { chars : chars; style : Style.t }
30
+
(** A border specification with characters and styling. *)
31
+
32
+
(** {1 Predefined Borders} *)
33
+
34
+
val none : t
35
+
(** No border (empty strings). *)
36
+
37
+
val ascii : t
38
+
(** ASCII border using [+], [-], [|]. *)
39
+
40
+
val single : t
41
+
(** Unicode single line: [┌─┐│└┘├┤┬┴┼] *)
42
+
43
+
val double : t
44
+
(** Unicode double line: [╔═╗║╚╝╠╣╦╩╬] *)
45
+
46
+
val rounded : t
47
+
(** Unicode rounded corners: [╭─╮│╰╯├┤┬┴┼] *)
48
+
49
+
val heavy : t
50
+
(** Unicode heavy line: [┏━┓┃┗┛┣┫┳┻╋] *)
51
+
52
+
val hidden : t
53
+
(** Space characters (maintains spacing but invisible). *)
54
+
55
+
(** {1 Styling} *)
56
+
57
+
val with_style : Style.t -> t -> t
58
+
(** [with_style style border] applies a style to the border characters. *)
59
+
60
+
(** {1 Operations} *)
61
+
62
+
val pp : Format.formatter -> t -> unit
+157
lib/color.ml
+157
lib/color.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type ansi =
7
+
[ `Black
8
+
| `Red
9
+
| `Green
10
+
| `Yellow
11
+
| `Blue
12
+
| `Magenta
13
+
| `Cyan
14
+
| `White
15
+
| `Bright_black
16
+
| `Bright_red
17
+
| `Bright_green
18
+
| `Bright_yellow
19
+
| `Bright_blue
20
+
| `Bright_magenta
21
+
| `Bright_cyan
22
+
| `Bright_white ]
23
+
24
+
type t = Ansi of ansi | Rgb of int * int * int | Palette of int
25
+
26
+
let ansi c = Ansi c
27
+
28
+
let rgb r g b =
29
+
if r < 0 || r > 255 then invalid_arg "Color.rgb: r out of range";
30
+
if g < 0 || g > 255 then invalid_arg "Color.rgb: g out of range";
31
+
if b < 0 || b > 255 then invalid_arg "Color.rgb: b out of range";
32
+
Rgb (r, g, b)
33
+
34
+
let hex s =
35
+
let s = if String.length s > 0 && s.[0] = '#' then String.sub s 1 (String.length s - 1) else s in
36
+
let len = String.length s in
37
+
let parse_hex2 i =
38
+
let c1 = s.[i] and c2 = s.[i + 1] in
39
+
let digit c =
40
+
match c with
41
+
| '0' .. '9' -> Char.code c - Char.code '0'
42
+
| 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
43
+
| 'A' .. 'F' -> Char.code c - Char.code 'A' + 10
44
+
| _ -> invalid_arg "Color.hex: invalid hex character"
45
+
in
46
+
(digit c1 * 16) + digit c2
47
+
in
48
+
let parse_hex1 i =
49
+
let c = s.[i] in
50
+
let d =
51
+
match c with
52
+
| '0' .. '9' -> Char.code c - Char.code '0'
53
+
| 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
54
+
| 'A' .. 'F' -> Char.code c - Char.code 'A' + 10
55
+
| _ -> invalid_arg "Color.hex: invalid hex character"
56
+
in
57
+
(d * 16) + d
58
+
in
59
+
match len with
60
+
| 6 -> Rgb (parse_hex2 0, parse_hex2 2, parse_hex2 4)
61
+
| 3 -> Rgb (parse_hex1 0, parse_hex1 1, parse_hex1 2)
62
+
| _ -> invalid_arg "Color.hex: expected 3 or 6 hex digits"
63
+
64
+
let palette n =
65
+
if n < 0 || n > 255 then invalid_arg "Color.palette: n out of range";
66
+
Palette n
67
+
68
+
(* Predefined colors *)
69
+
let black = Ansi `Black
70
+
let red = Ansi `Red
71
+
let green = Ansi `Green
72
+
let yellow = Ansi `Yellow
73
+
let blue = Ansi `Blue
74
+
let magenta = Ansi `Magenta
75
+
let cyan = Ansi `Cyan
76
+
let white = Ansi `White
77
+
let bright_black = Ansi `Bright_black
78
+
let bright_red = Ansi `Bright_red
79
+
let bright_green = Ansi `Bright_green
80
+
let bright_yellow = Ansi `Bright_yellow
81
+
let bright_blue = Ansi `Bright_blue
82
+
let bright_magenta = Ansi `Bright_magenta
83
+
let bright_cyan = Ansi `Bright_cyan
84
+
let bright_white = Ansi `Bright_white
85
+
86
+
let ansi_fg_code = function
87
+
| `Black -> "30"
88
+
| `Red -> "31"
89
+
| `Green -> "32"
90
+
| `Yellow -> "33"
91
+
| `Blue -> "34"
92
+
| `Magenta -> "35"
93
+
| `Cyan -> "36"
94
+
| `White -> "37"
95
+
| `Bright_black -> "90"
96
+
| `Bright_red -> "91"
97
+
| `Bright_green -> "92"
98
+
| `Bright_yellow -> "93"
99
+
| `Bright_blue -> "94"
100
+
| `Bright_magenta -> "95"
101
+
| `Bright_cyan -> "96"
102
+
| `Bright_white -> "97"
103
+
104
+
let ansi_bg_code = function
105
+
| `Black -> "40"
106
+
| `Red -> "41"
107
+
| `Green -> "42"
108
+
| `Yellow -> "43"
109
+
| `Blue -> "44"
110
+
| `Magenta -> "45"
111
+
| `Cyan -> "46"
112
+
| `White -> "47"
113
+
| `Bright_black -> "100"
114
+
| `Bright_red -> "101"
115
+
| `Bright_green -> "102"
116
+
| `Bright_yellow -> "103"
117
+
| `Bright_blue -> "104"
118
+
| `Bright_magenta -> "105"
119
+
| `Bright_cyan -> "106"
120
+
| `Bright_white -> "107"
121
+
122
+
let to_fg_code = function
123
+
| Ansi c -> ansi_fg_code c
124
+
| Rgb (r, g, b) -> Printf.sprintf "38;2;%d;%d;%d" r g b
125
+
| Palette n -> Printf.sprintf "38;5;%d" n
126
+
127
+
let to_bg_code = function
128
+
| Ansi c -> ansi_bg_code c
129
+
| Rgb (r, g, b) -> Printf.sprintf "48;2;%d;%d;%d" r g b
130
+
| Palette n -> Printf.sprintf "48;5;%d" n
131
+
132
+
let equal a b =
133
+
match (a, b) with
134
+
| Ansi a, Ansi b -> a = b
135
+
| Rgb (r1, g1, b1), Rgb (r2, g2, b2) -> r1 = r2 && g1 = g2 && b1 = b2
136
+
| Palette a, Palette b -> a = b
137
+
| _ -> false
138
+
139
+
let pp ppf = function
140
+
| Ansi `Black -> Format.fprintf ppf "black"
141
+
| Ansi `Red -> Format.fprintf ppf "red"
142
+
| Ansi `Green -> Format.fprintf ppf "green"
143
+
| Ansi `Yellow -> Format.fprintf ppf "yellow"
144
+
| Ansi `Blue -> Format.fprintf ppf "blue"
145
+
| Ansi `Magenta -> Format.fprintf ppf "magenta"
146
+
| Ansi `Cyan -> Format.fprintf ppf "cyan"
147
+
| Ansi `White -> Format.fprintf ppf "white"
148
+
| Ansi `Bright_black -> Format.fprintf ppf "bright_black"
149
+
| Ansi `Bright_red -> Format.fprintf ppf "bright_red"
150
+
| Ansi `Bright_green -> Format.fprintf ppf "bright_green"
151
+
| Ansi `Bright_yellow -> Format.fprintf ppf "bright_yellow"
152
+
| Ansi `Bright_blue -> Format.fprintf ppf "bright_blue"
153
+
| Ansi `Bright_magenta -> Format.fprintf ppf "bright_magenta"
154
+
| Ansi `Bright_cyan -> Format.fprintf ppf "bright_cyan"
155
+
| Ansi `Bright_white -> Format.fprintf ppf "bright_white"
156
+
| Rgb (r, g, b) -> Format.fprintf ppf "#%02x%02x%02x" r g b
157
+
| Palette n -> Format.fprintf ppf "palette(%d)" n
+82
lib/color.mli
+82
lib/color.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Terminal colors.
7
+
8
+
Supports ANSI 16-color palette, 256-color palette, and true color
9
+
(RGB/hex). *)
10
+
11
+
(** {1 Color Types} *)
12
+
13
+
type ansi =
14
+
[ `Black
15
+
| `Red
16
+
| `Green
17
+
| `Yellow
18
+
| `Blue
19
+
| `Magenta
20
+
| `Cyan
21
+
| `White
22
+
| `Bright_black
23
+
| `Bright_red
24
+
| `Bright_green
25
+
| `Bright_yellow
26
+
| `Bright_blue
27
+
| `Bright_magenta
28
+
| `Bright_cyan
29
+
| `Bright_white ]
30
+
(** Standard 16-color ANSI palette. *)
31
+
32
+
type t
33
+
(** A terminal color. *)
34
+
35
+
(** {1 Constructors} *)
36
+
37
+
val ansi : ansi -> t
38
+
(** [ansi c] creates an ANSI color. *)
39
+
40
+
val rgb : int -> int -> int -> t
41
+
(** [rgb r g b] creates an RGB color. Components must be 0-255.
42
+
@raise Invalid_argument if components are out of range. *)
43
+
44
+
val hex : string -> t
45
+
(** [hex s] creates a color from a hex string like ["#RRGGBB"] or ["RRGGBB"].
46
+
@raise Invalid_argument if the string is malformed. *)
47
+
48
+
val palette : int -> t
49
+
(** [palette n] creates a 256-color palette color.
50
+
@raise Invalid_argument if [n] is not 0-255. *)
51
+
52
+
(** {1 Predefined Colors} *)
53
+
54
+
val black : t
55
+
val red : t
56
+
val green : t
57
+
val yellow : t
58
+
val blue : t
59
+
val magenta : t
60
+
val cyan : t
61
+
val white : t
62
+
val bright_black : t
63
+
val bright_red : t
64
+
val bright_green : t
65
+
val bright_yellow : t
66
+
val bright_blue : t
67
+
val bright_magenta : t
68
+
val bright_cyan : t
69
+
val bright_white : t
70
+
71
+
(** {1 ANSI Codes} *)
72
+
73
+
val to_fg_code : t -> string
74
+
(** ANSI escape sequence for foreground color (without ESC[). *)
75
+
76
+
val to_bg_code : t -> string
77
+
(** ANSI escape sequence for background color (without ESC[). *)
78
+
79
+
(** {1 Operations} *)
80
+
81
+
val equal : t -> t -> bool
82
+
val pp : Format.formatter -> t -> unit
+125
lib/panel.ml
+125
lib/panel.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
border : Border.t;
8
+
title : Span.t option;
9
+
subtitle : Span.t option;
10
+
padding : int;
11
+
width : int option;
12
+
lines : Span.t list;
13
+
}
14
+
15
+
let create ?(border = Border.rounded) ?title ?subtitle ?(padding = 1) ?width
16
+
content =
17
+
(* Split content on newlines *)
18
+
let content_str = Span.to_plain_string content in
19
+
let line_strs = String.split_on_char '\n' content_str in
20
+
let lines = List.map Span.text line_strs in
21
+
{ border; title; subtitle; padding; width; lines }
22
+
23
+
let create_lines ?(border = Border.rounded) ?title ?subtitle ?(padding = 1)
24
+
?width lines =
25
+
{ border; title; subtitle; padding; width; lines }
26
+
27
+
let render_border_char ppf border_style char =
28
+
let ansi = Style.to_ansi border_style in
29
+
if ansi = "" then Format.pp_print_string ppf char
30
+
else (
31
+
Format.pp_print_string ppf ansi;
32
+
Format.pp_print_string ppf char;
33
+
Format.pp_print_string ppf Style.reset)
34
+
35
+
let render ppf t =
36
+
let c = t.border.chars in
37
+
let border_style = t.border.style in
38
+
39
+
(* Calculate content width *)
40
+
let content_width =
41
+
match t.width with
42
+
| Some w -> w - 2 - (t.padding * 2) (* subtract borders and padding *)
43
+
| None ->
44
+
let max_line_width =
45
+
List.fold_left (fun acc line -> max acc (Span.width line)) 0 t.lines
46
+
in
47
+
let title_width =
48
+
match t.title with Some s -> Span.width s | None -> 0
49
+
in
50
+
let subtitle_width =
51
+
match t.subtitle with Some s -> Span.width s | None -> 0
52
+
in
53
+
max max_line_width (max title_width subtitle_width)
54
+
in
55
+
56
+
let inner_width = content_width + (t.padding * 2) in
57
+
let pad = String.make t.padding ' ' in
58
+
59
+
(* Top border with optional title *)
60
+
render_border_char ppf border_style c.top_left;
61
+
(match t.title with
62
+
| None ->
63
+
for _ = 1 to inner_width do
64
+
render_border_char ppf border_style c.top
65
+
done
66
+
| Some title ->
67
+
let title_w = Span.width title in
68
+
let left_border = (inner_width - title_w - 2) / 2 in
69
+
let right_border = inner_width - title_w - 2 - left_border in
70
+
for _ = 1 to left_border do
71
+
render_border_char ppf border_style c.top
72
+
done;
73
+
Format.pp_print_char ppf ' ';
74
+
Span.render ppf title;
75
+
Format.pp_print_char ppf ' ';
76
+
for _ = 1 to right_border do
77
+
render_border_char ppf border_style c.top
78
+
done);
79
+
render_border_char ppf border_style c.top_right;
80
+
Format.pp_print_newline ppf ();
81
+
82
+
(* Content lines *)
83
+
List.iter
84
+
(fun line ->
85
+
render_border_char ppf border_style c.left;
86
+
Format.pp_print_string ppf pad;
87
+
Span.render ppf line;
88
+
let line_w = Span.width line in
89
+
let spaces = content_width - line_w in
90
+
if spaces > 0 then Format.pp_print_string ppf (String.make spaces ' ');
91
+
Format.pp_print_string ppf pad;
92
+
render_border_char ppf border_style c.right;
93
+
Format.pp_print_newline ppf ())
94
+
t.lines;
95
+
96
+
(* Bottom border with optional subtitle *)
97
+
render_border_char ppf border_style c.bottom_left;
98
+
(match t.subtitle with
99
+
| None ->
100
+
for _ = 1 to inner_width do
101
+
render_border_char ppf border_style c.bottom
102
+
done
103
+
| Some subtitle ->
104
+
let sub_w = Span.width subtitle in
105
+
let left_border = (inner_width - sub_w - 2) / 2 in
106
+
let right_border = inner_width - sub_w - 2 - left_border in
107
+
for _ = 1 to left_border do
108
+
render_border_char ppf border_style c.bottom
109
+
done;
110
+
Format.pp_print_char ppf ' ';
111
+
Span.render ppf subtitle;
112
+
Format.pp_print_char ppf ' ';
113
+
for _ = 1 to right_border do
114
+
render_border_char ppf border_style c.bottom
115
+
done);
116
+
render_border_char ppf border_style c.bottom_right
117
+
118
+
let to_string t =
119
+
let buf = Buffer.create 256 in
120
+
let ppf = Format.formatter_of_buffer buf in
121
+
render ppf t;
122
+
Format.pp_print_flush ppf ();
123
+
Buffer.contents buf
124
+
125
+
let pp = render
+52
lib/panel.mli
+52
lib/panel.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bordered panels with optional titles.
7
+
8
+
A panel is a box with a border that can contain styled text. *)
9
+
10
+
(** {1 Types} *)
11
+
12
+
type t
13
+
(** A panel. *)
14
+
15
+
(** {1 Construction} *)
16
+
17
+
val create :
18
+
?border:Border.t ->
19
+
?title:Span.t ->
20
+
?subtitle:Span.t ->
21
+
?padding:int ->
22
+
?width:int ->
23
+
Span.t ->
24
+
t
25
+
(** [create ?border ?title ?subtitle ?padding ?width content] creates a panel.
26
+
27
+
- [border]: Border style (default: {!Border.rounded})
28
+
- [title]: Optional title displayed at the top
29
+
- [subtitle]: Optional subtitle displayed at the bottom
30
+
- [padding]: Internal horizontal padding (default: 1)
31
+
- [width]: Fixed width; if not specified, auto-sized to content *)
32
+
33
+
val create_lines :
34
+
?border:Border.t ->
35
+
?title:Span.t ->
36
+
?subtitle:Span.t ->
37
+
?padding:int ->
38
+
?width:int ->
39
+
Span.t list ->
40
+
t
41
+
(** [create_lines] is like {!create} but takes multiple lines of content. *)
42
+
43
+
(** {1 Rendering} *)
44
+
45
+
val render : Format.formatter -> t -> unit
46
+
(** [render ppf panel] renders the panel with ANSI codes. *)
47
+
48
+
val to_string : t -> string
49
+
(** [to_string panel] renders to a string. *)
50
+
51
+
val pp : Format.formatter -> t -> unit
52
+
(** Pretty-printer (same as {!render}). *)
+54
lib/span.ml
+54
lib/span.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type atom = { style : Style.t; text : string }
7
+
type t = atom list
8
+
9
+
let text s = [ { style = Style.none; text = s } ]
10
+
let styled style s = [ { style; text = s } ]
11
+
let v = styled
12
+
let empty = []
13
+
let space = text " "
14
+
let newline = text "\n"
15
+
let concat spans = List.concat spans
16
+
let ( ++ ) a b = a @ b
17
+
18
+
let concat_map ?(sep = empty) f xs =
19
+
match xs with
20
+
| [] -> empty
21
+
| [ x ] -> f x
22
+
| x :: xs -> List.fold_left (fun acc x -> acc ++ sep ++ f x) (f x) xs
23
+
24
+
let render_atom ppf { style; text } =
25
+
let ansi = Style.to_ansi style in
26
+
if ansi = "" then Format.pp_print_string ppf text
27
+
else (
28
+
Format.pp_print_string ppf ansi;
29
+
Format.pp_print_string ppf text;
30
+
Format.pp_print_string ppf Style.reset)
31
+
32
+
let render ppf t = List.iter (render_atom ppf) t
33
+
34
+
let render_plain ppf t =
35
+
List.iter (fun { text; _ } -> Format.pp_print_string ppf text) t
36
+
37
+
let to_string t =
38
+
let buf = Buffer.create 64 in
39
+
let ppf = Format.formatter_of_buffer buf in
40
+
render ppf t;
41
+
Format.pp_print_flush ppf ();
42
+
Buffer.contents buf
43
+
44
+
let to_plain_string t =
45
+
let buf = Buffer.create 64 in
46
+
let ppf = Format.formatter_of_buffer buf in
47
+
render_plain ppf t;
48
+
Format.pp_print_flush ppf ();
49
+
Buffer.contents buf
50
+
51
+
let width t =
52
+
List.fold_left (fun acc { text; _ } -> acc + Width.string_width text) 0 t
53
+
54
+
let pp = render
+68
lib/span.mli
+68
lib/span.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Styled text spans.
7
+
8
+
A span is a piece of text with associated styling. Spans can be
9
+
concatenated. *)
10
+
11
+
type t
12
+
(** A styled text span. *)
13
+
14
+
(** {1 Constructors} *)
15
+
16
+
val text : string -> t
17
+
(** [text s] creates a plain text span with no styling. *)
18
+
19
+
val styled : Style.t -> string -> t
20
+
(** [styled style s] creates a styled text span. *)
21
+
22
+
val v : Style.t -> string -> t
23
+
(** [v style s] is an alias for [styled style s]. *)
24
+
25
+
val empty : t
26
+
(** The empty span. *)
27
+
28
+
val space : t
29
+
(** A single space. *)
30
+
31
+
val newline : t
32
+
(** A newline character. *)
33
+
34
+
(** {1 Concatenation} *)
35
+
36
+
val concat : t list -> t
37
+
(** [concat spans] concatenates a list of spans. *)
38
+
39
+
val ( ++ ) : t -> t -> t
40
+
(** [a ++ b] concatenates two spans. *)
41
+
42
+
val concat_map : ?sep:t -> ('a -> t) -> 'a list -> t
43
+
(** [concat_map ~sep f xs] maps [f] over [xs] and concatenates with [sep]. *)
44
+
45
+
(** {1 Rendering} *)
46
+
47
+
val render : Format.formatter -> t -> unit
48
+
(** [render ppf span] renders the span with ANSI codes to [ppf]. *)
49
+
50
+
val render_plain : Format.formatter -> t -> unit
51
+
(** [render_plain ppf span] renders the span without ANSI codes. *)
52
+
53
+
val to_string : t -> string
54
+
(** [to_string span] renders to a string with ANSI codes. *)
55
+
56
+
val to_plain_string : t -> string
57
+
(** [to_plain_string span] renders to a string without ANSI codes. *)
58
+
59
+
(** {1 Measurements} *)
60
+
61
+
val width : t -> int
62
+
(** [width span] returns the display width in terminal columns.
63
+
Excludes ANSI escape sequences. *)
64
+
65
+
(** {1 Operations} *)
66
+
67
+
val pp : Format.formatter -> t -> unit
68
+
(** Pretty-printer (renders with ANSI codes). *)
+139
lib/style.ml
+139
lib/style.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
bold : bool option;
8
+
faint : bool option;
9
+
italic : bool option;
10
+
underline : bool option;
11
+
blink : bool option;
12
+
reverse : bool option;
13
+
strikethrough : bool option;
14
+
fg : Color.t option;
15
+
bg : Color.t option;
16
+
}
17
+
18
+
let none =
19
+
{
20
+
bold = None;
21
+
faint = None;
22
+
italic = None;
23
+
underline = None;
24
+
blink = None;
25
+
reverse = None;
26
+
strikethrough = None;
27
+
fg = None;
28
+
bg = None;
29
+
}
30
+
31
+
let bold = { none with bold = Some true }
32
+
let faint = { none with faint = Some true }
33
+
let italic = { none with italic = Some true }
34
+
let underline = { none with underline = Some true }
35
+
let blink = { none with blink = Some true }
36
+
let reverse = { none with reverse = Some true }
37
+
let strikethrough = { none with strikethrough = Some true }
38
+
let fg c = { none with fg = Some c }
39
+
let bg c = { none with bg = Some c }
40
+
41
+
let merge_opt a b = match b with Some _ -> b | None -> a
42
+
43
+
let ( + ) a b =
44
+
{
45
+
bold = merge_opt a.bold b.bold;
46
+
faint = merge_opt a.faint b.faint;
47
+
italic = merge_opt a.italic b.italic;
48
+
underline = merge_opt a.underline b.underline;
49
+
blink = merge_opt a.blink b.blink;
50
+
reverse = merge_opt a.reverse b.reverse;
51
+
strikethrough = merge_opt a.strikethrough b.strikethrough;
52
+
fg = merge_opt a.fg b.fg;
53
+
bg = merge_opt a.bg b.bg;
54
+
}
55
+
56
+
let merge = List.fold_left ( + ) none
57
+
58
+
let to_ansi t =
59
+
let codes = ref [] in
60
+
(match t.bold with Some true -> codes := "1" :: !codes | _ -> ());
61
+
(match t.faint with Some true -> codes := "2" :: !codes | _ -> ());
62
+
(match t.italic with Some true -> codes := "3" :: !codes | _ -> ());
63
+
(match t.underline with Some true -> codes := "4" :: !codes | _ -> ());
64
+
(match t.blink with Some true -> codes := "5" :: !codes | _ -> ());
65
+
(match t.reverse with Some true -> codes := "7" :: !codes | _ -> ());
66
+
(match t.strikethrough with Some true -> codes := "9" :: !codes | _ -> ());
67
+
(match t.fg with Some c -> codes := Color.to_fg_code c :: !codes | None -> ());
68
+
(match t.bg with Some c -> codes := Color.to_bg_code c :: !codes | None -> ());
69
+
match !codes with
70
+
| [] -> ""
71
+
| codes -> Printf.sprintf "\027[%sm" (String.concat ";" (List.rev codes))
72
+
73
+
let reset = "\027[0m"
74
+
75
+
let styled style pp ppf x =
76
+
let ansi = to_ansi style in
77
+
if ansi = "" then pp ppf x
78
+
else (
79
+
Format.pp_print_string ppf ansi;
80
+
pp ppf x;
81
+
Format.pp_print_string ppf reset)
82
+
83
+
let pp_styled style fmt =
84
+
let ansi = to_ansi style in
85
+
if ansi = "" then Format.printf fmt
86
+
else (
87
+
Format.pp_print_string Format.std_formatter ansi;
88
+
Format.kfprintf
89
+
(fun ppf -> Format.pp_print_string ppf reset)
90
+
Format.std_formatter fmt)
91
+
92
+
let is_none t =
93
+
t.bold = None
94
+
&& t.faint = None
95
+
&& t.italic = None
96
+
&& t.underline = None
97
+
&& t.blink = None
98
+
&& t.reverse = None
99
+
&& t.strikethrough = None
100
+
&& t.fg = None
101
+
&& t.bg = None
102
+
103
+
let opt_equal eq a b =
104
+
match (a, b) with
105
+
| None, None -> true
106
+
| Some a, Some b -> eq a b
107
+
| _ -> false
108
+
109
+
let equal a b =
110
+
opt_equal ( = ) a.bold b.bold
111
+
&& opt_equal ( = ) a.faint b.faint
112
+
&& opt_equal ( = ) a.italic b.italic
113
+
&& opt_equal ( = ) a.underline b.underline
114
+
&& opt_equal ( = ) a.blink b.blink
115
+
&& opt_equal ( = ) a.reverse b.reverse
116
+
&& opt_equal ( = ) a.strikethrough b.strikethrough
117
+
&& opt_equal Color.equal a.fg b.fg
118
+
&& opt_equal Color.equal a.bg b.bg
119
+
120
+
let pp ppf t =
121
+
if is_none t then Format.fprintf ppf "none"
122
+
else
123
+
let parts = ref [] in
124
+
(match t.bold with Some true -> parts := "bold" :: !parts | _ -> ());
125
+
(match t.faint with Some true -> parts := "faint" :: !parts | _ -> ());
126
+
(match t.italic with Some true -> parts := "italic" :: !parts | _ -> ());
127
+
(match t.underline with Some true -> parts := "underline" :: !parts | _ -> ());
128
+
(match t.blink with Some true -> parts := "blink" :: !parts | _ -> ());
129
+
(match t.reverse with Some true -> parts := "reverse" :: !parts | _ -> ());
130
+
(match t.strikethrough with
131
+
| Some true -> parts := "strikethrough" :: !parts
132
+
| _ -> ());
133
+
(match t.fg with
134
+
| Some c -> parts := Format.asprintf "fg(%a)" Color.pp c :: !parts
135
+
| None -> ());
136
+
(match t.bg with
137
+
| Some c -> parts := Format.asprintf "bg(%a)" Color.pp c :: !parts
138
+
| None -> ());
139
+
Format.fprintf ppf "%s" (String.concat " + " (List.rev !parts))
+66
lib/style.mli
+66
lib/style.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Terminal text styles.
7
+
8
+
Styles can be composed: [Style.(bold + fg Color.red + underline)]. *)
9
+
10
+
(** {1 Style Type} *)
11
+
12
+
type t
13
+
(** A composable style specification. *)
14
+
15
+
(** {1 Constructors} *)
16
+
17
+
val none : t
18
+
(** No styling. *)
19
+
20
+
val bold : t
21
+
val faint : t
22
+
val italic : t
23
+
val underline : t
24
+
val blink : t
25
+
val reverse : t
26
+
val strikethrough : t
27
+
28
+
val fg : Color.t -> t
29
+
(** Foreground color. *)
30
+
31
+
val bg : Color.t -> t
32
+
(** Background color. *)
33
+
34
+
(** {1 Composition} *)
35
+
36
+
val ( + ) : t -> t -> t
37
+
(** [s1 + s2] combines two styles. Later styles override earlier ones
38
+
for conflicting attributes. *)
39
+
40
+
val merge : t list -> t
41
+
(** [merge styles] merges a list of styles left to right. *)
42
+
43
+
(** {1 ANSI Escape Codes} *)
44
+
45
+
val to_ansi : t -> string
46
+
(** ANSI escape sequence to enable this style. Returns empty string for
47
+
[none]. *)
48
+
49
+
val reset : string
50
+
(** ANSI escape sequence to reset all styling: ["\027[0m"]. *)
51
+
52
+
(** {1 Fmt Integration} *)
53
+
54
+
val styled : t -> 'a Fmt.t -> 'a Fmt.t
55
+
(** [styled style pp] wraps a formatter with ANSI styling.
56
+
57
+
Example: [Fmt.pr "%a" (Style.styled Style.bold Fmt.string) "hello"] *)
58
+
59
+
val pp_styled : t -> ('a, Format.formatter, unit) format -> 'a
60
+
(** [pp_styled style fmt ...] prints with styling to [Format.std_formatter]. *)
61
+
62
+
(** {1 Operations} *)
63
+
64
+
val equal : t -> t -> bool
65
+
val pp : Format.formatter -> t -> unit
66
+
val is_none : t -> bool
+170
lib/table.ml
+170
lib/table.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type align = [ `Left | `Center | `Right ]
7
+
8
+
type column = {
9
+
header : Span.t;
10
+
align : align;
11
+
min_width : int option;
12
+
max_width : int option;
13
+
style : Style.t;
14
+
}
15
+
16
+
type t = {
17
+
border : Border.t;
18
+
header_style : Style.t;
19
+
columns : column list;
20
+
rows : Span.t list list;
21
+
}
22
+
23
+
let column ?(align = `Left) ?min_width ?max_width ?(style = Style.none) header =
24
+
{ header = Span.text header; align; min_width; max_width; style }
25
+
26
+
let column' ?(align = `Left) ?min_width ?max_width ?(style = Style.none) header
27
+
=
28
+
{ header; align; min_width; max_width; style }
29
+
30
+
let create ?(border = Border.single) ?(header_style = Style.bold) columns =
31
+
{ border; header_style; columns; rows = [] }
32
+
33
+
let add_row cells t = { t with rows = t.rows @ [ cells ] }
34
+
35
+
let add_row_strings strings t =
36
+
add_row (List.map Span.text strings) t
37
+
38
+
let of_rows ?border ?header_style columns rows =
39
+
let t = create ?border ?header_style columns in
40
+
List.fold_left (fun t row -> add_row row t) t rows
41
+
42
+
let of_string_rows ?border ?header_style columns rows =
43
+
of_rows ?border ?header_style columns
44
+
(List.map (List.map Span.text) rows)
45
+
46
+
(* Calculate column widths *)
47
+
let calc_col_widths t =
48
+
let num_cols = List.length t.columns in
49
+
let widths = Array.make num_cols 0 in
50
+
51
+
(* Header widths *)
52
+
List.iteri
53
+
(fun i col -> widths.(i) <- max widths.(i) (Span.width col.header))
54
+
t.columns;
55
+
56
+
(* Row widths *)
57
+
List.iter
58
+
(fun row ->
59
+
List.iteri
60
+
(fun i cell ->
61
+
if i < num_cols then widths.(i) <- max widths.(i) (Span.width cell))
62
+
row)
63
+
t.rows;
64
+
65
+
(* Apply min/max constraints *)
66
+
List.iteri
67
+
(fun i col ->
68
+
(match col.min_width with
69
+
| Some min -> widths.(i) <- max widths.(i) min
70
+
| None -> ());
71
+
match col.max_width with
72
+
| Some max -> widths.(i) <- min widths.(i) max
73
+
| None -> ())
74
+
t.columns;
75
+
76
+
Array.to_list widths
77
+
78
+
let render_border_char ppf border_style char =
79
+
let ansi = Style.to_ansi border_style in
80
+
if ansi = "" then Format.pp_print_string ppf char
81
+
else (
82
+
Format.pp_print_string ppf ansi;
83
+
Format.pp_print_string ppf char;
84
+
Format.pp_print_string ppf Style.reset)
85
+
86
+
let render_horizontal ppf t widths left_char mid_char right_char horiz_char =
87
+
let c = t.border.chars in
88
+
let border_style = t.border.style in
89
+
if c.top = "" then () (* No border *)
90
+
else (
91
+
render_border_char ppf border_style left_char;
92
+
List.iteri
93
+
(fun i w ->
94
+
for _ = 1 to w + 2 do
95
+
(* +2 for padding *)
96
+
render_border_char ppf border_style horiz_char
97
+
done;
98
+
if i < List.length widths - 1 then
99
+
render_border_char ppf border_style mid_char)
100
+
widths;
101
+
render_border_char ppf border_style right_char;
102
+
Format.pp_print_newline ppf ())
103
+
104
+
let align_cell align width span =
105
+
let cell_width = Span.width span in
106
+
let text = Span.to_string span in
107
+
if cell_width >= width then text
108
+
else
109
+
match align with
110
+
| `Left -> Width.pad_right width text
111
+
| `Right -> Width.pad_left width text
112
+
| `Center -> Width.center width text
113
+
114
+
let render_row ppf t widths style cells =
115
+
let c = t.border.chars in
116
+
let border_style = t.border.style in
117
+
let num_cols = List.length t.columns in
118
+
119
+
if c.left <> "" then render_border_char ppf border_style c.left;
120
+
List.iteri
121
+
(fun i (col, w) ->
122
+
let cell =
123
+
if i < List.length cells then List.nth cells i else Span.empty
124
+
in
125
+
let aligned = align_cell col.align w cell in
126
+
Format.pp_print_char ppf ' ';
127
+
let cell_style = Style.(style + col.style) in
128
+
let ansi = Style.to_ansi cell_style in
129
+
if ansi <> "" then Format.pp_print_string ppf ansi;
130
+
Format.pp_print_string ppf aligned;
131
+
if ansi <> "" then Format.pp_print_string ppf Style.reset;
132
+
Format.pp_print_char ppf ' ';
133
+
if i < num_cols - 1 && c.left <> "" then
134
+
render_border_char ppf border_style c.right)
135
+
(List.combine t.columns widths);
136
+
if c.right <> "" then render_border_char ppf border_style c.right;
137
+
Format.pp_print_newline ppf ()
138
+
139
+
let render ppf t =
140
+
if List.length t.columns = 0 then ()
141
+
else
142
+
let c = t.border.chars in
143
+
let widths = calc_col_widths t in
144
+
145
+
(* Top border *)
146
+
render_horizontal ppf t widths c.top_left c.top_cross c.top_right c.top;
147
+
148
+
(* Header row *)
149
+
let headers = List.map (fun col -> col.header) t.columns in
150
+
render_row ppf t widths t.header_style headers;
151
+
152
+
(* Separator after header *)
153
+
if List.length t.rows > 0 then
154
+
render_horizontal ppf t widths c.left_cross c.cross c.right_cross c.top;
155
+
156
+
(* Data rows *)
157
+
List.iter (fun row -> render_row ppf t widths Style.none row) t.rows;
158
+
159
+
(* Bottom border *)
160
+
render_horizontal ppf t widths c.bottom_left c.bottom_cross c.bottom_right
161
+
c.bottom
162
+
163
+
let to_string t =
164
+
let buf = Buffer.create 256 in
165
+
let ppf = Format.formatter_of_buffer buf in
166
+
render ppf t;
167
+
Format.pp_print_flush ppf ();
168
+
Buffer.contents buf
169
+
170
+
let pp = render
+84
lib/table.mli
+84
lib/table.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tables with headers, alignment, and borders.
7
+
8
+
Tables display data in aligned columns with optional headers and
9
+
customizable borders. *)
10
+
11
+
(** {1 Types} *)
12
+
13
+
type align = [ `Left | `Center | `Right ]
14
+
(** Column alignment. *)
15
+
16
+
type column
17
+
(** A column specification. *)
18
+
19
+
type t
20
+
(** A table. *)
21
+
22
+
(** {1 Column Construction} *)
23
+
24
+
val column :
25
+
?align:align -> ?min_width:int -> ?max_width:int -> ?style:Style.t -> string -> column
26
+
(** [column ?align ?min_width ?max_width ?style header] creates a column.
27
+
28
+
- [align]: Text alignment (default: [`Left])
29
+
- [min_width]: Minimum column width
30
+
- [max_width]: Maximum column width (content will be truncated)
31
+
- [style]: Style applied to all cells in the column
32
+
- [header]: Column header text *)
33
+
34
+
val column' :
35
+
?align:align ->
36
+
?min_width:int ->
37
+
?max_width:int ->
38
+
?style:Style.t ->
39
+
Span.t ->
40
+
column
41
+
(** [column'] is like {!column} but takes a styled span for the header. *)
42
+
43
+
(** {1 Table Construction} *)
44
+
45
+
val create : ?border:Border.t -> ?header_style:Style.t -> column list -> t
46
+
(** [create ?border ?header_style columns] creates an empty table.
47
+
48
+
- [border]: Border style (default: {!Border.single})
49
+
- [header_style]: Style for header row (default: bold) *)
50
+
51
+
val add_row : Span.t list -> t -> t
52
+
(** [add_row cells table] adds a row of styled cells.
53
+
The number of cells should match the number of columns. *)
54
+
55
+
val add_row_strings : string list -> t -> t
56
+
(** [add_row_strings strings table] adds a row of plain strings. *)
57
+
58
+
val of_rows :
59
+
?border:Border.t ->
60
+
?header_style:Style.t ->
61
+
column list ->
62
+
Span.t list list ->
63
+
t
64
+
(** [of_rows ?border ?header_style columns rows] creates a table with all
65
+
data at once. *)
66
+
67
+
val of_string_rows :
68
+
?border:Border.t ->
69
+
?header_style:Style.t ->
70
+
column list ->
71
+
string list list ->
72
+
t
73
+
(** [of_string_rows] is like {!of_rows} but takes plain strings. *)
74
+
75
+
(** {1 Rendering} *)
76
+
77
+
val render : Format.formatter -> t -> unit
78
+
(** [render ppf table] renders the table with ANSI codes. *)
79
+
80
+
val to_string : t -> string
81
+
(** [to_string table] renders to a string. *)
82
+
83
+
val pp : Format.formatter -> t -> unit
84
+
(** Pretty-printer (same as {!render}). *)
+62
lib/tree.ml
+62
lib/tree.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type guide = { branch : string; last : string; pipe : string; space : string }
7
+
type 'a tree = Node of 'a * 'a tree list
8
+
9
+
type t = { guide : guide; tree : Span.t tree }
10
+
11
+
let ascii_guide =
12
+
{ branch = "+-- "; last = "+-- "; pipe = "| "; space = " " }
13
+
14
+
let unicode_guide =
15
+
{ branch = "├── "; last = "└── "; pipe = "│ "; space = " " }
16
+
17
+
let of_tree ?(guide = unicode_guide) tree = { guide; tree }
18
+
19
+
let make ?(guide = unicode_guide) f root =
20
+
let rec render_fn node = f render_fn node in
21
+
{ guide; tree = render_fn root }
22
+
23
+
let render ppf t =
24
+
let rec render_node prefix is_last (Node (label, children)) =
25
+
(* Print current node *)
26
+
Format.pp_print_string ppf prefix;
27
+
Span.render ppf label;
28
+
Format.pp_print_newline ppf ();
29
+
30
+
(* Print children *)
31
+
let n = List.length children in
32
+
List.iteri
33
+
(fun i child ->
34
+
let is_last_child = i = n - 1 in
35
+
let child_prefix =
36
+
if is_last then prefix ^ t.guide.space else prefix ^ t.guide.pipe
37
+
in
38
+
let branch =
39
+
if is_last_child then t.guide.last else t.guide.branch
40
+
in
41
+
render_node (child_prefix ^ branch) is_last_child child)
42
+
children
43
+
in
44
+
let (Node (label, children)) = t.tree in
45
+
Span.render ppf label;
46
+
Format.pp_print_newline ppf ();
47
+
let n = List.length children in
48
+
List.iteri
49
+
(fun i child ->
50
+
let is_last = i = n - 1 in
51
+
let branch = if is_last then t.guide.last else t.guide.branch in
52
+
render_node branch is_last child)
53
+
children
54
+
55
+
let to_string t =
56
+
let buf = Buffer.create 256 in
57
+
let ppf = Format.formatter_of_buffer buf in
58
+
render ppf t;
59
+
Format.pp_print_flush ppf ();
60
+
Buffer.contents buf
61
+
62
+
let pp = render
+65
lib/tree.mli
+65
lib/tree.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tree rendering with customizable guides.
7
+
8
+
Renders tree structures with ASCII or Unicode guide lines. *)
9
+
10
+
(** {1 Types} *)
11
+
12
+
type guide = {
13
+
branch : string; (** Branch connector, e.g., ["├── "] *)
14
+
last : string; (** Last child connector, e.g., ["└── "] *)
15
+
pipe : string; (** Vertical continuation, e.g., ["│ "] *)
16
+
space : string; (** Empty space, e.g., [" "] *)
17
+
}
18
+
(** Tree guide characters. *)
19
+
20
+
type 'a tree = Node of 'a * 'a tree list
21
+
(** A generic tree type. *)
22
+
23
+
type t
24
+
(** A renderable tree of spans. *)
25
+
26
+
(** {1 Predefined Guides} *)
27
+
28
+
val ascii_guide : guide
29
+
(** ASCII guide: [+-- ], [+-- ], [| ], [ ] *)
30
+
31
+
val unicode_guide : guide
32
+
(** Unicode guide: [├── ], [└── ], [│ ], [ ] *)
33
+
34
+
(** {1 Construction} *)
35
+
36
+
val of_tree : ?guide:guide -> Span.t tree -> t
37
+
(** [of_tree ?guide tree] creates a renderable tree from a tree of spans.
38
+
39
+
- [guide]: Guide characters (default: {!unicode_guide}) *)
40
+
41
+
val make : ?guide:guide -> (('a -> Span.t tree) -> 'a -> Span.t tree) -> 'a -> t
42
+
(** [make ?guide f root] creates a tree by recursively applying [f].
43
+
44
+
The function [f] receives a render function and the current node,
45
+
and should return a tree of spans.
46
+
47
+
Example:
48
+
{[
49
+
type dir = { name : string; children : dir list }
50
+
51
+
let tree = Tree.make (fun render dir ->
52
+
Node (Span.text dir.name, List.map render dir.children)
53
+
) root_dir
54
+
]} *)
55
+
56
+
(** {1 Rendering} *)
57
+
58
+
val render : Format.formatter -> t -> unit
59
+
(** [render ppf tree] renders the tree with guide lines. *)
60
+
61
+
val to_string : t -> string
62
+
(** [to_string tree] renders to a string. *)
63
+
64
+
val pp : Format.formatter -> t -> unit
65
+
(** Pretty-printer (same as {!render}). *)
+13
lib/tty.ml
+13
lib/tty.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Color = Color
7
+
module Style = Style
8
+
module Width = Width
9
+
module Span = Span
10
+
module Border = Border
11
+
module Panel = Panel
12
+
module Table = Table
13
+
module Tree = Tree
+77
lib/tty.mli
+77
lib/tty.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Terminal styling and layout widgets.
7
+
8
+
Type-safe terminal styling (colors, bold, italic) and layout widgets
9
+
(tables, trees, panels) for OCaml CLI applications.
10
+
11
+
{1 Quick Start}
12
+
13
+
{2 Styled Text}
14
+
15
+
{[
16
+
open Tty
17
+
18
+
let () =
19
+
let style = Style.(bold + fg Color.green) in
20
+
Fmt.pr "%a@." (Style.styled style Fmt.string) "Success!"
21
+
]}
22
+
23
+
{2 Tables}
24
+
25
+
{[
26
+
open Tty
27
+
28
+
let () =
29
+
let table =
30
+
Table.(
31
+
of_rows ~border:Border.rounded
32
+
[ column "Name"; column ~align:`Right "Age" ]
33
+
[ [ Span.text "Alice"; Span.text "30" ];
34
+
[ Span.text "Bob"; Span.text "25" ] ])
35
+
in
36
+
Table.pp Format.std_formatter table
37
+
]}
38
+
39
+
{2 Trees}
40
+
41
+
{[
42
+
open Tty
43
+
44
+
let () =
45
+
let tree =
46
+
Tree.of_tree
47
+
(Node
48
+
( Span.text "src",
49
+
[ Node (Span.text "lib", [ Node (Span.text "tty.ml", []) ]);
50
+
Node (Span.text "test", []) ] ))
51
+
in
52
+
Tree.pp Format.std_formatter tree
53
+
]}
54
+
55
+
{2 Panels}
56
+
57
+
{[
58
+
open Tty
59
+
60
+
let () =
61
+
let panel =
62
+
Panel.create ~title:(Span.text "Status")
63
+
(Span.text "All systems operational")
64
+
in
65
+
Panel.pp Format.std_formatter panel
66
+
]} *)
67
+
68
+
(** {1 Modules} *)
69
+
70
+
module Color = Color
71
+
module Style = Style
72
+
module Width = Width
73
+
module Span = Span
74
+
module Border = Border
75
+
module Panel = Panel
76
+
module Table = Table
77
+
module Tree = Tree
+101
lib/width.ml
+101
lib/width.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* ANSI escape sequence detection *)
7
+
type ansi_state = Normal | Escape | Csi
8
+
9
+
let char_width uchar =
10
+
match Uucp.Break.tty_width_hint uchar with
11
+
| -1 -> 0 (* Control characters *)
12
+
| n -> n
13
+
14
+
let string_width s =
15
+
let len = String.length s in
16
+
let width = ref 0 in
17
+
let state = ref Normal in
18
+
let decoder = Uutf.decoder ~encoding:`UTF_8 (`String s) in
19
+
let rec loop () =
20
+
match Uutf.decode decoder with
21
+
| `Uchar u -> (
22
+
let c = Uchar.to_int u in
23
+
match !state with
24
+
| Normal ->
25
+
if c = 0x1b then state := Escape
26
+
else width := !width + char_width u;
27
+
loop ()
28
+
| Escape ->
29
+
if c = 0x5b (* '[' *) then state := Csi
30
+
else state := Normal;
31
+
loop ()
32
+
| Csi ->
33
+
(* CSI sequence ends with byte in range 0x40-0x7E *)
34
+
if c >= 0x40 && c <= 0x7e then state := Normal;
35
+
loop ())
36
+
| `End -> ()
37
+
| `Await -> assert false
38
+
| `Malformed _ -> loop ()
39
+
in
40
+
if len = 0 then 0
41
+
else (
42
+
loop ();
43
+
!width)
44
+
45
+
let truncate target_width s =
46
+
if target_width <= 0 then ""
47
+
else
48
+
let buf = Buffer.create (String.length s) in
49
+
let width = ref 0 in
50
+
let state = ref Normal in
51
+
let decoder = Uutf.decoder ~encoding:`UTF_8 (`String s) in
52
+
let rec loop () =
53
+
match Uutf.decode decoder with
54
+
| `Uchar u -> (
55
+
let c = Uchar.to_int u in
56
+
match !state with
57
+
| Normal ->
58
+
if c = 0x1b then (
59
+
state := Escape;
60
+
Uutf.Buffer.add_utf_8 buf u;
61
+
loop ())
62
+
else
63
+
let w = char_width u in
64
+
if !width + w <= target_width then (
65
+
width := !width + w;
66
+
Uutf.Buffer.add_utf_8 buf u;
67
+
loop ())
68
+
else ()
69
+
| Escape ->
70
+
Uutf.Buffer.add_utf_8 buf u;
71
+
if c = 0x5b then state := Csi else state := Normal;
72
+
loop ()
73
+
| Csi ->
74
+
Uutf.Buffer.add_utf_8 buf u;
75
+
if c >= 0x40 && c <= 0x7e then state := Normal;
76
+
loop ())
77
+
| `End -> ()
78
+
| `Await -> assert false
79
+
| `Malformed _ -> loop ()
80
+
in
81
+
loop ();
82
+
Buffer.contents buf
83
+
84
+
let pad_right target_width s =
85
+
let w = string_width s in
86
+
if w >= target_width then s
87
+
else s ^ String.make (target_width - w) ' '
88
+
89
+
let pad_left target_width s =
90
+
let w = string_width s in
91
+
if w >= target_width then s
92
+
else String.make (target_width - w) ' ' ^ s
93
+
94
+
let center target_width s =
95
+
let w = string_width s in
96
+
if w >= target_width then s
97
+
else
98
+
let total_pad = target_width - w in
99
+
let left_pad = total_pad / 2 in
100
+
let right_pad = total_pad - left_pad in
101
+
String.make left_pad ' ' ^ s ^ String.make right_pad ' '
+31
lib/width.mli
+31
lib/width.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unicode-aware text width calculation.
7
+
8
+
Handles UTF-8 strings, wide characters (CJK), and ANSI escape sequences. *)
9
+
10
+
val string_width : string -> int
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 *)
16
+
17
+
val truncate : int -> string -> string
18
+
(** [truncate width s] truncates [s] to fit within [width] terminal columns.
19
+
Preserves ANSI escape sequences. Adds no ellipsis. *)
20
+
21
+
val pad_right : int -> string -> string
22
+
(** [pad_right width s] pads [s] with spaces on the right to reach [width]
23
+
columns. If [s] is already wider, returns [s] unchanged. *)
24
+
25
+
val pad_left : int -> string -> string
26
+
(** [pad_left width s] pads [s] with spaces on the left to reach [width]
27
+
columns. If [s] is already wider, returns [s] unchanged. *)
28
+
29
+
val center : int -> string -> string
30
+
(** [center width s] centers [s] within [width] columns by adding spaces
31
+
on both sides. If [s] is already wider, returns [s] unchanged. *)
+6
test/test.ml
+6
test/test.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = Alcotest.run "tty" Test_tty.suite
+190
test/test_tty.ml
+190
test/test_tty.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Tty
7
+
8
+
(* Color tests *)
9
+
let test_color_hex_6digit () =
10
+
let c = Color.hex "#FF5500" in
11
+
let expected = Color.rgb 255 85 0 in
12
+
Alcotest.(check bool) "6-digit hex" true (Color.equal c expected)
13
+
14
+
let test_color_hex_3digit () =
15
+
let c = Color.hex "#F50" in
16
+
let expected = Color.rgb 255 85 0 in
17
+
Alcotest.(check bool) "3-digit hex" true (Color.equal c expected)
18
+
19
+
let test_color_hex_no_hash () =
20
+
let c = Color.hex "FF5500" in
21
+
let expected = Color.rgb 255 85 0 in
22
+
Alcotest.(check bool) "hex without #" true (Color.equal c expected)
23
+
24
+
let test_color_predefined () =
25
+
Alcotest.(check bool) "red equals red" true (Color.equal Color.red Color.red);
26
+
Alcotest.(check bool)
27
+
"red not equal blue" false
28
+
(Color.equal Color.red Color.blue)
29
+
30
+
(* Style tests *)
31
+
let test_style_none () =
32
+
let ansi = Style.to_ansi Style.none in
33
+
Alcotest.(check string) "none produces empty" "" ansi
34
+
35
+
let test_style_bold () =
36
+
let ansi = Style.to_ansi Style.bold in
37
+
Alcotest.(check bool) "bold contains \\027[" true (String.length ansi > 0);
38
+
Alcotest.(check bool)
39
+
"bold contains 1" true
40
+
(String.is_substring ~affix:"1" ansi)
41
+
42
+
let test_style_composition () =
43
+
let s = Style.(bold + fg Color.red + underline) in
44
+
Alcotest.(check bool) "composed style not none" false (Style.is_none s)
45
+
46
+
(* Width tests *)
47
+
let test_width_ascii () =
48
+
let w = Width.string_width "hello" in
49
+
Alcotest.(check int) "ASCII width" 5 w
50
+
51
+
let test_width_empty () =
52
+
let w = Width.string_width "" in
53
+
Alcotest.(check int) "empty width" 0 w
54
+
55
+
let test_width_ansi_ignored () =
56
+
let styled = "\027[1mhello\027[0m" in
57
+
let w = Width.string_width styled in
58
+
Alcotest.(check int) "ANSI codes ignored" 5 w
59
+
60
+
(* Span tests *)
61
+
let test_span_text () =
62
+
let s = Span.text "hello" in
63
+
Alcotest.(check int) "span width" 5 (Span.width s)
64
+
65
+
let test_span_concat () =
66
+
let s = Span.(text "hello" ++ text " world") in
67
+
Alcotest.(check int) "concat width" 11 (Span.width s)
68
+
69
+
let test_span_plain () =
70
+
let s = Span.styled Style.bold "hello" in
71
+
let plain = Span.to_plain_string s in
72
+
Alcotest.(check string) "plain string" "hello" plain
73
+
74
+
(* Table tests *)
75
+
let test_table_basic () =
76
+
let t =
77
+
Table.(
78
+
of_rows [ column "A"; column "B" ]
79
+
[ [ Span.text "1"; Span.text "2" ]; [ Span.text "3"; Span.text "4" ] ])
80
+
in
81
+
let s = Table.to_string t in
82
+
Alcotest.(check bool) "contains A" true (String.is_substring ~affix:"A" s);
83
+
Alcotest.(check bool) "contains 1" true (String.is_substring ~affix:"1" s)
84
+
85
+
let test_table_empty () =
86
+
let t = Table.(create [ column "X" ]) in
87
+
let s = Table.to_string t in
88
+
Alcotest.(check bool) "contains X" true (String.is_substring ~affix:"X" s)
89
+
90
+
(* Tree tests *)
91
+
let test_tree_simple () =
92
+
let t =
93
+
Tree.of_tree
94
+
(Tree.Node (Span.text "root", [ Tree.Node (Span.text "child", []) ]))
95
+
in
96
+
let s = Tree.to_string t in
97
+
Alcotest.(check bool) "contains root" true (String.is_substring ~affix:"root" s);
98
+
Alcotest.(check bool)
99
+
"contains child" true
100
+
(String.is_substring ~affix:"child" s)
101
+
102
+
(* Panel tests *)
103
+
let test_panel_basic () =
104
+
let p = Panel.create (Span.text "content") in
105
+
let s = Panel.to_string p in
106
+
Alcotest.(check bool)
107
+
"contains content" true
108
+
(String.is_substring ~affix:"content" s)
109
+
110
+
let test_panel_with_title () =
111
+
let p =
112
+
Panel.create ~title:(Span.text "Title") (Span.text "body")
113
+
in
114
+
let s = Panel.to_string p in
115
+
Alcotest.(check bool) "contains title" true (String.is_substring ~affix:"Title" s);
116
+
Alcotest.(check bool) "contains body" true (String.is_substring ~affix:"body" s)
117
+
118
+
(* Border tests *)
119
+
let test_border_ascii () =
120
+
let b = Border.ascii in
121
+
Alcotest.(check string) "ascii top_left" "+" b.chars.top_left
122
+
123
+
let test_border_unicode () =
124
+
let b = Border.rounded in
125
+
Alcotest.(check string) "rounded top_left" "╭" b.chars.top_left
126
+
127
+
(* String.is_substring helper for older OCaml *)
128
+
module String = struct
129
+
include String
130
+
131
+
let is_substring ~affix s =
132
+
let len_affix = String.length affix in
133
+
let len_s = String.length s in
134
+
if len_affix > len_s then false
135
+
else
136
+
let rec check i =
137
+
if i > len_s - len_affix then false
138
+
else if String.sub s i len_affix = affix then true
139
+
else check (i + 1)
140
+
in
141
+
check 0
142
+
end
143
+
144
+
let suite =
145
+
[
146
+
( "Color",
147
+
[
148
+
Alcotest.test_case "hex 6-digit" `Quick test_color_hex_6digit;
149
+
Alcotest.test_case "hex 3-digit" `Quick test_color_hex_3digit;
150
+
Alcotest.test_case "hex no hash" `Quick test_color_hex_no_hash;
151
+
Alcotest.test_case "predefined" `Quick test_color_predefined;
152
+
] );
153
+
( "Style",
154
+
[
155
+
Alcotest.test_case "none" `Quick test_style_none;
156
+
Alcotest.test_case "bold" `Quick test_style_bold;
157
+
Alcotest.test_case "composition" `Quick test_style_composition;
158
+
] );
159
+
( "Width",
160
+
[
161
+
Alcotest.test_case "ASCII" `Quick test_width_ascii;
162
+
Alcotest.test_case "empty" `Quick test_width_empty;
163
+
Alcotest.test_case "ANSI ignored" `Quick test_width_ansi_ignored;
164
+
] );
165
+
( "Span",
166
+
[
167
+
Alcotest.test_case "text" `Quick test_span_text;
168
+
Alcotest.test_case "concat" `Quick test_span_concat;
169
+
Alcotest.test_case "plain" `Quick test_span_plain;
170
+
] );
171
+
( "Table",
172
+
[
173
+
Alcotest.test_case "basic" `Quick test_table_basic;
174
+
Alcotest.test_case "empty" `Quick test_table_empty;
175
+
] );
176
+
( "Tree",
177
+
[
178
+
Alcotest.test_case "simple" `Quick test_tree_simple;
179
+
] );
180
+
( "Panel",
181
+
[
182
+
Alcotest.test_case "basic" `Quick test_panel_basic;
183
+
Alcotest.test_case "with title" `Quick test_panel_with_title;
184
+
] );
185
+
( "Border",
186
+
[
187
+
Alcotest.test_case "ascii" `Quick test_border_ascii;
188
+
Alcotest.test_case "unicode" `Quick test_border_unicode;
189
+
] );
190
+
]