zachshipko.com
C build tool of the 21st century
1let lock = Mutex.create ()
2let spinner_frames = [| "◜"; "◝"; "◞"; "◟" |]
3let spinner_idx = ref 0
4
5type log_level = [ `Quiet | `Info | `Debug ]
6
7let log_level = function 0 -> `Quiet | 1 -> `Info | _ -> `Debug
8let is_verbose = function `Quiet -> false | `Info | `Debug -> true
9let is_debug = function `Debug -> true | _ -> false
10
11type progress_state = {
12 mutable current : int;
13 total : int;
14 is_tty : bool;
15 mutable current_file : string;
16}
17
18let progress : progress_state option Atomic.t = Atomic.make None
19
20let init_progress total =
21 if Unix.isatty Unix.stderr && total > 0 then
22 Atomic.set progress
23 (Some { current = 0; total; is_tty = true; current_file = "" })
24
25let finalize_progress () =
26 match Atomic.exchange progress None with
27 | Some p when p.is_tty ->
28 (* Clear the progress line *)
29 Fmt.epr "\r\027[K%!"
30 | _ -> ()
31
32let clear_progress_bar () =
33 match Atomic.get progress with
34 | Some p when p.is_tty ->
35 (* Clear current line *)
36 Fmt.epr "\r\027[K%!";
37 flush stderr
38 | _ -> ()
39
40let terminal_width = ref None
41
42let terminal_width ?(force = false) () =
43 if force then terminal_width := None;
44 match !terminal_width with
45 | Some w -> w
46 | None ->
47 let width =
48 match Sys.getenv_opt "COLUMNS" with
49 | Some cols -> int_of_string cols
50 | None -> (
51 try
52 let ic = Unix.open_process_in "tput cols" in
53 let w = int_of_string (input_line ic) in
54 close_in ic;
55 w
56 with _ -> 80)
57 in
58 terminal_width := Some width;
59 width
60
61let truncate_left ?(max_len = 30) s =
62 if String.length s > max_len then
63 String.sub s (String.length s - max_len) max_len
64 else s
65
66let truncate_path_left ?max_len s =
67 let s = Eio.Path.native_exn s in
68 truncate_left ?max_len s
69
70let redraw_progress_bar () =
71 match Atomic.get progress with
72 | Some p when p.is_tty && p.current < p.total && p.current > 0 ->
73 (* Don't redraw if we're at 100% or haven't started - it will be finalized soon *)
74 let frame =
75 spinner_frames.(!spinner_idx mod Array.length spinner_frames)
76 in
77 let percent = if p.total > 0 then p.current * 100 / p.total else 0 in
78 let bar_width = 20 in
79 let filled = bar_width * percent / 100 in
80 let bar =
81 String.concat ""
82 (List.init bar_width (fun i -> if i < filled then "█" else "░"))
83 in
84 (* Calculate available space for filename based on terminal width *)
85 let term_width = terminal_width () in
86 (* Format without filename to calculate fixed width *)
87 let fixed_part =
88 Printf.sprintf "%s [%s] %d%% (%d/%d) " frame bar percent p.current
89 p.total
90 in
91 let fixed_width = String.length fixed_part in
92 let available_for_file = max 20 (term_width - fixed_width - 1) in
93 let file_display =
94 truncate_left ~max_len:available_for_file p.current_file
95 in
96 Fmt.epr "%s%s%!" fixed_part file_display
97 | _ -> ()
98
99let log_clear ?(verbose = true) fmt =
100 Fmt.kstr
101 (fun msg ->
102 Mutex.protect lock @@ fun () ->
103 if verbose then (
104 clear_progress_bar ();
105 Fmt.epr "%s@." msg;
106 redraw_progress_bar ()))
107 fmt
108
109let log ?(verbose = true) fmt =
110 Mutex.protect lock @@ fun () ->
111 if verbose then Fmt.epr (fmt ^^ "@.") else Fmt.kstr ignore fmt
112
113let log_error ~log_output ~filepath ~target ?command ?exn () =
114 Mutex.protect lock @@ fun () ->
115 clear_progress_bar ();
116 Fmt.epr "\n%s@." log_output;
117 Fmt.epr "compilation failed for '%s' in target '%s'@." filepath target;
118 let () =
119 match command with None -> () | Some cmd -> Fmt.epr "command: %s@." cmd
120 in
121 let () =
122 match exn with Some e -> Fmt.epr "\tmessage: %a@." Fmt.exn e | None -> ()
123 in
124 redraw_progress_bar ()
125
126let log_spinner ?(verbose = true) fmt =
127 if verbose then Mutex.protect lock @@ fun () -> Fmt.epr ("• " ^^ fmt ^^ "@.")
128 else
129 Fmt.kstr
130 (fun msg ->
131 Mutex.protect lock @@ fun () ->
132 match Atomic.get progress with
133 | Some p ->
134 p.current <- p.current + 1;
135 p.current_file <- msg;
136 let frame =
137 spinner_frames.(!spinner_idx mod Array.length spinner_frames)
138 in
139 incr spinner_idx;
140 let percent =
141 if p.total > 0 then p.current * 100 / p.total else 0
142 in
143 let bar_width = 25 in
144 let filled = bar_width * percent / 100 in
145 let bar =
146 String.concat ""
147 (List.init bar_width (fun i -> if i < filled then "█" else "░"))
148 in
149 (* Calculate available space for filename based on terminal width *)
150 let term_width = terminal_width () in
151 let fixed_part =
152 Printf.sprintf "\r\027[K%s [%s] %d%% (%d/%d) " frame bar percent
153 p.current p.total
154 in
155 let fixed_width = String.length fixed_part - 5 in
156 (* -5 for escape codes *)
157 let available_for_file = max 20 (term_width - fixed_width - 1) in
158 let file_display = truncate_left ~max_len:available_for_file msg in
159 Fmt.epr "%s%s%!" fixed_part file_display
160 | None -> ())
161 fmt
162
163let ext path =
164 let s =
165 Eio.Path.split path |> Option.map snd |> Option.value ~default:""
166 |> Filename.extension
167 in
168 if String.length s > 0 then String.sub s 1 (String.length s - 1) else ""
169
170let with_ext path ext =
171 let a, b = Eio.Path.split path |> Option.get in
172 let c = Filename.remove_extension b ^ "." ^ ext in
173 Eio.Path.(a / c)
174
175let mkparent path =
176 let parent = Eio.Path.split path |> Option.map fst in
177 Option.iter
178 (fun p ->
179 if Eio.Path.native_exn p = "." || Eio.Path.native_exn p = "" then ()
180 else if not (Eio.Path.is_directory p) then
181 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p)
182 parent
183
184let relative_to base a =
185 let prefix = Eio.Path.native_exn base in
186 let a = Eio.Path.native_exn a in
187 if String.starts_with ~prefix a then
188 let prefix_len = String.length prefix in
189 String.sub a (prefix_len + 1) (String.length a - prefix_len - 1)
190 else a
191
192let glob =
193 Re.Glob.glob ~pathname:true ~anchored:true ~double_asterisk:true
194 ~expand_braces:true
195
196let uname =
197 let ic = Unix.open_process_in "uname -s" in
198 Fun.protect ~finally:(fun () -> close_in_noerr ic) @@ fun () ->
199 String.trim @@ input_line ic
200
201let is_static_lib (filename : string) =
202 String.starts_with ~prefix:"lib" filename
203 && String.ends_with ~suffix:".a" filename
204 || String.ends_with ~suffix:".cmxa" filename
205
206let is_shared_lib (filename : string) =
207 String.starts_with ~prefix:"lib" filename
208 && (String.ends_with ~suffix:".so" filename
209 || String.ends_with ~suffix:".dylib" filename)
210
211let normalize_shared_lib_ext (filename : string) =
212 if Sys.os_type = "Unix" && String.ends_with ~suffix:".so" filename then
213 try
214 if uname = "Darwin" then Filename.remove_extension filename ^ ".dylib"
215 else filename
216 with _ -> filename
217 else filename
218
219let parse_gitignore path =
220 if Eio.Path.is_file path then
221 Eio.Path.with_lines path @@ fun lines ->
222 Seq.filter_map
223 (fun line ->
224 let line = String.trim line in
225 if String.length line = 0 || String.starts_with ~prefix:"#" line then
226 None
227 else
228 let pattern =
229 if String.starts_with ~prefix:"/" line then
230 String.sub line 1 (String.length line - 1)
231 else line
232 in
233 Some (glob pattern))
234 lines
235 |> List.of_seq
236 else []
237
238let extension_is_c_or_cxx = function
239 | "c" | "cc" | "cpp" | "cxx" -> true
240 | _ -> false
241
242let remove_duplicates_preserving_order lst =
243 let seen = Hashtbl.create (List.length lst) in
244 List.fold_left
245 (fun acc x ->
246 if not (Hashtbl.mem seen x) then
247 let () = Hashtbl.add seen x () in
248 x :: acc
249 else acc)
250 [] lst