gazagnaire.org
Find and remove dead code and unused APIs in OCaml projects
1(* System utilities for prune - TTY detection, dune operations, and project
2 validation *)
3
4open Bos
5module Log = (val Logs.src_log (Logs.Src.create "prune.system") : Logs.LOG)
6
7(* Error helper functions *)
8let err fmt = Fmt.kstr (fun e -> Error (`Msg e)) fmt
9
10let err_no_dune_project root_dir =
11 err "No dune-project file found in %s" root_dir
12
13let err_version_parse version = err "Could not parse OCaml version: %s" version
14
15(* {2 TTY and environment detection} *)
16
17let is_tty () = try Unix.isatty Unix.stdout with Unix.Unix_error _ -> false
18
19(* {2 Dune version checking} *)
20
21let dune_version () =
22 match OS.Cmd.run_out Cmd.(v "dune" % "--version") |> OS.Cmd.out_string with
23 | Ok (version_str, _) -> Some (String.trim version_str)
24 | Error _ -> None
25
26let should_skip_dune_operations =
27 lazy
28 (match Sys.getenv_opt "INSIDE_DUNE" with
29 | None -> false
30 | Some _ -> (
31 match dune_version () with
32 | Some "3.19.0" -> true
33 | Some version ->
34 Log.debug (fun m ->
35 m "Dune version %s detected, safe to run nested dune commands"
36 version);
37 false
38 | None ->
39 Log.warn (fun m ->
40 m
41 "Could not detect dune version, being conservative and \
42 skipping nested dune");
43 true))
44
45(* {2 OCaml version checking} *)
46
47let ocaml_version () =
48 match OS.Cmd.run_out Cmd.(v "ocaml" % "-version") |> OS.Cmd.out_string with
49 | Ok (version_str, _) -> (
50 let version_str = String.trim version_str in
51 match String.split_on_char ' ' version_str with
52 | _ :: _ :: _ :: "version" :: version :: _ -> Some version
53 | _ -> None)
54 | Error _ -> None
55
56let parse_version version_str =
57 let extract_number s =
58 match String.split_on_char '+' s with
59 | num :: _ -> (
60 match String.split_on_char '-' num with num :: _ -> num | [] -> num)
61 | [] -> s
62 in
63 match String.split_on_char '.' version_str with
64 | major :: minor :: patch :: _ -> (
65 try
66 Some
67 ( int_of_string major,
68 int_of_string minor,
69 int_of_string (extract_number patch) )
70 with Failure _ -> None)
71 | [ major; minor ] -> (
72 try Some (int_of_string major, int_of_string minor, 0)
73 with Failure _ -> None)
74 | _ -> None
75
76let check_ocaml_version () =
77 match ocaml_version () with
78 | None -> Error (`Msg "Could not determine OCaml compiler version")
79 | Some version_str -> (
80 match parse_version version_str with
81 | None -> err_version_parse version_str
82 | Some (major, minor, _patch) ->
83 if major > 5 || (major = 5 && minor >= 3) then Ok ()
84 else
85 Error
86 (`Msg
87 (Fmt.str
88 "OCaml compiler version %s is below the minimum required \
89 version 5.3.0. Please upgrade your OCaml compiler to use \
90 prune."
91 version_str)))
92
93(* {2 Project validation} *)
94
95let validate_dune_project root_dir =
96 let root_path = Fpath.v root_dir in
97 let dune_project = Fpath.(root_path / "dune-project") in
98 match OS.File.exists dune_project with
99 | Ok false | Error _ -> err_no_dune_project root_dir
100 | Ok true -> Ok ()
101
102(* {2 Dune build operations} *)
103
104let run_build_command _cmd_desc build_cmd =
105 Log.debug (fun m -> m "Running: %s" (Cmd.to_string build_cmd));
106 match
107 OS.Cmd.run_out ~err:OS.Cmd.err_run_out build_cmd |> OS.Cmd.out_string
108 with
109 | Error (`Msg err) ->
110 { Types.success = false; output = err; exit_code = 1; warnings = [] }
111 | Ok (output, (_, status)) ->
112 let exit_code =
113 match status with `Exited n -> n | `Signaled n -> 128 + n
114 in
115 { Types.success = exit_code = 0; output; exit_code; warnings = [] }
116
117let run_single_build root_dir ctx =
118 Log.info (fun m -> m "Running build");
119 let build_cmd =
120 Cmd.(v "dune" % "build" % "--root" % root_dir % "@all" % "@ocaml-index")
121 in
122 let result = run_build_command "build" build_cmd in
123 let ctx = Types.update_build_result ctx result in
124 let warnings = Warning.parse result.output in
125 let ctx = Types.update_build_result ctx { result with warnings } in
126 (ctx, warnings)
127
128let build_project_and_index root_dir ctx =
129 if Lazy.force should_skip_dune_operations then (
130 Log.info (fun m ->
131 m
132 "Running inside dune with problematic version - skipping index build \
133 to avoid deadlock");
134 Log.warn (fun m ->
135 m "Cross-module detection may be limited without pre-built index");
136 Ok ())
137 else
138 let ctx, _warnings = run_single_build root_dir ctx in
139 match Types.last_build_result ctx with
140 | Some result when result.success ->
141 Log.debug (fun m -> m "Build completed successfully");
142 Ok ()
143 | _ -> Error (`Build_failed ctx)
144
145let is_fixable_warning warning_type =
146 match warning_type with
147 | Types.Signature_mismatch | Types.Unbound_field -> true
148 | Types.Unused_value -> true
149 | Types.Unused_type -> true
150 | Types.Unused_open -> true
151 | Types.Unused_constructor -> true
152 | Types.Unused_field -> true
153 | Types.Unnecessary_mutable -> true
154 | _ -> false
155
156let extract_fixable_errors result =
157 let parsed_errors : Types.warning_info list = result.Types.warnings in
158 let fixable_errors =
159 List.filter (fun w -> is_fixable_warning w.Types.warning_type) parsed_errors
160 in
161 Log.debug (fun m -> m "Found %d fixable errors" (List.length fixable_errors));
162 fixable_errors
163
164let output_excerpt result =
165 if String.length result.Types.output > 1000 then
166 String.sub result.Types.output 0 1000 ^ "\n[... output truncated ...]"
167 else result.Types.output
168
169let classify_build_error ctx =
170 match Types.last_build_result ctx with
171 | None -> Types.Other_errors "No build result available"
172 | Some result when result.success -> Types.No_error
173 | Some result ->
174 Log.debug (fun m -> m "Build failed with output:\n%s" result.output);
175 let fixable_errors = extract_fixable_errors result in
176 if fixable_errors <> [] then Types.Fixable_errors fixable_errors
177 else
178 let output_excerpt = output_excerpt result in
179 Types.Other_errors output_excerpt
180
181let count_all_errors output =
182 let lines = String.split_on_char '\n' output in
183 List.fold_left
184 (fun count line ->
185 let line = String.trim line in
186 if String.length line > 6 && String.sub line 0 6 = "Error:" then count + 1
187 else if
188 Re.execp
189 (Re.compile
190 (Re.seq [ Re.str "characters"; Re.rep Re.any; Re.str ": Error" ]))
191 line
192 then count + 1
193 else count)
194 0 lines
195
196let display_failure_and_exit ctx =
197 let total_error_count =
198 match Types.last_build_result ctx with
199 | Some result -> count_all_errors result.output
200 | None -> 0
201 in
202 Fmt.pr "%a with %d %s - full output:@."
203 Fmt.(styled (`Fg `Red) string)
204 "Build failed" total_error_count
205 (if total_error_count = 1 then "error" else "errors");
206 let pp_build_error ppf ctx =
207 match Types.last_build_result ctx with
208 | None -> Fmt.pf ppf "No build output available"
209 | Some result -> Fmt.pf ppf "%s" result.output
210 in
211 Fmt.pr "%a@." pp_build_error ctx;
212 let exit_code =
213 match Types.last_build_result ctx with
214 | Some result -> result.exit_code
215 | None -> 1
216 in
217 exit exit_code