forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Add History module for per-package build history tracking
Implements append-only JSONL storage for build history entries with
functions for reading, filtering by build_hash/blessed status, and
compacting old entries. This is the foundation for CI status tracking.
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+226
-1
+1
-1
day10/lib/dune
+1
-1
day10/lib/dune
+191
day10/lib/history.ml
+191
day10/lib/history.ml
···
1
+
type entry = {
2
+
ts : string;
3
+
run : string;
4
+
build_hash : string;
5
+
status : string;
6
+
category : string;
7
+
compiler : string;
8
+
blessed : bool;
9
+
error : string option;
10
+
failed_dep : string option;
11
+
failed_dep_hash : string option;
12
+
}
13
+
14
+
let entry_to_json (e : entry) : Yojson.Safe.t =
15
+
let fields = [
16
+
("ts", `String e.ts);
17
+
("run", `String e.run);
18
+
("build_hash", `String e.build_hash);
19
+
("status", `String e.status);
20
+
("category", `String e.category);
21
+
("compiler", `String e.compiler);
22
+
("blessed", `Bool e.blessed);
23
+
] in
24
+
let fields = match e.error with
25
+
| Some v -> fields @ [("error", `String v)]
26
+
| None -> fields
27
+
in
28
+
let fields = match e.failed_dep with
29
+
| Some v -> fields @ [("failed_dep", `String v)]
30
+
| None -> fields
31
+
in
32
+
let fields = match e.failed_dep_hash with
33
+
| Some v -> fields @ [("failed_dep_hash", `String v)]
34
+
| None -> fields
35
+
in
36
+
`Assoc fields
37
+
38
+
let string_of_json key assoc =
39
+
match List.assoc_opt key assoc with
40
+
| Some (`String s) -> s
41
+
| _ -> failwith (Printf.sprintf "History: missing or invalid string field %S" key)
42
+
43
+
let bool_of_json key assoc =
44
+
match List.assoc_opt key assoc with
45
+
| Some (`Bool b) -> b
46
+
| _ -> failwith (Printf.sprintf "History: missing or invalid bool field %S" key)
47
+
48
+
let string_opt_of_json key assoc =
49
+
match List.assoc_opt key assoc with
50
+
| Some (`String s) -> Some s
51
+
| Some `Null | None -> None
52
+
| _ -> failwith (Printf.sprintf "History: invalid optional string field %S" key)
53
+
54
+
let entry_of_json (json : Yojson.Safe.t) : entry =
55
+
match json with
56
+
| `Assoc assoc ->
57
+
{
58
+
ts = string_of_json "ts" assoc;
59
+
run = string_of_json "run" assoc;
60
+
build_hash = string_of_json "build_hash" assoc;
61
+
status = string_of_json "status" assoc;
62
+
category = string_of_json "category" assoc;
63
+
compiler = string_of_json "compiler" assoc;
64
+
blessed = bool_of_json "blessed" assoc;
65
+
error = string_opt_of_json "error" assoc;
66
+
failed_dep = string_opt_of_json "failed_dep" assoc;
67
+
failed_dep_hash = string_opt_of_json "failed_dep_hash" assoc;
68
+
}
69
+
| _ -> failwith "History: expected JSON object"
70
+
71
+
let history_path ~packages_dir ~pkg_str =
72
+
Filename.concat (Filename.concat packages_dir pkg_str) "history.jsonl"
73
+
74
+
let mkdir_p path =
75
+
let rec create dir =
76
+
if not (Sys.file_exists dir) then begin
77
+
create (Filename.dirname dir);
78
+
try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
79
+
end
80
+
in
81
+
create path
82
+
83
+
let append ~packages_dir ~pkg_str entry =
84
+
let path = history_path ~packages_dir ~pkg_str in
85
+
mkdir_p (Filename.dirname path);
86
+
let line = Yojson.Safe.to_string (entry_to_json entry) in
87
+
let oc = open_out_gen
88
+
[Open_append; Open_creat; Open_wronly] 0o644 path in
89
+
Fun.protect ~finally:(fun () -> close_out oc) (fun () ->
90
+
output_string oc line;
91
+
output_char oc '\n')
92
+
93
+
let read ~packages_dir ~pkg_str =
94
+
let path = history_path ~packages_dir ~pkg_str in
95
+
if not (Sys.file_exists path) then []
96
+
else begin
97
+
let ic = open_in path in
98
+
Fun.protect ~finally:(fun () -> close_in ic) (fun () ->
99
+
let entries = ref [] in
100
+
(try while true do
101
+
let line = input_line ic in
102
+
if String.length line > 0 then begin
103
+
let json = Yojson.Safe.from_string line in
104
+
entries := entry_of_json json :: !entries
105
+
end
106
+
done with End_of_file -> ());
107
+
!entries)
108
+
end
109
+
110
+
let read_latest ~packages_dir ~pkg_str =
111
+
let entries = read ~packages_dir ~pkg_str in
112
+
let seen = Hashtbl.create 16 in
113
+
List.filter (fun (e : entry) ->
114
+
if Hashtbl.mem seen e.build_hash then false
115
+
else begin Hashtbl.add seen e.build_hash true; true end
116
+
) entries
117
+
118
+
let read_blessed ~packages_dir ~pkg_str =
119
+
let entries = read ~packages_dir ~pkg_str in
120
+
List.find_opt (fun (e : entry) -> e.blessed) entries
121
+
122
+
(** Parse an ISO 8601 timestamp "YYYY-MM-DDTHH:MM:SSZ" or
123
+
"YYYY-MM-DDTHH:MM:SS" into a Unix timestamp (float). *)
124
+
let parse_iso8601 s =
125
+
try
126
+
Scanf.sscanf s "%4d-%2d-%2dT%2d:%2d:%2d"
127
+
(fun year month day hour min sec ->
128
+
let tm = {
129
+
Unix.tm_sec = sec;
130
+
tm_min = min;
131
+
tm_hour = hour;
132
+
tm_mday = day;
133
+
tm_mon = month - 1;
134
+
tm_year = year - 1900;
135
+
tm_wday = 0;
136
+
tm_yday = 0;
137
+
tm_isdst = false;
138
+
} in
139
+
let (t, _) = Unix.mktime tm in
140
+
t)
141
+
with _ -> 0.0
142
+
143
+
let compact ~packages_dir ~pkg_str ~max_age_days =
144
+
let path = history_path ~packages_dir ~pkg_str in
145
+
if not (Sys.file_exists path) then ()
146
+
else begin
147
+
(* Read entries in file order (oldest first) *)
148
+
let entries = List.rev (read ~packages_dir ~pkg_str) in
149
+
let now = Unix.gettimeofday () in
150
+
let cutoff = now -. (float_of_int max_age_days *. 86400.0) in
151
+
(* Group consecutive entries with the same (status, build_hash) *)
152
+
let rec process acc = function
153
+
| [] -> List.rev acc
154
+
| e :: rest ->
155
+
let is_old = parse_iso8601 e.ts < cutoff in
156
+
if not is_old then
157
+
process (e :: acc) rest
158
+
else begin
159
+
(* Collect a run of consecutive same-status same-build_hash entries *)
160
+
let rec collect_run run remaining =
161
+
match remaining with
162
+
| next :: tail
163
+
when next.status = e.status
164
+
&& next.build_hash = e.build_hash
165
+
&& parse_iso8601 next.ts < cutoff ->
166
+
collect_run (next :: run) tail
167
+
| _ -> (List.rev run, remaining)
168
+
in
169
+
let (run, remaining) = collect_run [e] rest in
170
+
match run with
171
+
| [single] -> process (single :: acc) remaining
172
+
| first :: _ ->
173
+
let last = List.nth run (List.length run - 1) in
174
+
if first == last then
175
+
process (first :: acc) remaining
176
+
else
177
+
process (last :: first :: acc) remaining
178
+
| [] -> process acc remaining (* can't happen *)
179
+
end
180
+
in
181
+
let compacted = process [] entries in
182
+
(* Write to temp file and rename for atomicity *)
183
+
let tmp_path = path ^ ".tmp" in
184
+
let oc = open_out tmp_path in
185
+
Fun.protect ~finally:(fun () -> close_out oc) (fun () ->
186
+
List.iter (fun e ->
187
+
output_string oc (Yojson.Safe.to_string (entry_to_json e));
188
+
output_char oc '\n'
189
+
) compacted);
190
+
Sys.rename tmp_path path
191
+
end
+34
day10/lib/history.mli
+34
day10/lib/history.mli
···
1
+
(** Per-package build history, stored as append-only JSONL files. *)
2
+
3
+
type entry = {
4
+
ts : string; (** ISO 8601 timestamp *)
5
+
run : string; (** Run identifier *)
6
+
build_hash : string; (** Build layer hash *)
7
+
status : string; (** "success" or "failure" *)
8
+
category : string; (** Failure category or "success" *)
9
+
compiler : string; (** OCaml version used *)
10
+
blessed : bool; (** Whether this is the blessed build *)
11
+
error : string option; (** Error description if failed *)
12
+
failed_dep : string option; (** For dependency_failure *)
13
+
failed_dep_hash : string option; (** Hash of the failed dep *)
14
+
}
15
+
16
+
val entry_to_json : entry -> Yojson.Safe.t
17
+
val entry_of_json : Yojson.Safe.t -> entry
18
+
19
+
(** Append an entry to the history file for a package.
20
+
File: [packages_dir]/[pkg_str]/history.jsonl *)
21
+
val append : packages_dir:string -> pkg_str:string -> entry -> unit
22
+
23
+
(** Read all history entries for a package, most recent first. *)
24
+
val read : packages_dir:string -> pkg_str:string -> entry list
25
+
26
+
(** Read only the most recent entry per build_hash for a package. *)
27
+
val read_latest : packages_dir:string -> pkg_str:string -> entry list
28
+
29
+
(** Read the most recent blessed entry for a package. *)
30
+
val read_blessed : packages_dir:string -> pkg_str:string -> entry option
31
+
32
+
(** Compact a history file: for consecutive same-status entries older
33
+
than [max_age_days], keep only first and last. *)
34
+
val compact : packages_dir:string -> pkg_str:string -> max_age_days:int -> unit