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