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