gazagnaire.org
Find and remove dead code and unused APIs in OCaml projects
1open Types
2
3type format = Cli | Html
4
5let pp_symbol_with_count fmt (symbol : symbol_info) count =
6 Fmt.pf fmt "%s %s (%d occurrences)"
7 (string_of_symbol_kind symbol.kind)
8 symbol.name count
9
10let pp_location_link fmt loc =
11 Fmt.pf fmt "%s:%d:%d" loc.file loc.start_line loc.start_col
12
13let group_by_file occurrences =
14 List.fold_left
15 (fun acc occ ->
16 let file = occ.symbol.location.file in
17 let existing = try List.assoc file acc with Not_found -> [] in
18 (file, occ :: existing) :: List.remove_assoc file acc)
19 [] occurrences
20
21let group_by_symbol occurrences =
22 List.fold_left
23 (fun acc occ ->
24 let key = (occ.symbol.name, occ.symbol.kind) in
25 let existing = try List.assoc key acc with Not_found -> [] in
26 (key, occ :: existing) :: List.remove_assoc key acc)
27 [] occurrences
28
29(* Print CLI header *)
30let print_cli_header () =
31 Fmt.pr "@[<v>Symbol Occurrence Report@,";
32 Fmt.pr "========================@,@,"
33
34(* Print CLI summary statistics *)
35let print_cli_summary occurrences =
36 let total_symbols = List.length occurrences in
37 let used_symbols = List.filter (fun o -> o.usage_class = Used) occurrences in
38 let unused_symbols =
39 List.filter (fun o -> o.usage_class = Unused) occurrences
40 in
41 let excluded_only =
42 List.filter (fun o -> o.usage_class = Used_only_in_excluded) occurrences
43 in
44
45 Fmt.pr "Total symbols: %d@," total_symbols;
46 Fmt.pr "Used symbols: %d@," (List.length used_symbols);
47 Fmt.pr "Unused symbols: %d@," (List.length unused_symbols);
48 Fmt.pr "Used only in excluded dirs: %d@,@," (List.length excluded_only)
49
50(* Print usage locations for an occurrence *)
51let print_usage_locations occ =
52 if occ.occurrences > 0 then
53 (* Filter out the definition location itself *)
54 let usage_locations =
55 List.filter
56 (fun loc ->
57 (* Filter out locations on the same line as the definition *)
58 loc.file <> occ.symbol.location.file
59 || loc.start_line <> occ.symbol.location.start_line)
60 occ.locations
61 in
62 if usage_locations <> [] then (
63 Fmt.pr " Used in:@,";
64 List.iter
65 (fun loc -> Fmt.pr " %a@," pp_location_link loc)
66 usage_locations)
67
68(* Print occurrences for a single file *)
69let print_file_occurrences file occs =
70 Fmt.pr "@[<v2>File: %s@," file;
71 let sorted_occs =
72 List.sort
73 (fun o1 o2 ->
74 match String.compare o1.symbol.name o2.symbol.name with
75 | 0 -> compare o1.symbol.kind o2.symbol.kind
76 | n -> n)
77 occs
78 in
79 List.iter
80 (fun occ ->
81 Fmt.pr " %a - %a@,"
82 (fun fmt () -> pp_symbol_with_count fmt occ.symbol occ.occurrences)
83 () pp_usage_classification occ.usage_class;
84 print_usage_locations occ)
85 sorted_occs;
86 Fmt.pr "@]@,"
87
88let render_cli occurrences =
89 let by_file = group_by_file occurrences in
90 let sorted_files =
91 List.sort (fun (f1, _) (f2, _) -> String.compare f1 f2) by_file
92 in
93
94 print_cli_header ();
95 print_cli_summary occurrences;
96
97 (* By file *)
98 List.iter (fun (file, occs) -> print_file_occurrences file occs) sorted_files;
99 Fmt.pr "@]@."
100
101let escape_html s =
102 let buffer = Buffer.create (String.length s) in
103 String.iter
104 (function
105 | '<' -> Buffer.add_string buffer "<"
106 | '>' -> Buffer.add_string buffer ">"
107 | '&' -> Buffer.add_string buffer "&"
108 | '"' -> Buffer.add_string buffer """
109 | '\'' -> Buffer.add_string buffer "'"
110 | c -> Buffer.add_char buffer c)
111 s;
112 Buffer.contents buffer
113
114(* Write HTML header and CSS *)
115let write_html_header fmt =
116 Fmt.pf fmt "<!DOCTYPE html>@.";
117 Fmt.pf fmt "<html>@.";
118 Fmt.pf fmt "<head>@.";
119 Fmt.pf fmt " <meta charset=\"UTF-8\">@.";
120 Fmt.pf fmt " <title>Prune Symbol Report</title>@.";
121 Fmt.pf fmt " <style>@.";
122 Fmt.pf fmt
123 " body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', \
124 Roboto, sans-serif; margin: 20px; }@.";
125 Fmt.pf fmt " h1, h2, h3 { color: #333; }@.";
126 Fmt.pf fmt
127 " .summary { background: #f5f5f5; padding: 15px; border-radius: 5px; \
128 margin-bottom: 20px; }@.";
129 Fmt.pf fmt
130 " .file-section { margin-bottom: 30px; border: 1px solid #ddd; padding: \
131 15px; border-radius: 5px; }@.";
132 Fmt.pf fmt
133 " .symbol { margin: 10px 0; padding: 10px; background: #fafafa; \
134 border-radius: 3px; }@.";
135 Fmt.pf fmt " .unused { background: #ffe6e6; }@.";
136 Fmt.pf fmt " .used { background: #e6ffe6; }@.";
137 Fmt.pf fmt " .excluded-only { background: #fff3cd; }@.";
138 Fmt.pf fmt
139 " .location { font-family: monospace; font-size: 0.9em; color: #666; \
140 margin-left: 20px; }@.";
141 Fmt.pf fmt " .kind { font-weight: bold; color: #0066cc; }@.";
142 Fmt.pf fmt " .name { font-family: monospace; font-weight: bold; }@.";
143 Fmt.pf fmt " .count { color: #666; font-size: 0.9em; }@.";
144 Fmt.pf fmt " a { color: #0066cc; text-decoration: none; }@.";
145 Fmt.pf fmt " a:hover { text-decoration: underline; }@.";
146 Fmt.pf fmt " .tab-buttons { margin-bottom: 20px; }@.";
147 Fmt.pf fmt
148 " .tab-button { padding: 10px 20px; margin-right: 5px; border: 1px \
149 solid #ddd; background: #f5f5f5; cursor: pointer; }@.";
150 Fmt.pf fmt " .tab-button.active { background: #0066cc; color: white; }@.";
151 Fmt.pf fmt " .tab-content { display: none; }@.";
152 Fmt.pf fmt " .tab-content.active { display: block; }@.";
153 Fmt.pf fmt " </style>@.";
154 Fmt.pf fmt "</head>@."
155
156(* Write summary section *)
157let write_summary fmt occurrences =
158 let total_symbols = List.length occurrences in
159 let used_symbols = List.filter (fun o -> o.usage_class = Used) occurrences in
160 let unused_symbols =
161 List.filter (fun o -> o.usage_class = Unused) occurrences
162 in
163 let excluded_only =
164 List.filter (fun o -> o.usage_class = Used_only_in_excluded) occurrences
165 in
166
167 Fmt.pf fmt "<div class=\"summary\">@.";
168 Fmt.pf fmt " <h2>Summary</h2>@.";
169 Fmt.pf fmt " <p>Total symbols: %d</p>@." total_symbols;
170 Fmt.pf fmt " <p>Used symbols: %d</p>@." (List.length used_symbols);
171 Fmt.pf fmt " <p>Unused symbols: %d</p>@." (List.length unused_symbols);
172 Fmt.pf fmt " <p>Used only in excluded directories: %d</p>@."
173 (List.length excluded_only);
174 Fmt.pf fmt "</div>@."
175
176(* Write tab buttons *)
177let write_tab_buttons fmt =
178 Fmt.pf fmt "<div class=\"tab-buttons\">@.";
179 Fmt.pf fmt
180 " <button class=\"tab-button active\" onclick=\"showTab('by-file')\">By \
181 File</button>@.";
182 Fmt.pf fmt
183 " <button class=\"tab-button\" onclick=\"showTab('by-symbol')\">By \
184 Symbol</button>@.";
185 Fmt.pf fmt "</div>@."
186
187(* Get CSS class name for usage classification *)
188let class_of_usage = function
189 | Unused -> "unused"
190 | Used -> "used"
191 | Used_only_in_excluded -> "excluded-only"
192 | Unknown -> "unknown"
193
194(* Filter usage locations excluding definition *)
195let filter_usage_locations occ =
196 List.filter
197 (fun loc ->
198 loc.file <> occ.symbol.location.file
199 || loc.start_line <> occ.symbol.location.start_line)
200 occ.locations
201
202(* Write symbol occurrence *)
203let write_symbol fmt occ =
204 let class_name = class_of_usage occ.usage_class in
205 Fmt.pf fmt " <div class=\"symbol %s\">@." class_name;
206 Fmt.pf fmt " <span class=\"kind\">%s</span> "
207 (escape_html (string_of_symbol_kind occ.symbol.kind));
208 Fmt.pf fmt " <span class=\"name\">%s</span> "
209 (escape_html occ.symbol.name);
210 Fmt.pf fmt " <span class=\"count\">(%d occurrences)</span>@."
211 occ.occurrences;
212 if occ.occurrences > 0 then (
213 let usage_locations = filter_usage_locations occ in
214 if usage_locations <> [] then (
215 Fmt.pf fmt " <div>Used in:</div>@.";
216 List.iter
217 (fun loc ->
218 Fmt.pf fmt " <div class=\"location\">%s:%d:%d</div>@."
219 (escape_html loc.file) loc.start_line loc.start_col)
220 usage_locations);
221 Fmt.pf fmt " </div>@.")
222
223(* Write By File view *)
224let write_by_file_view fmt by_file =
225 Fmt.pf fmt "<div id=\"by-file\" class=\"tab-content active\">@.";
226 Fmt.pf fmt " <h2>Symbols by File</h2>@.";
227 List.iter
228 (fun (file, occs) ->
229 Fmt.pf fmt " <div class=\"file-section\">@.";
230 Fmt.pf fmt " <h3>%s</h3>@." (escape_html file);
231 List.iter (write_symbol fmt) occs;
232 Fmt.pf fmt " </div>@.")
233 (List.sort (fun (f1, _) (f2, _) -> String.compare f1 f2) by_file);
234 Fmt.pf fmt "</div>@."
235
236(* Write By Symbol view *)
237let write_by_symbol_view fmt by_symbol =
238 Fmt.pf fmt "<div id=\"by-symbol\" class=\"tab-content\">@.";
239 Fmt.pf fmt " <h2>All Symbols</h2>@.";
240 List.iter
241 (fun ((name, kind), occs) ->
242 let first_occ = List.hd occs in
243 let total_occurrences =
244 List.fold_left (fun acc o -> acc + o.occurrences) 0 occs
245 in
246 let class_name = class_of_usage first_occ.usage_class in
247
248 Fmt.pf fmt " <div class=\"symbol %s\">@." class_name;
249 Fmt.pf fmt " <span class=\"kind\">%s</span> "
250 (escape_html (string_of_symbol_kind kind));
251 Fmt.pf fmt " <span class=\"name\">%s</span> " (escape_html name);
252 Fmt.pf fmt " <span class=\"count\">(%d total occurrences)</span>@."
253 total_occurrences;
254
255 (* Show where it's defined *)
256 Fmt.pf fmt " <div>Defined in:</div>@.";
257 List.iter
258 (fun occ ->
259 Fmt.pf fmt " <div class=\"location\">%s:%d:%d</div>@."
260 (escape_html occ.symbol.location.file)
261 occ.symbol.location.start_line occ.symbol.location.start_col)
262 occs;
263
264 (* Show all usage locations *)
265 let usage_locations =
266 List.concat_map (fun occ -> filter_usage_locations occ) occs
267 in
268 if usage_locations <> [] then (
269 Fmt.pf fmt " <div>Used in:</div>@.";
270 List.iter
271 (fun loc ->
272 Fmt.pf fmt " <div class=\"location\">%s:%d:%d</div>@."
273 (escape_html loc.file) loc.start_line loc.start_col)
274 usage_locations);
275 Fmt.pf fmt " </div>@.")
276 (List.sort
277 (fun ((n1, k1), _) ((n2, k2), _) ->
278 match String.compare n1 n2 with 0 -> compare k1 k2 | n -> n)
279 by_symbol);
280 Fmt.pf fmt "</div>@."
281
282(* Write JavaScript for tab switching *)
283let write_javascript fmt =
284 Fmt.pf fmt "<script>@.";
285 Fmt.pf fmt "function showTab(tabName) {@.";
286 Fmt.pf fmt " var tabs = document.getElementsByClassName('tab-content');@.";
287 Fmt.pf fmt " for (var i = 0; i < tabs.length; i++) {@.";
288 Fmt.pf fmt " tabs[i].classList.remove('active');@.";
289 Fmt.pf fmt " }@.";
290 Fmt.pf fmt " var buttons = document.getElementsByClassName('tab-button');@.";
291 Fmt.pf fmt " for (var i = 0; i < buttons.length; i++) {@.";
292 Fmt.pf fmt " buttons[i].classList.remove('active');@.";
293 Fmt.pf fmt " }@.";
294 Fmt.pf fmt " document.getElementById(tabName).classList.add('active');@.";
295 Fmt.pf fmt " event.target.classList.add('active');@.";
296 Fmt.pf fmt "}@.";
297 Fmt.pf fmt "</script>@."
298
299let render_html output_dir occurrences =
300 let html_file = Filename.concat output_dir "index.html" in
301 let oc = open_out html_file in
302 let fmt = Format.formatter_of_out_channel oc in
303
304 let by_file = group_by_file occurrences in
305 let by_symbol = group_by_symbol occurrences in
306
307 (* HTML header *)
308 write_html_header fmt;
309 Fmt.pf fmt "<body>@.";
310
311 Fmt.pf fmt "<h1>Prune Symbol Occurrence Report</h1>@.";
312
313 (* Summary *)
314 write_summary fmt occurrences;
315
316 (* Tabs *)
317 write_tab_buttons fmt;
318
319 (* By File View *)
320 write_by_file_view fmt by_file;
321
322 (* By Symbol View *)
323 write_by_symbol_view fmt by_symbol;
324
325 (* JavaScript *)
326 write_javascript fmt;
327
328 Fmt.pf fmt "</body>@.";
329 Fmt.pf fmt "</html>@.";
330 Format.pp_print_flush fmt ();
331 close_out oc;
332
333 Fmt.pr "HTML report generated: %s@." html_file
334
335let run ~format ~output_dir ~root_dir ~mli_files =
336 (* Create cache *)
337 let cache = Cache.v () in
338
339 if mli_files = [] then Error (`Msg "No .mli files found to analyze")
340 else
341 (* Use Analysis module to get all symbol occurrences *)
342 match Analysis.all_symbol_occurrences ~cache root_dir mli_files with
343 | Error (`Build_error _) ->
344 Error (`Msg "Build failed - please fix build errors first")
345 | Error (`Msg msg) -> Error (`Msg msg)
346 | Ok all_occurrences -> (
347 (* Render based on format *)
348 match format with
349 | Cli -> Ok (render_cli all_occurrences)
350 | Html -> (
351 match output_dir with
352 | None -> Error (`Msg "Output directory required for HTML format")
353 | Some dir ->
354 (* Create output directory if needed *)
355 (try Unix.mkdir dir 0o755
356 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
357 Ok (render_html dir all_occurrences)))