gazagnaire.org
Terminal styling and layout widgets for OCaml (tables, trees, panels, colors)
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6(** {1 Progress Bar State} *)
7
8type state = { total : int; current : int; message : string; phase : string }
9
10let state ?(phase = "") ?(current = 0) ~total message =
11 { total; current; message; phase }
12
13let with_current current s = { s with current }
14let with_message message s = { s with message }
15let with_phase phase s = { s with phase }
16let incr s = { s with current = s.current + 1 }
17
18let update ?(phase = "") ~message s =
19 { s with current = s.current + 1; message; phase }
20
21(** {1 Configuration} *)
22
23type config = {
24 ppf : Format.formatter;
25 width : int;
26 style : [ `ASCII | `UTF8 | `Plain ];
27 bar_width : int;
28}
29
30let config ?(ppf = Format.std_formatter) ?width ?(style = `UTF8)
31 ?(bar_width = 25) () =
32 let width =
33 match width with Some w -> w | None -> Width.terminal_width ()
34 in
35 { ppf; width; style; bar_width }
36
37(** {1 Rendering} *)
38
39(* Braille spinner frames *)
40let spinner_utf8 = [| "⠋"; "⠙"; "⠹"; "⠸"; "⠼"; "⠴"; "⠦"; "⠧"; "⠇"; "⠏" |]
41
42let spinner_ascii = [| "|"; "/"; "-"; "\\" |]
43
44(* Bar characters for smooth animation *)
45let bar_chars = [| " "; "▏"; "▎"; "▍"; "▌"; "▋"; "▊"; "▉"; "█" |]
46
47(* ANSI codes *)
48let cyan = "\027[36m"
49let green = "\027[32m"
50let dim = "\027[2m"
51let reset_code = "\027[0m"
52let hide_cursor = "\027[?25l"
53let show_cursor = "\027[?25h"
54
55(* Ensure cursor is restored on exit (handles Ctrl-C, uncaught exceptions) *)
56let cursor_hidden = ref false
57
58let restore_cursor () =
59 if !cursor_hidden then begin
60 output_string stdout show_cursor;
61 flush stdout;
62 cursor_hidden := false
63 end
64
65let () = at_exit restore_cursor
66
67let render_bar_utf8 ~bar_width ~pct =
68 let total_eighths = bar_width * 8 in
69 let filled_eighths = total_eighths * pct / 100 in
70 let full_blocks = filled_eighths / 8 in
71 let partial = filled_eighths mod 8 in
72 let empty_blocks = bar_width - full_blocks - if partial > 0 then 1 else 0 in
73 let full =
74 String.concat "" (List.init full_blocks (fun _ -> bar_chars.(8)))
75 in
76 let part = if partial > 0 then bar_chars.(partial) else "" in
77 let empty =
78 String.concat "" (List.init empty_blocks (fun _ -> bar_chars.(0)))
79 in
80 full ^ part ^ empty
81
82let render_bar_ascii ~bar_width ~pct =
83 let filled = bar_width * pct / 100 in
84 let empty = max 0 (bar_width - filled - 1) in
85 String.make filled '='
86 ^ (if filled < bar_width then ">" else "")
87 ^ String.make empty ' '
88
89let 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
93let render ~frame cfg s =
94 let pct = if s.total > 0 then min 100 (s.current * 100 / s.total) else 0 in
95 let counter = Fmt.str "%d/%d" s.current s.total in
96 let full_msg =
97 if s.phase <> "" then s.phase ^ ": " ^ s.message else s.message
98 in
99 match cfg.style with
100 | `UTF8 ->
101 let bar = render_bar_utf8 ~bar_width:cfg.bar_width ~pct in
102 let spinner = spinner_utf8.(frame mod Array.length spinner_utf8) in
103 (* Calculate prefix width to determine how much space is left for message *)
104 let prefix = Fmt.str "%s ▕%s▏ %3d%% %s " spinner bar pct counter in
105 let prefix_width = Width.string_width prefix in
106 let max_msg_len = max 0 (cfg.width - prefix_width) in
107 let display_msg =
108 if String.length full_msg > max_msg_len then
109 String.sub full_msg 0 (max 0 (max_msg_len - 1)) ^ "…"
110 else full_msg
111 in
112 let visible_width = prefix_width + Width.string_width display_msg in
113 let padding =
114 if visible_width < cfg.width then
115 String.make (cfg.width - visible_width) ' '
116 else ""
117 in
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
120 | `ASCII ->
121 let bar = render_bar_ascii ~bar_width:cfg.bar_width ~pct in
122 let spinner = spinner_ascii.(frame mod Array.length spinner_ascii) in
123 let prefix = Fmt.str "%s [%s] %3d%% %s " spinner bar pct counter in
124 let prefix_width = Width.string_width prefix in
125 let max_msg_len = max 0 (cfg.width - prefix_width) in
126 let display_msg =
127 if String.length full_msg > max_msg_len then
128 String.sub full_msg 0 (max 0 (max_msg_len - 3)) ^ "..."
129 else full_msg
130 in
131 pad_to_width cfg.width (prefix ^ display_msg)
132 | `Plain ->
133 (* Minimal: no spinner, no colors, just counter and message *)
134 pad_to_width cfg.width (Fmt.str "[%3d%%] %s %s" pct counter full_msg)
135
136(** {1 Imperative Wrapper} *)
137
138type t = {
139 cfg : config;
140 mutable s : state;
141 mutable frame : int;
142 mutable finished : bool;
143 enabled : bool;
144 start_time : float;
145}
146
147let debug =
148 match Sys.getenv_opt "TTY_PROGRESS_DEBUG" with
149 | Some _ -> true
150 | None -> false
151
152let output_line ppf line =
153 (* Use direct stdout when ppf is std_formatter to bypass Format line-breaking *)
154 let use_direct = ppf == Format.std_formatter in
155 if debug then
156 Fmt.epr "[PROGRESS] use_direct=%b is_tty=%b line_bytes=%d line_width=%d\n"
157 use_direct (Width.is_tty ()) (String.length line)
158 (Width.string_width line);
159 (* Use \r\027[K to: move to start of line, clear to end of line *)
160 let cr_clear = "\r\027[K" in
161 if use_direct then begin
162 output_string stdout cr_clear;
163 output_string stdout line;
164 flush stdout
165 end
166 else begin
167 (* For buffers/custom formatters, use Format but disable line-breaking *)
168 let old_margin = Format.pp_get_margin ppf () in
169 Format.pp_set_margin ppf max_int;
170 Fmt.string ppf cr_clear;
171 Fmt.string ppf line;
172 Format.pp_print_flush ppf ();
173 Format.pp_set_margin ppf old_margin
174 end
175
176let v ?(ppf = Format.std_formatter) ?width ?enabled ?(style = `UTF8) ~total msg
177 =
178 let cfg = config ~ppf ?width ~style () in
179 let enabled = match enabled with Some e -> e | None -> Width.is_tty () in
180 let s = state ~total msg in
181 let start_time = Unix.gettimeofday () in
182 let t = { cfg; s; frame = 0; finished = false; enabled; start_time } in
183 (* Hide cursor and render immediately *)
184 if enabled && total > 0 then begin
185 if ppf == Format.std_formatter then begin
186 cursor_hidden := true;
187 output_string stdout hide_cursor;
188 flush stdout
189 end;
190 let line = render ~frame:0 cfg s in
191 output_line ppf line
192 end;
193 t
194
195let position t = t.s.current
196
197let pp ppf t =
198 let status = if t.finished then "finished" else "active" in
199 Fmt.pf ppf "progress(%s %d/%d %S)" status t.s.current t.s.total t.s.message
200
201let display t =
202 if t.enabled && not t.finished then begin
203 (* Time-based frame for faster spinner: ~10 frames per second *)
204 let elapsed = Unix.gettimeofday () -. t.start_time in
205 let frame = int_of_float (elapsed *. 10.) in
206 t.frame <- frame;
207 let line = render ~frame t.cfg t.s in
208 output_line t.cfg.ppf line
209 end
210
211let set t pos =
212 t.s <- with_current pos t.s;
213 display t
214
215let tick t =
216 t.s <- incr t.s;
217 display t
218
219let message t msg =
220 t.s <- with_message msg t.s;
221 display t
222
223let set_phase t phase =
224 t.s <- with_phase phase t.s;
225 display t
226
227let update t ~phase ~msg =
228 t.s <- update ~phase ~message:msg t.s;
229 display t
230
231let reset t ~total msg =
232 t.s <- state ~total msg;
233 t.frame <- 0;
234 t.finished <- false;
235 display t
236
237let finish t =
238 if not t.finished then begin
239 t.s <- with_current t.s.total t.s;
240 display t;
241 t.finished <- true;
242 if t.enabled then begin
243 if t.cfg.ppf == Format.std_formatter then begin
244 cursor_hidden := false;
245 output_string stdout show_cursor;
246 output_char stdout '\n';
247 flush stdout
248 end
249 else begin
250 Format.pp_print_newline t.cfg.ppf ();
251 Format.pp_print_flush t.cfg.ppf ()
252 end
253 end
254 end
255
256let clear t =
257 if not t.finished then begin
258 t.finished <- true;
259 if t.enabled then begin
260 if t.cfg.ppf == Format.std_formatter then begin
261 cursor_hidden := false;
262 output_string stdout "\r\027[K";
263 output_string stdout show_cursor;
264 flush stdout
265 end
266 else begin
267 Fmt.string t.cfg.ppf "\r\027[K";
268 Format.pp_print_flush t.cfg.ppf ()
269 end
270 end
271 end