jon.recoil.org
A fork of mtelver's day10 project
Add status_index module for global state and change detection
Implements Status_index with JSON serialization, generation from
package history files, change detection between runs, and atomic
file writes. Scans package directories, tallies blessed/non-blessed
totals by category, detects status changes and new packages.
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+1
-1
lib/dune
+1
-1
lib/dune
+208
lib/status_index.ml
+208
lib/status_index.ml
···
1
+
type change = {
2
+
package : string;
3
+
build_hash : string;
4
+
blessed : bool;
5
+
from_status : string;
6
+
to_status : string;
7
+
}
8
+
9
+
type totals = (string * int) list
10
+
11
+
type t = {
12
+
generated : string;
13
+
run_id : string;
14
+
blessed_totals : totals;
15
+
non_blessed_totals : totals;
16
+
changes : change list;
17
+
new_packages : string list;
18
+
}
19
+
20
+
let totals_to_json (t : totals) : Yojson.Safe.t =
21
+
`Assoc (List.map (fun (k, v) -> (k, `Int v)) t)
22
+
23
+
let totals_of_json (json : Yojson.Safe.t) : totals =
24
+
match json with
25
+
| `Assoc assoc ->
26
+
List.filter_map (fun (k, v) ->
27
+
match v with
28
+
| `Int n -> Some (k, n)
29
+
| _ -> None
30
+
) assoc
31
+
| _ -> []
32
+
33
+
let change_to_json (c : change) : Yojson.Safe.t =
34
+
`Assoc [
35
+
("package", `String c.package);
36
+
("build_hash", `String c.build_hash);
37
+
("blessed", `Bool c.blessed);
38
+
("from", `String c.from_status);
39
+
("to", `String c.to_status);
40
+
]
41
+
42
+
let change_of_json (json : Yojson.Safe.t) : change =
43
+
match json with
44
+
| `Assoc assoc ->
45
+
let s key =
46
+
match List.assoc_opt key assoc with
47
+
| Some (`String s) -> s
48
+
| _ -> failwith (Printf.sprintf "Status_index: missing field %S" key)
49
+
in
50
+
let b key =
51
+
match List.assoc_opt key assoc with
52
+
| Some (`Bool b) -> b
53
+
| _ -> failwith (Printf.sprintf "Status_index: missing bool field %S" key)
54
+
in
55
+
{
56
+
package = s "package";
57
+
build_hash = s "build_hash";
58
+
blessed = b "blessed";
59
+
from_status = s "from";
60
+
to_status = s "to";
61
+
}
62
+
| _ -> failwith "Status_index: expected JSON object for change"
63
+
64
+
let to_json (t : t) : Yojson.Safe.t =
65
+
`Assoc [
66
+
("generated", `String t.generated);
67
+
("run_id", `String t.run_id);
68
+
("blessed_totals", totals_to_json t.blessed_totals);
69
+
("non_blessed_totals", totals_to_json t.non_blessed_totals);
70
+
("changes_since_last", `List (List.map change_to_json t.changes));
71
+
("new_packages", `List (List.map (fun s -> `String s) t.new_packages));
72
+
]
73
+
74
+
let of_json (json : Yojson.Safe.t) : t =
75
+
match json with
76
+
| `Assoc assoc ->
77
+
let s key =
78
+
match List.assoc_opt key assoc with
79
+
| Some (`String s) -> s
80
+
| _ -> failwith (Printf.sprintf "Status_index: missing field %S" key)
81
+
in
82
+
let changes =
83
+
match List.assoc_opt "changes_since_last" assoc with
84
+
| Some (`List l) -> List.map change_of_json l
85
+
| _ -> []
86
+
in
87
+
let new_packages =
88
+
match List.assoc_opt "new_packages" assoc with
89
+
| Some (`List l) ->
90
+
List.filter_map (fun j ->
91
+
match j with `String s -> Some s | _ -> None
92
+
) l
93
+
| _ -> []
94
+
in
95
+
{
96
+
generated = s "generated";
97
+
run_id = s "run_id";
98
+
blessed_totals = totals_of_json
99
+
(match List.assoc_opt "blessed_totals" assoc with
100
+
| Some j -> j | None -> `Assoc []);
101
+
non_blessed_totals = totals_of_json
102
+
(match List.assoc_opt "non_blessed_totals" assoc with
103
+
| Some j -> j | None -> `Assoc []);
104
+
changes;
105
+
new_packages;
106
+
}
107
+
| _ -> failwith "Status_index: expected JSON object"
108
+
109
+
let iso8601_now () =
110
+
let t = Unix.gettimeofday () in
111
+
let tm = Unix.gmtime t in
112
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
113
+
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
114
+
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
115
+
116
+
let incr_totals totals category =
117
+
match List.assoc_opt category totals with
118
+
| Some n -> (category, n + 1) :: List.filter (fun (k, _) -> k <> category) totals
119
+
| None -> (category, 1) :: totals
120
+
121
+
let list_subdirs dir =
122
+
if not (Sys.file_exists dir) then []
123
+
else
124
+
Sys.readdir dir
125
+
|> Array.to_list
126
+
|> List.filter (fun name ->
127
+
let path = Filename.concat dir name in
128
+
try Sys.is_directory path with Sys_error _ -> false)
129
+
130
+
let generate ~packages_dir ~run_id ~previous:_ =
131
+
let pkg_dirs = list_subdirs packages_dir in
132
+
let blessed_totals = ref [] in
133
+
let non_blessed_totals = ref [] in
134
+
let changes = ref [] in
135
+
let new_packages = ref [] in
136
+
List.iter (fun pkg_str ->
137
+
let latest_entries = History.read_latest ~packages_dir ~pkg_str in
138
+
(* Tally blessed and non-blessed totals *)
139
+
List.iter (fun (e : History.entry) ->
140
+
if e.blessed then
141
+
blessed_totals := incr_totals !blessed_totals e.category
142
+
else
143
+
non_blessed_totals := incr_totals !non_blessed_totals e.category
144
+
) latest_entries;
145
+
(* Detect changes: read full history for this package *)
146
+
let all_entries = History.read ~packages_dir ~pkg_str in
147
+
(* Group by build_hash and check for status changes in this run *)
148
+
let seen_hashes = Hashtbl.create 16 in
149
+
List.iter (fun (e : History.entry) ->
150
+
if not (Hashtbl.mem seen_hashes e.build_hash) then begin
151
+
Hashtbl.add seen_hashes e.build_hash true;
152
+
(* This is the latest entry for this build_hash (since read returns
153
+
most recent first). Find the previous entry for same build_hash. *)
154
+
if e.run = run_id then begin
155
+
(* Look for the next entry with the same build_hash *)
156
+
let prev = List.find_opt (fun (e2 : History.entry) ->
157
+
e2.build_hash = e.build_hash && e2.run <> run_id
158
+
) all_entries in
159
+
match prev with
160
+
| Some prev_entry when prev_entry.category <> e.category ->
161
+
changes := {
162
+
package = pkg_str;
163
+
build_hash = e.build_hash;
164
+
blessed = e.blessed;
165
+
from_status = prev_entry.category;
166
+
to_status = e.category;
167
+
} :: !changes
168
+
| _ -> ()
169
+
end
170
+
end
171
+
) all_entries;
172
+
(* New packages: all entries have run_id matching current run *)
173
+
let is_new = List.for_all (fun (e : History.entry) ->
174
+
e.run = run_id
175
+
) all_entries in
176
+
if is_new && all_entries <> [] then
177
+
new_packages := pkg_str :: !new_packages
178
+
) pkg_dirs;
179
+
{
180
+
generated = iso8601_now ();
181
+
run_id;
182
+
blessed_totals = !blessed_totals;
183
+
non_blessed_totals = !non_blessed_totals;
184
+
changes = List.rev !changes;
185
+
new_packages = List.rev !new_packages;
186
+
}
187
+
188
+
let status_path dir = Filename.concat dir "status.json"
189
+
190
+
let write ~dir t =
191
+
let path = status_path dir in
192
+
let json_str = Yojson.Safe.pretty_to_string (to_json t) in
193
+
let tmp_path = path ^ ".tmp" in
194
+
let oc = open_out tmp_path in
195
+
Fun.protect ~finally:(fun () -> close_out oc) (fun () ->
196
+
output_string oc json_str;
197
+
output_char oc '\n');
198
+
Sys.rename tmp_path path
199
+
200
+
let read ~dir =
201
+
let path = status_path dir in
202
+
if not (Sys.file_exists path) then None
203
+
else begin
204
+
try
205
+
let json = Yojson.Safe.from_file path in
206
+
Some (of_json json)
207
+
with _ -> None
208
+
end
+38
lib/status_index.mli
+38
lib/status_index.mli
···
1
+
(** Global status index — regenerated after each run. *)
2
+
3
+
type change = {
4
+
package : string;
5
+
build_hash : string;
6
+
blessed : bool;
7
+
from_status : string;
8
+
to_status : string;
9
+
}
10
+
11
+
type totals = (string * int) list
12
+
(** Association list of category -> count *)
13
+
14
+
type t = {
15
+
generated : string; (** ISO 8601 *)
16
+
run_id : string;
17
+
blessed_totals : totals;
18
+
non_blessed_totals : totals;
19
+
changes : change list;
20
+
new_packages : string list;
21
+
}
22
+
23
+
val to_json : t -> Yojson.Safe.t
24
+
val of_json : Yojson.Safe.t -> t
25
+
26
+
(** Generate a status index by scanning all package history files.
27
+
Compares with previous index (if exists) to detect changes. *)
28
+
val generate :
29
+
packages_dir:string ->
30
+
run_id:string ->
31
+
previous:t option ->
32
+
t
33
+
34
+
(** Write status.json to the given directory. *)
35
+
val write : dir:string -> t -> unit
36
+
37
+
(** Read status.json from the given directory. Returns None if missing. *)
38
+
val read : dir:string -> t option