jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1(*---------------------------------------------------------------------------
2 Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Daily changes with per-day-per-repo structure.
7
8 This module provides an immutable data structure for loading and querying
9 daily changes from per-day-per-repo JSON files. Files are named
10 [<repo>-<YYYY-MM-DD>.json] and contain timestamped entries for real-time
11 tracking. *)
12
13type commit_range = { from_hash : string; to_hash : string; count : int }
14
15type entry = {
16 repository : string;
17 hour : int;
18 timestamp : Ptime.t;
19 summary : string;
20 changes : string list;
21 commit_range : commit_range;
22 contributors : string list;
23 repo_url : string option;
24}
25
26type day = { repository : string; date : string; entries : entry list }
27
28module String_map = Map.Make (String)
29
30type t = {
31 by_repo : day list String_map.t;
32 by_date : day list String_map.t;
33 all_entries : entry list;
34}
35
36(* JSON codecs for the per-day file format *)
37
38let commit_range_jsont =
39 let make from_hash to_hash count = { from_hash; to_hash; count } in
40 Jsont.Object.map ~kind:"commit_range" make
41 |> Jsont.Object.mem "from" Jsont.string ~enc:(fun r -> r.from_hash)
42 |> Jsont.Object.mem "to" Jsont.string ~enc:(fun r -> r.to_hash)
43 |> Jsont.Object.mem "count" Jsont.int ~enc:(fun r -> r.count)
44 |> Jsont.Object.finish
45
46let ptime_jsont =
47 let enc t = Ptime.to_rfc3339 t ~tz_offset_s:0 in
48 let dec s =
49 match Ptime.of_rfc3339 s with
50 | Ok (t, _, _) -> t
51 | Error _ -> failwith ("Invalid timestamp: " ^ s)
52 in
53 Jsont.map ~dec ~enc Jsont.string
54
55(* Entry codec for the file format (without repository, added during load) *)
56type file_entry = {
57 hour : int;
58 timestamp : Ptime.t;
59 summary : string;
60 changes : string list;
61 commit_range : commit_range;
62 contributors : string list;
63 repo_url : string option;
64}
65
66let file_entry_jsont =
67 let make hour timestamp summary changes commit_range contributors repo_url =
68 { hour; timestamp; summary; changes; commit_range; contributors; repo_url }
69 in
70 let default_hour = 0 in
71 let default_timestamp = Ptime.epoch in
72 Jsont.Object.map ~kind:"daily_entry" make
73 |> Jsont.Object.mem "hour" Jsont.int ~dec_absent:default_hour ~enc:(fun e ->
74 e.hour)
75 |> Jsont.Object.mem "timestamp" ptime_jsont ~dec_absent:default_timestamp
76 ~enc:(fun e -> e.timestamp)
77 |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun e -> e.summary)
78 |> Jsont.Object.mem "changes" (Jsont.list Jsont.string) ~enc:(fun e ->
79 e.changes)
80 |> Jsont.Object.mem "commit_range" commit_range_jsont ~enc:(fun e ->
81 e.commit_range)
82 |> Jsont.Object.mem "contributors" (Jsont.list Jsont.string) ~dec_absent:[]
83 ~enc:(fun e -> e.contributors)
84 |> Jsont.Object.mem "repo_url" (Jsont.option Jsont.string) ~dec_absent:None
85 ~enc:(fun e -> e.repo_url)
86 |> Jsont.Object.finish
87
88type json_file = { json_repository : string; json_entries : file_entry list }
89
90let json_file_jsont =
91 let make json_repository json_entries = { json_repository; json_entries } in
92 Jsont.Object.map ~kind:"daily_changes_file" make
93 |> Jsont.Object.mem "repository" Jsont.string ~enc:(fun f ->
94 f.json_repository)
95 |> Jsont.Object.mem "entries" (Jsont.list file_entry_jsont) ~enc:(fun f ->
96 f.json_entries)
97 |> Jsont.Object.finish
98
99(* Parse date from filename: <repo>-<YYYY-MM-DD>.json *)
100let parse_daily_filename filename =
101 (* Check for pattern: ends with -YYYY-MM-DD.json *)
102 let len = String.length filename in
103 if len < 16 || not (String.ends_with ~suffix:".json" filename) then None
104 else
105 (* Try to extract date: last 15 chars are -YYYY-MM-DD.json *)
106 let date_start = len - 15 in
107 let potential_date = String.sub filename (date_start + 1) 10 in
108 (* Validate date format YYYY-MM-DD *)
109 if
110 String.length potential_date = 10
111 && potential_date.[4] = '-'
112 && potential_date.[7] = '-'
113 then
114 let repo = String.sub filename 0 date_start in
115 Some (repo, potential_date)
116 else None
117
118(* Load a single daily file *)
119let load_file ~fs ~changes_dir ~repo ~date : entry list =
120 let filename = repo ^ "-" ^ date ^ ".json" in
121 let file_path = Eio.Path.(fs / Fpath.to_string changes_dir / filename) in
122 match Eio.Path.kind ~follow:true file_path with
123 | `Regular_file -> (
124 let content = Eio.Path.load file_path in
125 match Jsont_bytesrw.decode_string json_file_jsont content with
126 | Ok jf ->
127 List.map
128 (fun (fe : file_entry) : entry ->
129 {
130 repository = repo;
131 hour = fe.hour;
132 timestamp = fe.timestamp;
133 summary = fe.summary;
134 changes = fe.changes;
135 commit_range = fe.commit_range;
136 contributors = fe.contributors;
137 repo_url = fe.repo_url;
138 })
139 jf.json_entries
140 | Error _ -> [])
141 | _ -> []
142 | exception Eio.Io _ -> []
143
144let empty =
145 { by_repo = String_map.empty; by_date = String_map.empty; all_entries = [] }
146
147let list_repos ~fs ~changes_dir =
148 let dir_path = Eio.Path.(fs / Fpath.to_string changes_dir) in
149 match Eio.Path.kind ~follow:true dir_path with
150 | `Directory ->
151 let files = Eio.Path.read_dir dir_path in
152 files
153 |> List.filter_map parse_daily_filename
154 |> List.map fst
155 |> List.sort_uniq String.compare
156 | _ -> []
157 | exception Eio.Io _ -> []
158
159let list_dates ~fs ~changes_dir ~repo =
160 let dir_path = Eio.Path.(fs / Fpath.to_string changes_dir) in
161 match Eio.Path.kind ~follow:true dir_path with
162 | `Directory ->
163 let files = Eio.Path.read_dir dir_path in
164 files
165 |> List.filter_map (fun filename ->
166 match parse_daily_filename filename with
167 | Some (r, date) when r = repo -> Some date
168 | _ -> None)
169 |> List.sort (fun a b -> String.compare b a)
170 (* descending *)
171 | _ -> []
172 | exception Eio.Io _ -> []
173
174let load_repo_day ~fs ~changes_dir ~repo ~date =
175 load_file ~fs ~changes_dir ~repo ~date
176
177let load_repo_all ~fs ~changes_dir ~repo =
178 let dates = list_dates ~fs ~changes_dir ~repo in
179 List.concat_map (fun date -> load_file ~fs ~changes_dir ~repo ~date) dates
180
181let load_all ~fs ~changes_dir =
182 let dir_path = Eio.Path.(fs / Fpath.to_string changes_dir) in
183 match Eio.Path.kind ~follow:true dir_path with
184 | `Directory ->
185 let files = Eio.Path.read_dir dir_path in
186 let parsed_files = List.filter_map parse_daily_filename files in
187
188 (* Load all files and build days *)
189 let days : day list =
190 List.filter_map
191 (fun (repo, date) ->
192 let loaded_entries : entry list =
193 load_file ~fs ~changes_dir ~repo ~date
194 in
195 if loaded_entries = [] then None
196 else
197 let sorted_entries : entry list =
198 List.sort
199 (fun (e1 : entry) (e2 : entry) ->
200 Ptime.compare e1.timestamp e2.timestamp)
201 loaded_entries
202 in
203 Some ({ repository = repo; date; entries = sorted_entries } : day))
204 parsed_files
205 in
206
207 (* Build by_repo map *)
208 let by_repo : day list String_map.t =
209 List.fold_left
210 (fun acc (d : day) ->
211 let existing =
212 String_map.find_opt d.repository acc |> Option.value ~default:[]
213 in
214 String_map.add d.repository (d :: existing) acc)
215 String_map.empty days
216 in
217
218 (* Sort each repo's days by date descending *)
219 let by_repo : day list String_map.t =
220 String_map.map
221 (fun (ds : day list) ->
222 List.sort
223 (fun (d1 : day) (d2 : day) -> String.compare d2.date d1.date)
224 ds)
225 by_repo
226 in
227
228 (* Build by_date map *)
229 let by_date : day list String_map.t =
230 List.fold_left
231 (fun acc (d : day) ->
232 let existing =
233 String_map.find_opt d.date acc |> Option.value ~default:[]
234 in
235 String_map.add d.date (d :: existing) acc)
236 String_map.empty days
237 in
238
239 (* Sort each date's days by repo name *)
240 let by_date : day list String_map.t =
241 String_map.map
242 (fun (ds : day list) ->
243 List.sort
244 (fun (d1 : day) (d2 : day) ->
245 String.compare d1.repository d2.repository)
246 ds)
247 by_date
248 in
249
250 (* Collect all entries sorted by timestamp *)
251 let all_entries : entry list =
252 days
253 |> List.concat_map (fun (d : day) -> d.entries)
254 |> List.sort (fun (e1 : entry) (e2 : entry) ->
255 Ptime.compare e1.timestamp e2.timestamp)
256 in
257
258 { by_repo; by_date; all_entries }
259 | _ -> empty
260 | exception Eio.Io _ -> empty
261
262let since (t : t) (timestamp : Ptime.t) : entry list =
263 List.filter
264 (fun (e : entry) -> Ptime.compare e.timestamp timestamp > 0)
265 t.all_entries
266
267let for_repo t repo =
268 String_map.find_opt repo t.by_repo |> Option.value ~default:[]
269
270let for_date t date =
271 String_map.find_opt date t.by_date |> Option.value ~default:[]
272
273let repos t = String_map.bindings t.by_repo |> List.map fst
274
275let dates t =
276 String_map.bindings t.by_date
277 |> List.map fst
278 |> List.sort (fun a b -> String.compare b a)
279(* descending *)
280
281let entries_since ~fs ~changes_dir ~since:timestamp =
282 let t = load_all ~fs ~changes_dir in
283 since t timestamp