this repo has no description
1(** results command: summarise build results with failure impact ranking *)
2
3open Cmdliner
4
5let run profile_name profile_dir =
6 match Common.load_profile ~profile_dir ~name:profile_name with
7 | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8 | Ok (_profile, paths) ->
9 match Common.latest_snapshot_dir paths with
10 | None -> Printf.printf "No snapshots found\n"; 1
11 | Some snapshot_dir ->
12 (* Load solutions *)
13 let solutions_dir = Fpath.(snapshot_dir / "solutions") in
14 let all_solutions : (string, Day11_solution.Deps.t) Hashtbl.t =
15 Hashtbl.create 4096 in
16 let n_solve_failures = ref 0 in
17 (match Bos.OS.Dir.contents solutions_dir with
18 | Ok commit_dirs ->
19 List.iter (fun commit_dir ->
20 let manifest = Fpath.(commit_dir / "repos.json") in
21 (match Bos.OS.File.read manifest with
22 | Ok data ->
23 (try
24 let json = Yojson.Safe.from_string data in
25 let open Yojson.Safe.Util in
26 let repos = json |> member "repos" |> to_list in
27 Printf.printf "Solver cache: %s\n" (Fpath.basename commit_dir);
28 List.iter (fun r ->
29 let path = r |> member "path" |> to_string in
30 let commit = r |> member "commit" |> to_string in
31 Printf.printf " %s @ %s\n" path (String.sub commit 0 12)
32 ) repos;
33 (match json |> member "ocaml_version" with
34 | `String v -> Printf.printf " compiler: %s\n" v
35 | _ -> ());
36 Printf.printf "\n"
37 with _ -> ())
38 | Error _ -> ());
39 match Bos.OS.Dir.contents commit_dir with
40 | Ok files ->
41 List.iter (fun f ->
42 if Fpath.has_ext ".json" f
43 && Fpath.basename f <> "repos.json" then
44 match Day11_batch.Incremental_solver.load f with
45 | Ok (Day11_batch.Incremental_solver.Cached_solution
46 { package; result; _ }) ->
47 let key = OpamPackage.to_string package in
48 if not (Hashtbl.mem all_solutions key) then
49 Hashtbl.replace all_solutions key result.build_deps
50 | Ok (Day11_batch.Incremental_solver.Cached_failure _) ->
51 incr n_solve_failures
52 | _ -> ()
53 ) files
54 | Error _ -> ()
55 ) commit_dirs
56 | Error _ -> ());
57 Printf.printf "=== Solver Cache ===\n";
58 Printf.printf " Solutions cached: %d (across all solve passes)\n"
59 (Hashtbl.length all_solutions);
60 Printf.printf " Solve failed: %d\n\n" !n_solve_failures;
61 (* Load runs -- each run is a subdirectory containing summary.json *)
62 let runs_dir = Fpath.(snapshot_dir / "runs") in
63 let load_run f =
64 try
65 let data = In_channel.with_open_text (Fpath.to_string f)
66 In_channel.input_all in
67 Some (Yojson.Safe.from_string data)
68 with _ -> None
69 in
70 let run_pkg_status_from_jsonl run_dir =
71 let jsonl_path = Fpath.(run_dir / "build.jsonl") in
72 let pkg_status : (string, string) Hashtbl.t = Hashtbl.create 256 in
73 if Sys.file_exists (Fpath.to_string jsonl_path) then begin
74 let ic = open_in (Fpath.to_string jsonl_path) in
75 Fun.protect ~finally:(fun () -> close_in ic) (fun () ->
76 try while true do
77 let line = input_line ic in
78 if String.length line > 0 then begin
79 let open Yojson.Safe.Util in
80 let json = Yojson.Safe.from_string line in
81 let pkg = json |> member "pkg" |> to_string in
82 let status = json |> member "status" |> to_string in
83 match Hashtbl.find_opt pkg_status pkg with
84 | Some "ok" -> ()
85 | _ -> Hashtbl.replace pkg_status pkg status
86 end
87 done with End_of_file -> ())
88 end;
89 pkg_status
90 in
91 let runs =
92 match Bos.OS.Dir.contents runs_dir with
93 | Ok entries ->
94 entries
95 |> List.filter (fun d ->
96 Sys.file_exists (Fpath.to_string Fpath.(d / "summary.json")))
97 |> List.sort (fun a b ->
98 compare (Fpath.to_string b) (Fpath.to_string a))
99 | Error _ -> []
100 in
101 (* Use latest run for build results and failure ranking *)
102 (match runs with
103 | latest_dir :: _ ->
104 let summary_file = Fpath.(latest_dir / "summary.json") in
105 (match load_run summary_file with
106 | Some latest_json ->
107 let open Yojson.Safe.Util in
108 let ts = latest_json |> member "run_id" |> to_string in
109 let ps = run_pkg_status_from_jsonl latest_dir in
110 let n_ok = Hashtbl.fold (fun _ s n ->
111 if s = "ok" then n + 1 else n) ps 0 in
112 let n_fail = Hashtbl.fold (fun _ s n ->
113 if s = "fail" then n + 1 else n) ps 0 in
114 let n_cascade = Hashtbl.fold (fun _ s n ->
115 if s = "cascade" then n + 1 else n) ps 0 in
116 let n_target_solved = match latest_json |> member "targets_requested" with
117 | `Int n -> Some n | _ -> None in
118 Printf.printf "=== Build Results (run %s) ===\n" ts;
119 (match n_target_solved with
120 | Some n -> Printf.printf " Solved (targets): %d\n" n
121 | None -> ());
122 Printf.printf " Succeeded: %d\n" n_ok;
123 Printf.printf " Failed: %d\n" n_fail;
124 Printf.printf " Cascade: %d\n\n" n_cascade;
125 (* Build failed set from this run *)
126 let failed_set : (string, unit) Hashtbl.t = Hashtbl.create 64 in
127 Hashtbl.iter (fun pkg status ->
128 if status <> "ok" then Hashtbl.replace failed_set pkg ()
129 ) ps;
130 (* Compute blocked counts from solutions *)
131 let blocked_count : (string, int) Hashtbl.t = Hashtbl.create 64 in
132 let sole_blocker_count : (string, int) Hashtbl.t =
133 Hashtbl.create 64 in
134 Hashtbl.iter (fun pkg_str solution ->
135 let visited : (string, unit) Hashtbl.t = Hashtbl.create 16 in
136 let failed_deps = ref [] in
137 let rec walk pkg =
138 let key = OpamPackage.to_string pkg in
139 if Hashtbl.mem visited key then ()
140 else begin
141 Hashtbl.replace visited key ();
142 if Hashtbl.mem failed_set key && key <> pkg_str then
143 failed_deps := key :: !failed_deps;
144 match OpamPackage.Map.find_opt pkg solution with
145 | Some deps -> OpamPackage.Set.iter walk deps
146 | None -> ()
147 end
148 in
149 let pkg = OpamPackage.of_string pkg_str in
150 walk pkg;
151 let unique_failed = List.sort_uniq String.compare !failed_deps in
152 List.iter (fun dep ->
153 let n = try Hashtbl.find blocked_count dep
154 with Not_found -> 0 in
155 Hashtbl.replace blocked_count dep (n + 1);
156 if List.length unique_failed = 1 then begin
157 let n = try Hashtbl.find sole_blocker_count dep
158 with Not_found -> 0 in
159 Hashtbl.replace sole_blocker_count dep (n + 1)
160 end
161 ) unique_failed
162 ) all_solutions;
163 (* Root failures: failed packages with status "fail" (not cascade) *)
164 let root_failures = Hashtbl.fold (fun pkg status acc ->
165 if status = "fail" then pkg :: acc else acc
166 ) ps [] in
167 let root_failures = List.sort (fun a b ->
168 let ba = try Hashtbl.find blocked_count a with Not_found -> 0 in
169 let bb = try Hashtbl.find blocked_count b with Not_found -> 0 in
170 compare bb ba
171 ) root_failures in
172 if root_failures <> [] then begin
173 Printf.printf "Root cause failures (%d):\n"
174 (List.length root_failures);
175 List.iter (fun pkg ->
176 let blocks = try Hashtbl.find blocked_count pkg
177 with Not_found -> 0 in
178 let sole = try Hashtbl.find sole_blocker_count pkg
179 with Not_found -> 0 in
180 if blocks > 0 then
181 Printf.printf " %-45s (blocks %d, %d sole)\n"
182 pkg blocks sole
183 else
184 Printf.printf " %-45s\n" pkg
185 ) root_failures
186 end;
187 if n_cascade > 0 then
188 Printf.printf "\nCascade: %d packages blocked by failed deps\n"
189 n_cascade
190 | None -> ())
191 | [] ->
192 Printf.printf "No build runs yet\n");
193 (* Run history *)
194 if List.length runs > 1 then begin
195 Printf.printf "\n=== Run History ===\n";
196 List.iter (fun run_dir ->
197 match load_run Fpath.(run_dir / "summary.json") with
198 | Some json ->
199 let open Yojson.Safe.Util in
200 let ts = json |> member "run_id" |> to_string in
201 let ps = run_pkg_status_from_jsonl run_dir in
202 let n_ok = Hashtbl.fold (fun _ s n ->
203 if s = "ok" then n + 1 else n) ps 0 in
204 let n_fail = Hashtbl.fold (fun _ s n ->
205 if s = "fail" then n + 1 else n) ps 0 in
206 let n_cascade = Hashtbl.fold (fun _ s n ->
207 if s = "cascade" then n + 1 else n) ps 0 in
208 Printf.printf " %s: %d ok, %d fail, %d cascade\n"
209 ts n_ok n_fail n_cascade
210 | None -> ()
211 ) runs;
212 (* Diff last two runs *)
213 match load_run Fpath.((List.nth runs 0) / "summary.json"),
214 load_run Fpath.((List.nth runs 1) / "summary.json") with
215 | Some _latest, Some _prev ->
216 let latest_ps = run_pkg_status_from_jsonl (List.nth runs 0) in
217 let prev_ps = run_pkg_status_from_jsonl (List.nth runs 1) in
218 let fixed = ref [] in
219 let regressed = ref [] in
220 Hashtbl.iter (fun pkg status ->
221 match Hashtbl.find_opt prev_ps pkg with
222 | Some prev_status ->
223 if status = "ok" && prev_status <> "ok" then
224 fixed := pkg :: !fixed
225 else if status <> "ok" && prev_status = "ok" then
226 regressed := pkg :: !regressed
227 | None -> ()
228 ) latest_ps;
229 let fixed = List.sort String.compare !fixed in
230 let regressed = List.sort String.compare !regressed in
231 if fixed <> [] || regressed <> [] then begin
232 Printf.printf "\n=== Changes (latest vs previous) ===\n";
233 if fixed <> [] then begin
234 Printf.printf " Fixed (%d):\n" (List.length fixed);
235 List.iteri (fun i p ->
236 if i < 20 then Printf.printf " + %s\n" p) fixed;
237 if List.length fixed > 20 then
238 Printf.printf " ... and %d more\n"
239 (List.length fixed - 20)
240 end;
241 if regressed <> [] then begin
242 Printf.printf " Regressed (%d):\n" (List.length regressed);
243 List.iteri (fun i p ->
244 if i < 20 then Printf.printf " - %s\n" p) regressed;
245 if List.length regressed > 20 then
246 Printf.printf " ... and %d more\n"
247 (List.length regressed - 20)
248 end;
249 let net = List.length fixed - List.length regressed in
250 Printf.printf " Net: %+d packages\n" net
251 end
252 | _ -> ()
253 end;
254 0
255
256let cmd =
257 let info = Cmd.info "results"
258 ~doc:"Summarise build results with failure impact ranking" in
259 let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term) in
260 Cmd.v info term