forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Rewrite results to derive everything from run files
Build results, failure ranking, and blocked counts now come from
the latest run file instead of scanning layer.json on disk. This
fixes the empty results when the os_dir path doesn't match, and
ensures results always reflect a specific run.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+158
-203
+158
-203
day11/bin/cmd_results.ml
+158
-203
day11/bin/cmd_results.ml
···
4
4
5
5
let run cache_dir =
6
6
let cache_dir = Common.fpath cache_dir in
7
-
(* Find the os_dir *)
8
-
let os_dir =
9
-
match Bos.OS.Dir.contents cache_dir with
10
-
| Ok entries ->
11
-
List.find_opt (fun p ->
12
-
let name = Fpath.basename p in
13
-
String.length name > 0 &&
14
-
Bos.OS.Dir.exists Fpath.(p / "packages") |> Result.get_ok
15
-
) entries
16
-
| Error _ -> None
17
-
in
18
-
(* Load solutions first — always available after --solve-only *)
7
+
(* Load solutions *)
19
8
let solutions_dir = Fpath.(cache_dir / "solutions") in
20
9
let all_solutions : (string, Day11_graph.Graph.solution) Hashtbl.t =
21
10
Hashtbl.create 4096 in
···
63
52
Printf.printf "=== Solver Results ===\n";
64
53
Printf.printf " Solved: %d\n" (Hashtbl.length all_solutions);
65
54
Printf.printf " Solve failed: %d\n\n" !n_solve_failures;
66
-
match os_dir with
67
-
| None ->
68
-
Printf.printf "No build results yet (run without --solve-only to build)\n";
69
-
0
70
-
| Some os_dir ->
71
-
(* Scan all build layers *)
72
-
let build_dirs =
73
-
match Bos.OS.Dir.contents os_dir with
74
-
| Ok entries ->
75
-
List.filter (fun p ->
76
-
let name = Fpath.basename p in
77
-
String.starts_with ~prefix:"build-" name &&
78
-
not (Fpath.has_ext ".lock" p) &&
79
-
Bos.OS.File.exists Fpath.(p / "layer.json") |> Result.get_ok
80
-
) entries
81
-
| Error _ -> []
82
-
in
83
-
(* Load metadata *)
84
-
let layers = List.filter_map (fun dir ->
85
-
match Day11_layer.Layer_meta.load_build Fpath.(dir / "layer.json") with
86
-
| Ok meta -> Some (Fpath.basename dir, meta)
87
-
| Error _ -> None
88
-
) build_dirs in
89
-
let total = List.length layers in
90
-
let succeeded = List.filter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
91
-
m.exit_status = 0) layers in
92
-
let failed = List.filter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
93
-
m.exit_status <> 0) layers in
94
-
Printf.printf "=== Build Results ===\n";
95
-
Printf.printf " Total layers: %d\n" total;
96
-
Printf.printf " Succeeded: %d\n" (List.length succeeded);
97
-
Printf.printf " Failed: %d\n\n" (List.length failed);
98
-
let failed_set : (string, unit) Hashtbl.t = Hashtbl.create 64 in
99
-
List.iter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
100
-
Hashtbl.replace failed_set m.package ()
101
-
) failed;
102
-
(* For each solved package, find which failed packages it
103
-
transitively depends on. Track total blocks and sole-blocker count. *)
104
-
let blocked_count : (string, int) Hashtbl.t = Hashtbl.create 64 in
105
-
let sole_blocker_count : (string, int) Hashtbl.t = Hashtbl.create 64 in
106
-
Hashtbl.iter (fun pkg_str solution ->
107
-
(* Walk the solution's deps to collect all failed deps *)
108
-
let visited : (string, unit) Hashtbl.t = Hashtbl.create 16 in
109
-
let failed_deps = ref [] in
110
-
let rec walk pkg =
111
-
let key = OpamPackage.to_string pkg in
112
-
if Hashtbl.mem visited key then ()
113
-
else begin
114
-
Hashtbl.replace visited key ();
115
-
if Hashtbl.mem failed_set key && key <> pkg_str then
116
-
failed_deps := key :: !failed_deps;
117
-
match OpamPackage.Map.find_opt pkg solution with
118
-
| Some deps ->
119
-
OpamPackage.Set.iter walk deps
120
-
| None -> ()
121
-
end
122
-
in
123
-
let pkg = OpamPackage.of_string pkg_str in
124
-
walk pkg;
125
-
let unique_failed = List.sort_uniq String.compare !failed_deps in
126
-
List.iter (fun dep ->
127
-
let n = try Hashtbl.find blocked_count dep with Not_found -> 0 in
128
-
Hashtbl.replace blocked_count dep (n + 1);
129
-
if List.length unique_failed = 1 then begin
130
-
let n = try Hashtbl.find sole_blocker_count dep with Not_found -> 0 in
131
-
Hashtbl.replace sole_blocker_count dep (n + 1)
132
-
end
133
-
) unique_failed
134
-
) all_solutions;
135
-
(* Separate root cause failures from cascaded failures using failed_dep *)
136
-
let root_failures = List.filter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
137
-
m.failed_dep = None
138
-
) failed in
139
-
let cascade_failures = List.filter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
140
-
m.failed_dep <> None
141
-
) failed in
142
-
(* Deduplicate by package name — keep one entry per package *)
143
-
let seen_root : (string, unit) Hashtbl.t = Hashtbl.create 64 in
144
-
let root_failures = List.filter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
145
-
if Hashtbl.mem seen_root m.package then false
146
-
else begin Hashtbl.replace seen_root m.package (); true end
147
-
) root_failures in
148
-
ignore cascade_failures;
149
-
let cascade_count = List.length failed - List.length root_failures in
150
-
(* Sort root failures by blocked count *)
151
-
let root_failures = List.sort (fun (_, (a : Day11_layer.Layer_meta.build_meta))
152
-
(_, (b : Day11_layer.Layer_meta.build_meta)) ->
153
-
let ba = try Hashtbl.find blocked_count a.package with Not_found -> 0 in
154
-
let bb = try Hashtbl.find blocked_count b.package with Not_found -> 0 in
155
-
compare bb ba
156
-
) root_failures in
157
-
if root_failures <> [] then begin
158
-
Printf.printf "Root cause failures (%d):\n" (List.length root_failures);
159
-
List.iter (fun (_, (m : Day11_layer.Layer_meta.build_meta)) ->
160
-
let blocks = try Hashtbl.find blocked_count m.package
161
-
with Not_found -> 0 in
162
-
let patched = if m.patches <> [] then
163
-
Printf.sprintf " [patched: %s]" (String.concat ", " m.patches)
164
-
else "" in
165
-
let sole = try Hashtbl.find sole_blocker_count m.package
166
-
with Not_found -> 0 in
167
-
if blocks > 0 then
168
-
Printf.printf " %-45s (blocks %d, %d sole)%s\n"
169
-
m.package blocks sole patched
170
-
else
171
-
Printf.printf " %-45s%s\n" m.package patched
172
-
) root_failures
173
-
end;
174
-
if cascade_count > 0 then
175
-
Printf.printf "\nCascade failures: %d layers from duplicate hashes or cascades\n"
176
-
cascade_count;
177
-
(* Show run history and diff — derived from layers *)
55
+
(* Load runs *)
178
56
let runs_dir = Fpath.(cache_dir / "runs") in
179
57
let load_run f =
180
58
try
181
59
let data = In_channel.with_open_text (Fpath.to_string f)
182
60
In_channel.input_all in
183
-
let json = Yojson.Safe.from_string data in
184
-
Some json
61
+
Some (Yojson.Safe.from_string data)
185
62
with _ -> None
186
63
in
187
64
let run_pkg_status json =
···
191
68
List.iter (fun (_hash, entry) ->
192
69
let pkg = entry |> member "package" |> to_string in
193
70
let status = entry |> member "status" |> to_string in
194
-
(* Keep the "best" status per package (ok > fail > cascade) *)
195
71
match Hashtbl.find_opt pkg_status pkg with
196
72
| Some "ok" -> ()
197
73
| _ -> Hashtbl.replace pkg_status pkg status
198
74
) layers;
199
75
pkg_status
200
76
in
201
-
(match Bos.OS.Dir.contents runs_dir with
202
-
| Ok files ->
203
-
let runs = files
204
-
|> List.filter (fun f -> Fpath.has_ext ".json" f)
205
-
|> List.sort (fun a b ->
206
-
compare (Fpath.to_string b) (Fpath.to_string a))
207
-
in
208
-
if runs <> [] then begin
209
-
Printf.printf "\n=== Run History ===\n";
210
-
List.iter (fun f ->
211
-
match load_run f with
212
-
| Some json ->
213
-
let open Yojson.Safe.Util in
214
-
let ts = json |> member "timestamp" |> to_string in
215
-
let ps = run_pkg_status json in
216
-
let n_ok = Hashtbl.fold (fun _ s n ->
217
-
if s = "ok" then n + 1 else n) ps 0 in
218
-
let n_fail = Hashtbl.fold (fun _ s n ->
219
-
if s = "fail" then n + 1 else n) ps 0 in
220
-
let n_cascade = Hashtbl.fold (fun _ s n ->
221
-
if s = "cascade" then n + 1 else n) ps 0 in
222
-
Printf.printf " %s: %d ok, %d fail, %d cascade\n"
223
-
ts n_ok n_fail n_cascade
224
-
| None -> ()
225
-
) runs;
226
-
(* Diff last two runs *)
227
-
if List.length runs >= 2 then begin
228
-
match load_run (List.nth runs 0), load_run (List.nth runs 1) with
229
-
| Some latest, Some prev ->
230
-
let latest_ps = run_pkg_status latest in
231
-
let prev_ps = run_pkg_status prev in
232
-
let fixed = ref [] in
233
-
let regressed = ref [] in
234
-
let new_ok = ref [] in
235
-
Hashtbl.iter (fun pkg status ->
236
-
match Hashtbl.find_opt prev_ps pkg with
237
-
| Some prev_status ->
238
-
if status = "ok" && prev_status <> "ok" then
239
-
fixed := pkg :: !fixed
240
-
else if status <> "ok" && prev_status = "ok" then
241
-
regressed := pkg :: !regressed
242
-
| None ->
243
-
if status = "ok" then new_ok := pkg :: !new_ok
244
-
) latest_ps;
245
-
let fixed = List.sort String.compare !fixed in
246
-
let regressed = List.sort String.compare !regressed in
247
-
let new_ok = List.sort String.compare !new_ok in
248
-
if fixed <> [] || regressed <> [] || new_ok <> [] then begin
249
-
Printf.printf "\n=== Changes (latest vs previous) ===\n";
250
-
if fixed <> [] then begin
251
-
Printf.printf " Fixed (%d):\n" (List.length fixed);
252
-
List.iteri (fun i p ->
253
-
if i < 20 then Printf.printf " + %s\n" p) fixed;
254
-
if List.length fixed > 20 then
255
-
Printf.printf " ... and %d more\n"
256
-
(List.length fixed - 20)
257
-
end;
258
-
if regressed <> [] then begin
259
-
Printf.printf " Regressed (%d):\n" (List.length regressed);
260
-
List.iteri (fun i p ->
261
-
if i < 20 then Printf.printf " - %s\n" p) regressed;
262
-
if List.length regressed > 20 then
263
-
Printf.printf " ... and %d more\n"
264
-
(List.length regressed - 20)
265
-
end;
266
-
if new_ok <> [] then
267
-
Printf.printf " New packages built: %d\n"
268
-
(List.length new_ok);
269
-
let net = List.length fixed - List.length regressed
270
-
+ List.length new_ok in
271
-
Printf.printf " Net: %+d packages\n" net
272
-
end
273
-
| _ -> ()
274
-
end
275
-
end
276
-
| Error _ -> ());
77
+
let runs =
78
+
match Bos.OS.Dir.contents runs_dir with
79
+
| Ok files ->
80
+
files
81
+
|> List.filter (fun f -> Fpath.has_ext ".json" f)
82
+
|> List.sort (fun a b ->
83
+
compare (Fpath.to_string b) (Fpath.to_string a))
84
+
| Error _ -> []
85
+
in
86
+
(* Use latest run for build results and failure ranking *)
87
+
(match runs with
88
+
| latest_file :: _ ->
89
+
(match load_run latest_file with
90
+
| Some latest_json ->
91
+
let open Yojson.Safe.Util in
92
+
let ts = latest_json |> member "timestamp" |> to_string in
93
+
let ps = run_pkg_status latest_json in
94
+
let n_ok = Hashtbl.fold (fun _ s n ->
95
+
if s = "ok" then n + 1 else n) ps 0 in
96
+
let n_fail = Hashtbl.fold (fun _ s n ->
97
+
if s = "fail" then n + 1 else n) ps 0 in
98
+
let n_cascade = Hashtbl.fold (fun _ s n ->
99
+
if s = "cascade" then n + 1 else n) ps 0 in
100
+
Printf.printf "=== Build Results (run %s) ===\n" ts;
101
+
Printf.printf " Succeeded: %d\n" n_ok;
102
+
Printf.printf " Failed: %d\n" n_fail;
103
+
Printf.printf " Cascade: %d\n\n" n_cascade;
104
+
(* Build failed set from this run *)
105
+
let failed_set : (string, unit) Hashtbl.t = Hashtbl.create 64 in
106
+
Hashtbl.iter (fun pkg status ->
107
+
if status <> "ok" then Hashtbl.replace failed_set pkg ()
108
+
) ps;
109
+
(* Compute blocked counts from solutions *)
110
+
let blocked_count : (string, int) Hashtbl.t = Hashtbl.create 64 in
111
+
let sole_blocker_count : (string, int) Hashtbl.t =
112
+
Hashtbl.create 64 in
113
+
Hashtbl.iter (fun pkg_str solution ->
114
+
let visited : (string, unit) Hashtbl.t = Hashtbl.create 16 in
115
+
let failed_deps = ref [] in
116
+
let rec walk pkg =
117
+
let key = OpamPackage.to_string pkg in
118
+
if Hashtbl.mem visited key then ()
119
+
else begin
120
+
Hashtbl.replace visited key ();
121
+
if Hashtbl.mem failed_set key && key <> pkg_str then
122
+
failed_deps := key :: !failed_deps;
123
+
match OpamPackage.Map.find_opt pkg solution with
124
+
| Some deps -> OpamPackage.Set.iter walk deps
125
+
| None -> ()
126
+
end
127
+
in
128
+
let pkg = OpamPackage.of_string pkg_str in
129
+
walk pkg;
130
+
let unique_failed = List.sort_uniq String.compare !failed_deps in
131
+
List.iter (fun dep ->
132
+
let n = try Hashtbl.find blocked_count dep
133
+
with Not_found -> 0 in
134
+
Hashtbl.replace blocked_count dep (n + 1);
135
+
if List.length unique_failed = 1 then begin
136
+
let n = try Hashtbl.find sole_blocker_count dep
137
+
with Not_found -> 0 in
138
+
Hashtbl.replace sole_blocker_count dep (n + 1)
139
+
end
140
+
) unique_failed
141
+
) all_solutions;
142
+
(* Root failures: failed packages with status "fail" (not cascade) *)
143
+
let root_failures = Hashtbl.fold (fun pkg status acc ->
144
+
if status = "fail" then pkg :: acc else acc
145
+
) ps [] in
146
+
let root_failures = List.sort (fun a b ->
147
+
let ba = try Hashtbl.find blocked_count a with Not_found -> 0 in
148
+
let bb = try Hashtbl.find blocked_count b with Not_found -> 0 in
149
+
compare bb ba
150
+
) root_failures in
151
+
if root_failures <> [] then begin
152
+
Printf.printf "Root cause failures (%d):\n"
153
+
(List.length root_failures);
154
+
List.iter (fun pkg ->
155
+
let blocks = try Hashtbl.find blocked_count pkg
156
+
with Not_found -> 0 in
157
+
let sole = try Hashtbl.find sole_blocker_count pkg
158
+
with Not_found -> 0 in
159
+
if blocks > 0 then
160
+
Printf.printf " %-45s (blocks %d, %d sole)\n"
161
+
pkg blocks sole
162
+
else
163
+
Printf.printf " %-45s\n" pkg
164
+
) root_failures
165
+
end;
166
+
if n_cascade > 0 then
167
+
Printf.printf "\nCascade: %d packages blocked by failed deps\n"
168
+
n_cascade
169
+
| None -> ())
170
+
| [] ->
171
+
Printf.printf "No build runs yet\n");
172
+
(* Run history *)
173
+
if List.length runs > 1 then begin
174
+
Printf.printf "\n=== Run History ===\n";
175
+
List.iter (fun f ->
176
+
match load_run f with
177
+
| Some json ->
178
+
let open Yojson.Safe.Util in
179
+
let ts = json |> member "timestamp" |> to_string in
180
+
let ps = run_pkg_status json in
181
+
let n_ok = Hashtbl.fold (fun _ s n ->
182
+
if s = "ok" then n + 1 else n) ps 0 in
183
+
let n_fail = Hashtbl.fold (fun _ s n ->
184
+
if s = "fail" then n + 1 else n) ps 0 in
185
+
let n_cascade = Hashtbl.fold (fun _ s n ->
186
+
if s = "cascade" then n + 1 else n) ps 0 in
187
+
Printf.printf " %s: %d ok, %d fail, %d cascade\n"
188
+
ts n_ok n_fail n_cascade
189
+
| None -> ()
190
+
) runs;
191
+
(* Diff last two runs *)
192
+
match load_run (List.nth runs 0), load_run (List.nth runs 1) with
193
+
| Some latest, Some prev ->
194
+
let latest_ps = run_pkg_status latest in
195
+
let prev_ps = run_pkg_status prev in
196
+
let fixed = ref [] in
197
+
let regressed = ref [] in
198
+
Hashtbl.iter (fun pkg status ->
199
+
match Hashtbl.find_opt prev_ps pkg with
200
+
| Some prev_status ->
201
+
if status = "ok" && prev_status <> "ok" then
202
+
fixed := pkg :: !fixed
203
+
else if status <> "ok" && prev_status = "ok" then
204
+
regressed := pkg :: !regressed
205
+
| None -> ()
206
+
) latest_ps;
207
+
let fixed = List.sort String.compare !fixed in
208
+
let regressed = List.sort String.compare !regressed in
209
+
if fixed <> [] || regressed <> [] then begin
210
+
Printf.printf "\n=== Changes (latest vs previous) ===\n";
211
+
if fixed <> [] then begin
212
+
Printf.printf " Fixed (%d):\n" (List.length fixed);
213
+
List.iteri (fun i p ->
214
+
if i < 20 then Printf.printf " + %s\n" p) fixed;
215
+
if List.length fixed > 20 then
216
+
Printf.printf " ... and %d more\n"
217
+
(List.length fixed - 20)
218
+
end;
219
+
if regressed <> [] then begin
220
+
Printf.printf " Regressed (%d):\n" (List.length regressed);
221
+
List.iteri (fun i p ->
222
+
if i < 20 then Printf.printf " - %s\n" p) regressed;
223
+
if List.length regressed > 20 then
224
+
Printf.printf " ... and %d more\n"
225
+
(List.length regressed - 20)
226
+
end;
227
+
let net = List.length fixed - List.length regressed in
228
+
Printf.printf " Net: %+d packages\n" net
229
+
end
230
+
| _ -> ()
231
+
end;
277
232
0
278
233
279
234
let cmd =