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(** Aggregated daily changes format.
7
8 This module provides types and JSON codecs for the aggregated daily changes
9 format stored in [.changes/YYYYMMDD.json] files. These files combine all
10 repository changes for a single day into a structured format suitable for
11 broadcasting. *)
12
13(** {1 Error Helpers} *)
14
15let err_parse filename e = Error (Fmt.str "Failed to parse %s: %s" filename e)
16let err_not_found filename = Error (Fmt.str "File not found: %s" filename)
17let err_read filename = Error (Fmt.str "Could not read %s" filename)
18
19type change_type =
20 | Feature
21 | Bugfix
22 | Documentation
23 | Refactor
24 | New_library
25 | Unknown
26
27let change_type_of_string = function
28 | "feature" -> Feature
29 | "bugfix" -> Bugfix
30 | "documentation" -> Documentation
31 | "refactor" -> Refactor
32 | "new_library" -> New_library
33 | _ -> Unknown
34
35let string_of_change_type = function
36 | Feature -> "feature"
37 | Bugfix -> "bugfix"
38 | Documentation -> "documentation"
39 | Refactor -> "refactor"
40 | New_library -> "new_library"
41 | Unknown -> "unknown"
42
43type commit_range = { from_hash : string; to_hash : string; count : int }
44
45type entry = {
46 repository : string;
47 hour : int;
48 timestamp : Ptime.t;
49 summary : string;
50 changes : string list;
51 commit_range : commit_range;
52 contributors : string list;
53 repo_url : string option;
54 change_type : change_type;
55}
56
57type t = {
58 date : string;
59 generated_at : Ptime.t;
60 git_head : string;
61 entries : entry list;
62 authors : string list;
63}
64
65let pp ppf t =
66 Fmt.pf ppf "@[<v>date: %s@ entries: %d@ authors: %d@]" t.date
67 (List.length t.entries) (List.length t.authors)
68
69(* JSON codecs *)
70
71let change_type_jsont =
72 let open Json.Codec in
73 enum ~kind:"change_type"
74 [
75 ("feature", Feature);
76 ("bugfix", Bugfix);
77 ("documentation", Documentation);
78 ("refactor", Refactor);
79 ("new_library", New_library);
80 ("unknown", Unknown);
81 ]
82
83let commit_range_jsont =
84 let open Json.Codec in
85 let make from_hash to_hash count = { from_hash; to_hash; count } in
86 Object.map ~kind:"commit_range" make
87 |> Object.member "from" string ~enc:(fun r -> r.from_hash)
88 |> Object.member "to" string ~enc:(fun r -> r.to_hash)
89 |> Object.member "count" int ~enc:(fun r -> r.count)
90 |> Object.seal
91
92let ptime_jsont =
93 let open Json.Codec in
94 let enc t = Ptime.to_rfc3339 t ~tz_offset_s:0 in
95 let dec s =
96 match Ptime.of_rfc3339 s with
97 | Ok (t, _, _) -> t
98 | Error _ -> failwith ("Invalid timestamp: " ^ s)
99 in
100 map ~dec ~enc string
101
102let entry_jsont =
103 let open Json.Codec in
104 let make repository hour timestamp summary changes commit_range contributors
105 repo_url change_type =
106 {
107 repository;
108 hour;
109 timestamp;
110 summary;
111 changes;
112 commit_range;
113 contributors;
114 repo_url;
115 change_type;
116 }
117 in
118 (* Default hour and timestamp for backwards compat when reading old files *)
119 let default_hour = 0 in
120 let default_timestamp = Ptime.epoch in
121 Object.map ~kind:"aggregated_entry" make
122 |> Object.member "repository" string ~enc:(fun e -> e.repository)
123 |> Object.member "hour" int ~dec_absent:default_hour ~enc:(fun e -> e.hour)
124 |> Object.member "timestamp" ptime_jsont ~dec_absent:default_timestamp
125 ~enc:(fun e -> e.timestamp)
126 |> Object.member "summary" string ~enc:(fun e -> e.summary)
127 |> Object.member "changes" (list string) ~enc:(fun e -> e.changes)
128 |> Object.member "commit_range" commit_range_jsont ~enc:(fun e ->
129 e.commit_range)
130 |> Object.member "contributors" (list string) ~dec_absent:[] ~enc:(fun e ->
131 e.contributors)
132 |> Object.member "repo_url" (option string) ~dec_absent:None ~enc:(fun e ->
133 e.repo_url)
134 |> Object.member "change_type" change_type_jsont ~dec_absent:Unknown
135 ~enc:(fun e -> e.change_type)
136 |> Object.seal
137
138let jsont =
139 let open Json.Codec in
140 let make date generated_at git_head entries authors =
141 { date; generated_at; git_head; entries; authors }
142 in
143 Object.map ~kind:"aggregated_changes" make
144 |> Object.member "date" string ~enc:(fun t -> t.date)
145 |> Object.member "generated_at" ptime_jsont ~enc:(fun t -> t.generated_at)
146 |> Object.member "git_head" string ~enc:(fun t -> t.git_head)
147 |> Object.member "entries" (list entry_jsont) ~enc:(fun t -> t.entries)
148 |> Object.member "authors" (list string) ~dec_absent:[] ~enc:(fun t ->
149 t.authors)
150 |> Object.seal
151
152(* File I/O *)
153
154let filename_of_date date =
155 (* date is in YYYY-MM-DD format, convert to YYYYMMDD.json *)
156 let clean = String.concat "" (String.split_on_char '-' date) in
157 clean ^ ".json"
158
159let date_of_filename filename =
160 (* YYYYMMDD.json -> YYYY-MM-DD *)
161 if String.length filename >= 12 && String.sub filename 8 5 = ".json" then
162 let yyyymmdd = String.sub filename 0 8 in
163 let yyyy = String.sub yyyymmdd 0 4 in
164 let mm = String.sub yyyymmdd 4 2 in
165 let dd = String.sub yyyymmdd 6 2 in
166 Some (yyyy ^ "-" ^ mm ^ "-" ^ dd)
167 else None
168
169let load ~fs ~changes_dir ~date =
170 let filename = filename_of_date date in
171 let file_path = Eio.Path.(fs / Fpath.to_string changes_dir / filename) in
172 match Eio.Path.kind ~follow:true file_path with
173 | `Regular_file -> (
174 let content = Eio.Path.load file_path in
175 match Json.of_string jsont content with
176 | Ok t -> Ok t
177 | Error e -> err_parse filename (Json.Error.to_string e))
178 | _ -> err_not_found filename
179 | exception Eio.Io _ -> err_read filename
180
181let load_range ~fs ~changes_dir ~from_date ~to_date =
182 (* List all YYYYMMDD.json files and filter by range *)
183 let dir_path = Eio.Path.(fs / Fpath.to_string changes_dir) in
184 match Eio.Path.kind ~follow:true dir_path with
185 | `Directory ->
186 let entries = Eio.Path.read_dir dir_path in
187 let json_files =
188 List.filter
189 (fun f ->
190 String.length f = 13
191 && String.ends_with ~suffix:".json" f
192 && not (String.contains f '-'))
193 entries
194 in
195 let sorted = List.sort String.compare json_files in
196 let from_file = filename_of_date from_date in
197 let to_file = filename_of_date to_date in
198 let in_range =
199 List.filter (fun f -> f >= from_file && f <= to_file) sorted
200 in
201 let results =
202 List.filter_map
203 (fun filename ->
204 match date_of_filename filename with
205 | Some date -> (
206 match load ~fs ~changes_dir ~date with
207 | Ok t -> Some t
208 | Error _ -> None)
209 | None -> None)
210 in_range
211 in
212 Ok results
213 | _ -> Error "Changes directory not found"
214 | exception Eio.Io _ -> Error "Could not read changes directory"
215
216let latest ~fs ~changes_dir =
217 let dir_path = Eio.Path.(fs / Fpath.to_string changes_dir) in
218 match Eio.Path.kind ~follow:true dir_path with
219 | `Directory -> (
220 let entries = Eio.Path.read_dir dir_path in
221 let json_files =
222 List.filter
223 (fun f ->
224 String.length f = 13
225 && String.ends_with ~suffix:".json" f
226 && not (String.contains f '-'))
227 entries
228 in
229 match List.sort (fun a b -> String.compare b a) json_files with
230 | [] -> Ok None
231 | latest_file :: _ -> (
232 match date_of_filename latest_file with
233 | Some date -> (
234 match load ~fs ~changes_dir ~date with
235 | Ok t -> Ok (Some t)
236 | Error e -> Error e)
237 | None -> Ok None))
238 | _ -> Ok None
239 | exception Eio.Io _ -> Ok None
240
241let ensure_dir ~fs dir =
242 let path = Eio.Path.(fs / Fpath.to_string dir) in
243 match Eio.Path.kind ~follow:true path with
244 | `Directory -> ()
245 | _ -> Eio.Path.mkdir ~perm:0o755 path
246 | exception Eio.Io _ -> Eio.Path.mkdir ~perm:0o755 path
247
248let save ~fs ~changes_dir t =
249 ensure_dir ~fs changes_dir;
250 let filename = filename_of_date t.date in
251 let file_path = Eio.Path.(fs / Fpath.to_string changes_dir / filename) in
252 let content = Json.to_string ~indent:2 jsont t in
253 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
254 Ok ()