jon.recoil.org
A fork of mtelver's day10 project
1(** Progress tracking for batch builds.
2
3 Writes progress.json early (after solving phase) and updates it during
4 the build phase so the dashboard can show real-time progress.
5*)
6
7(** Build phases *)
8type phase =
9 | Solving
10 | Blessings
11 | Building
12 | Gc
13 | Completed
14
15let phase_to_string = function
16 | Solving -> "solving"
17 | Blessings -> "blessings"
18 | Building -> "building"
19 | Gc -> "gc"
20 | Completed -> "completed"
21
22(** Progress state *)
23type t = {
24 run_id : string;
25 start_time : string;
26 phase : phase;
27 targets : string list;
28 solutions_found : int;
29 solutions_failed : int;
30 build_completed : int;
31 build_total : int;
32 doc_completed : int;
33 doc_total : int;
34}
35
36(** Create initial progress state *)
37let create ~run_id ~start_time ~targets =
38 {
39 run_id;
40 start_time;
41 phase = Solving;
42 targets;
43 solutions_found = 0;
44 solutions_failed = 0;
45 build_completed = 0;
46 build_total = 0;
47 doc_completed = 0;
48 doc_total = 0;
49 }
50
51(** Update the phase *)
52let set_phase t phase = { t with phase }
53
54(** Update solutions count *)
55let set_solutions t ~found ~failed =
56 { t with solutions_found = found; solutions_failed = failed }
57
58(** Update build totals (call when entering build phase) *)
59let set_build_total t total = { t with build_total = total; doc_total = total }
60
61(** Increment build completed count *)
62let incr_build_completed t = { t with build_completed = t.build_completed + 1 }
63
64(** Increment doc completed count *)
65let incr_doc_completed t = { t with doc_completed = t.doc_completed + 1 }
66
67(** Set both build and doc completed (for sequential updates) *)
68let set_completed t ~build ~doc =
69 { t with build_completed = build; doc_completed = doc }
70
71(** Convert progress to JSON *)
72let to_json t =
73 `Assoc [
74 ("run_id", `String t.run_id);
75 ("start_time", `String t.start_time);
76 ("phase", `String (phase_to_string t.phase));
77 ("targets", `List (List.map (fun s -> `String s) t.targets));
78 ("solutions_found", `Int t.solutions_found);
79 ("solutions_failed", `Int t.solutions_failed);
80 ("build_completed", `Int t.build_completed);
81 ("build_total", `Int t.build_total);
82 ("doc_completed", `Int t.doc_completed);
83 ("doc_total", `Int t.doc_total);
84 ]
85
86(** Write progress to run directory (atomic via temp+rename) *)
87let write ~run_dir t =
88 let path = Filename.concat run_dir "progress.json" in
89 let temp_path = path ^ ".tmp" in
90 let json = to_json t in
91 let content = Yojson.Safe.pretty_to_string json in
92 Out_channel.with_open_text temp_path (fun oc ->
93 Out_channel.output_string oc content);
94 Unix.rename temp_path path
95
96(** Delete progress.json when run is complete *)
97let delete ~run_dir =
98 let path = Filename.concat run_dir "progress.json" in
99 try Unix.unlink path with Unix.Unix_error _ -> ()