forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Track runs as layer snapshots, derive stats from layers
Each run writes runs/TIMESTAMP.json mapping layer hashes to their
package + status (ok/fail/cascade). Layers are shared across runs
(content-addressed), runs just reference them.
Results command derives history and diffs from run files:
- Per-run counts (ok/fail/cascade)
- Fixed packages (was fail, now ok)
- Regressed packages (was ok, now fail)
- Net change
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+90
-63
+14
-17
day11/bin/cmd_batch.ml
+14
-17
day11/bin/cmd_batch.ml
···
400
400
let n_failed = Atomic.get failed in
401
401
Printf.printf "\n=== Build: %d succeeded, %d failed ===\n%!"
402
402
n_succeeded n_failed;
403
-
(* Write run summary *)
403
+
(* Write run summary — maps each layer hash to its package + status *)
404
404
let runs_dir = Fpath.(cache_dir / "runs") in
405
405
Bos.OS.Dir.create ~path:true runs_dir |> ignore;
406
406
let timestamp = Day11_layer.Layer_meta.now_iso8601 () in
407
-
let succeeded_pkgs = List.filter_map (fun (node : Day11_layer.Layer_type.build) ->
407
+
let layer_entries = List.filter_map (fun (node : Day11_layer.Layer_type.build) ->
408
408
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
409
409
match Day11_layer.Layer_meta.load_build Fpath.(dir / "layer.json") with
410
-
| Ok { exit_status = 0; _ } -> Some (OpamPackage.to_string node.pkg)
411
-
| _ -> None
412
-
) nodes in
413
-
let failed_pkgs = List.filter_map (fun (node : Day11_layer.Layer_type.build) ->
414
-
let dir = Day11_layer.Layer_type.build_dir ~os_dir node in
415
-
match Day11_layer.Layer_meta.load_build Fpath.(dir / "layer.json") with
416
-
| Ok { exit_status; _ } when exit_status <> 0 ->
417
-
Some (OpamPackage.to_string node.pkg)
418
-
| _ -> None
410
+
| Ok meta ->
411
+
let status = if meta.exit_status = 0 then "ok"
412
+
else if meta.exit_status = -1 then "cascade"
413
+
else "fail" in
414
+
Some (node.hash, `Assoc [
415
+
("package", `String (OpamPackage.to_string node.pkg));
416
+
("status", `String status);
417
+
("failed_dep", match meta.failed_dep with
418
+
| Some d -> `String d | None -> `Null);
419
+
])
420
+
| Error _ -> None
419
421
) nodes in
420
422
let run_json = `Assoc [
421
423
("timestamp", `String timestamp);
···
423
425
`Assoc [ ("path", `String repo); ("commit", `String sha) ]
424
426
) repos_with_shas));
425
427
("solved", `Int n_solved);
426
-
("succeeded", `Int (List.length succeeded_pkgs));
427
-
("failed", `Int (List.length failed_pkgs));
428
-
("succeeded_packages", `List (List.map (fun s -> `String s)
429
-
(List.sort_uniq String.compare succeeded_pkgs)));
430
-
("failed_packages", `List (List.map (fun s -> `String s)
431
-
(List.sort_uniq String.compare failed_pkgs)));
428
+
("layers", `Assoc layer_entries);
432
429
] in
433
430
let run_file = Fpath.(runs_dir / (timestamp ^ ".json")) in
434
431
ignore (Bos.OS.File.write run_file (Yojson.Safe.pretty_to_string run_json));
+76
-46
day11/bin/cmd_results.ml
+76
-46
day11/bin/cmd_results.ml
···
174
174
if cascade_count > 0 then
175
175
Printf.printf "\nCascade failures: %d layers from duplicate hashes or cascades\n"
176
176
cascade_count;
177
-
(* Show run history and diff *)
177
+
(* Show run history and diff — derived from layers *)
178
178
let runs_dir = Fpath.(cache_dir / "runs") in
179
+
let load_run f =
180
+
try
181
+
let data = In_channel.with_open_text (Fpath.to_string f)
182
+
In_channel.input_all in
183
+
let json = Yojson.Safe.from_string data in
184
+
Some json
185
+
with _ -> None
186
+
in
187
+
let run_pkg_status json =
188
+
let open Yojson.Safe.Util in
189
+
let layers = json |> member "layers" |> to_assoc in
190
+
let pkg_status : (string, string) Hashtbl.t = Hashtbl.create 256 in
191
+
List.iter (fun (_hash, entry) ->
192
+
let pkg = entry |> member "package" |> to_string in
193
+
let status = entry |> member "status" |> to_string in
194
+
(* Keep the "best" status per package (ok > fail > cascade) *)
195
+
match Hashtbl.find_opt pkg_status pkg with
196
+
| Some "ok" -> ()
197
+
| _ -> Hashtbl.replace pkg_status pkg status
198
+
) layers;
199
+
pkg_status
200
+
in
179
201
(match Bos.OS.Dir.contents runs_dir with
180
202
| Ok files ->
181
203
let runs = files
182
204
|> List.filter (fun f -> Fpath.has_ext ".json" f)
183
-
|> List.sort (fun a b -> compare (Fpath.to_string b) (Fpath.to_string a))
205
+
|> List.sort (fun a b ->
206
+
compare (Fpath.to_string b) (Fpath.to_string a))
184
207
in
185
208
if runs <> [] then begin
186
209
Printf.printf "\n=== Run History ===\n";
187
210
List.iter (fun f ->
188
-
(try
189
-
let data = In_channel.with_open_text (Fpath.to_string f)
190
-
In_channel.input_all in
191
-
let json = Yojson.Safe.from_string data in
211
+
match load_run f with
212
+
| Some json ->
192
213
let open Yojson.Safe.Util in
193
214
let ts = json |> member "timestamp" |> to_string in
194
-
let ok = json |> member "succeeded" |> to_int in
195
-
let fail = json |> member "failed" |> to_int in
196
-
Printf.printf " %s: %d succeeded, %d failed\n" ts ok fail
197
-
with _ -> ())
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 -> ()
198
225
) runs;
199
226
(* Diff last two runs *)
200
227
if List.length runs >= 2 then begin
201
-
let load_pkg_list json key =
202
-
let open Yojson.Safe.Util in
203
-
json |> member key |> to_list |> List.map to_string
204
-
|> List.sort String.compare
205
-
in
206
-
(try
207
-
let latest = Yojson.Safe.from_file
208
-
(Fpath.to_string (List.nth runs 0)) in
209
-
let prev = Yojson.Safe.from_file
210
-
(Fpath.to_string (List.nth runs 1)) in
211
-
let latest_ok = load_pkg_list latest "succeeded_packages" in
212
-
let prev_ok = load_pkg_list prev "succeeded_packages" in
213
-
let latest_fail = load_pkg_list latest "failed_packages" in
214
-
let prev_fail = load_pkg_list prev "failed_packages" in
215
-
let newly_ok = List.filter (fun p ->
216
-
not (List.mem p prev_ok)) latest_ok in
217
-
let newly_fail = List.filter (fun p ->
218
-
not (List.mem p prev_fail)) latest_fail in
219
-
let fixed = List.filter (fun p ->
220
-
List.mem p prev_fail) newly_ok in
221
-
if newly_ok <> [] || newly_fail <> [] 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
222
249
Printf.printf "\n=== Changes (latest vs previous) ===\n";
223
250
if fixed <> [] then begin
224
251
Printf.printf " Fixed (%d):\n" (List.length fixed);
225
-
List.iter (fun p ->
226
-
Printf.printf " + %s\n" p) (List.filteri (fun i _ -> i < 20) fixed);
252
+
List.iteri (fun i p ->
253
+
if i < 20 then Printf.printf " + %s\n" p) fixed;
227
254
if List.length fixed > 20 then
228
-
Printf.printf " ... and %d more\n" (List.length fixed - 20)
255
+
Printf.printf " ... and %d more\n"
256
+
(List.length fixed - 20)
229
257
end;
230
-
if newly_fail <> [] then begin
231
-
Printf.printf " New failures (%d):\n" (List.length newly_fail);
232
-
List.iter (fun p ->
233
-
Printf.printf " - %s\n" p) (List.filteri (fun i _ -> i < 20) newly_fail);
234
-
if List.length newly_fail > 20 then
235
-
Printf.printf " ... and %d more\n" (List.length newly_fail - 20)
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)
236
265
end;
237
-
let net = List.length newly_ok - List.length newly_fail in
238
-
if net > 0 then
239
-
Printf.printf " Net: +%d packages\n" net
240
-
else if net < 0 then
241
-
Printf.printf " Net: %d packages\n" net
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
242
272
end
243
-
with _ -> ())
273
+
| _ -> ()
244
274
end
245
275
end
246
276
| Error _ -> ());