jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1(** Generate a static HTML site representing the monoverse map. *)
2
3(** Information about a package in the verse *)
4type pkg_info = {
5 name : string;
6 synopsis : string option;
7 repo_name : string;
8 dev_repo : string; (** Upstream git URL *)
9 owners : string list; (** List of handles that have this package *)
10 depends : string list; (** Package dependencies *)
11}
12
13(** Information about a repository (group of packages) *)
14type repo_info = {
15 ri_name : string;
16 ri_dev_repo : string;
17 ri_packages : pkg_info list;
18 ri_owners : string list; (** All handles that have any package from this repo *)
19 ri_fork_status : (string * Forks.relationship) list; (** (handle, relationship) *)
20 ri_dep_count : int; (** Number of dependencies (for sorting) *)
21}
22
23(** Information about a verse member *)
24type member_info = {
25 handle : string;
26 display_name : string; (** Name to display (from registry or handle) *)
27 monorepo_url : string;
28 opam_url : string;
29 package_count : int;
30 unique_packages : string list; (** Packages unique to this member *)
31}
32
33(** Aggregated site data *)
34type site_data = {
35 local_handle : string;
36 registry_name : string;
37 registry_description : string option;
38 members : member_info list;
39 common_repos : repo_info list; (** Repos that exist in multiple members *)
40 unique_repos : repo_info list; (** Repos unique to one member *)
41 all_packages : pkg_info list; (** All packages *)
42}
43
44(** Scan a member's opam repo and return package info *)
45let scan_member_packages ~fs opam_repo_path =
46 let pkgs, _errors = Opam_repo.scan_all ~fs opam_repo_path in
47 List.map (fun pkg ->
48 {
49 name = Package.name pkg;
50 synopsis = Package.synopsis pkg;
51 repo_name = Package.repo_name pkg;
52 dev_repo = Uri.to_string (Package.dev_repo pkg);
53 owners = [];
54 depends = Package.depends pkg;
55 }
56 ) pkgs
57
58(** Check if a directory exists *)
59let dir_exists ~fs path =
60 let eio_path = Eio.Path.(fs / Fpath.to_string path) in
61 match Eio.Path.kind ~follow:true eio_path with
62 | `Directory -> true
63 | _ -> false
64 | exception _ -> false
65
66(** Collect site data from the workspace *)
67let collect_data ~fs ~config ?forks ~registry () =
68 let local_handle = Verse_config.handle config in
69 let local_opam_repo = Verse_config.opam_repo_path config in
70 let verse_path = Verse_config.verse_path config in
71
72 (* Scan local packages *)
73 let local_pkgs =
74 if dir_exists ~fs local_opam_repo then
75 scan_member_packages ~fs local_opam_repo
76 else []
77 in
78
79 (* Build a map: package name -> list of (handle, pkg_info) *)
80 let pkg_map : (string, (string * pkg_info) list) Hashtbl.t = Hashtbl.create 256 in
81
82 (* Add local packages *)
83 List.iter (fun pkg ->
84 let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in
85 Hashtbl.replace pkg_map pkg.name ((local_handle, pkg) :: existing)
86 ) local_pkgs;
87
88 let registry_name = registry.Verse_registry.name in
89 let registry_description = registry.Verse_registry.description in
90
91 (* Build handle -> display name lookup *)
92 let handle_to_name = Hashtbl.create 16 in
93 List.iter (fun (m : Verse_registry.member) ->
94 let display = match m.name with Some n -> n | None -> m.handle in
95 Hashtbl.replace handle_to_name m.handle display
96 ) registry.Verse_registry.members;
97
98 (* Get tracked handles from verse directory, excluding local handle *)
99 let tracked_handles =
100 if dir_exists ~fs verse_path then
101 let eio_path = Eio.Path.(fs / Fpath.to_string verse_path) in
102 try
103 Eio.Path.read_dir eio_path
104 |> List.filter (fun name ->
105 not (String.ends_with ~suffix:"-opam" name) &&
106 name <> local_handle &&
107 dir_exists ~fs Fpath.(verse_path / name))
108 with Eio.Io _ -> []
109 else []
110 in
111
112 (* Scan each tracked member's opam repo *)
113 let member_infos =
114 List.filter_map (fun handle ->
115 let opam_path = Fpath.(verse_path / (handle ^ "-opam")) in
116 if dir_exists ~fs opam_path then begin
117 let pkgs = scan_member_packages ~fs opam_path in
118 (* Add to package map *)
119 List.iter (fun pkg ->
120 let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in
121 Hashtbl.replace pkg_map pkg.name ((handle, pkg) :: existing)
122 ) pkgs;
123 (* Look up member in registry for URLs *)
124 let member = Verse_registry.find_member registry ~handle in
125 let display_name =
126 try Hashtbl.find handle_to_name handle
127 with Not_found -> handle
128 in
129 Some {
130 handle;
131 display_name;
132 monorepo_url = (match member with Some m -> m.monorepo | None -> "");
133 opam_url = (match member with Some m -> m.opamrepo | None -> "");
134 package_count = List.length pkgs;
135 unique_packages = []; (* Will be filled in later *)
136 }
137 end else None
138 ) tracked_handles
139 in
140
141 (* Add local member info *)
142 let local_member =
143 let member = Verse_registry.find_member registry ~handle:local_handle in
144 let display_name =
145 try Hashtbl.find handle_to_name local_handle
146 with Not_found -> local_handle
147 in
148 {
149 handle = local_handle;
150 display_name;
151 monorepo_url = (match member with Some m -> m.monorepo | None -> "");
152 opam_url = (match member with Some m -> m.opamrepo | None -> "");
153 package_count = List.length local_pkgs;
154 unique_packages = [];
155 }
156 in
157
158 (* Build final package list with owners *)
159 let all_packages =
160 Hashtbl.fold (fun _name entries acc ->
161 match entries with
162 | [] -> acc
163 | (_, pkg) :: _ as all ->
164 let owners = List.map fst all in
165 (* Pick the best synopsis (first non-None) *)
166 let synopsis =
167 List.find_map (fun (_, p) -> p.synopsis) all
168 in
169 (* Merge depends from all sources *)
170 let depends =
171 List.concat_map (fun (_, p) -> p.depends) all
172 |> List.sort_uniq String.compare
173 in
174 { pkg with owners; synopsis; depends } :: acc
175 ) pkg_map []
176 |> List.sort (fun a b -> String.compare a.name b.name)
177 in
178
179 (* Build set of all package names for dependency counting *)
180 let all_pkg_names =
181 List.fold_left (fun s p -> Hashtbl.replace s p.name (); s)
182 (Hashtbl.create 256) all_packages
183 in
184
185 (* Group packages by repo *)
186 let repos_map : (string, pkg_info list) Hashtbl.t = Hashtbl.create 64 in
187 List.iter (fun (pkg : pkg_info) ->
188 let existing = try Hashtbl.find repos_map pkg.repo_name with Not_found -> [] in
189 Hashtbl.replace repos_map pkg.repo_name (pkg :: existing)
190 ) all_packages;
191
192 (* Build forks status lookup from forks data if provided *)
193 let forks_by_repo : (string, (string * Forks.relationship) list) Hashtbl.t = Hashtbl.create 64 in
194 (match forks with
195 | Some f ->
196 List.iter (fun (ra : Forks.repo_analysis) ->
197 let statuses = List.map (fun (h, _src, rel) -> (h, rel)) ra.verse_sources in
198 Hashtbl.replace forks_by_repo ra.repo_name statuses
199 ) f.Forks.repos
200 | None -> ());
201
202 (* Build repo_info list with dependency counts *)
203 let all_repos =
204 Hashtbl.fold (fun repo_name pkgs acc ->
205 let dev_repo = (List.hd pkgs).dev_repo in
206 let owners =
207 List.sort_uniq String.compare (List.concat_map (fun (p : pkg_info) -> p.owners) pkgs)
208 in
209 let fork_status =
210 try Hashtbl.find forks_by_repo repo_name with Not_found -> []
211 in
212 (* Count dependencies that are in our package set *)
213 let dep_count =
214 List.concat_map (fun (p : pkg_info) -> p.depends) pkgs
215 |> List.filter (fun d -> Hashtbl.mem all_pkg_names d)
216 |> List.sort_uniq String.compare
217 |> List.length
218 in
219 { ri_name = repo_name;
220 ri_dev_repo = dev_repo;
221 ri_packages = List.sort (fun a b -> String.compare a.name b.name) pkgs;
222 ri_owners = owners;
223 ri_fork_status = fork_status;
224 ri_dep_count = dep_count } :: acc
225 ) repos_map []
226 (* Sort by dependency count descending (apps with most deps first), then by name *)
227 |> List.sort (fun a b ->
228 let cmp = compare b.ri_dep_count a.ri_dep_count in
229 if cmp <> 0 then cmp else String.compare a.ri_name b.ri_name)
230 in
231
232 (* Separate common and unique repos *)
233 let common_repos = List.filter (fun r -> List.length r.ri_owners > 1) all_repos in
234 let unique_repos = List.filter (fun r -> List.length r.ri_owners = 1) all_repos in
235
236 (* Compute unique packages per member *)
237 let unique_by_handle = Hashtbl.create 32 in
238 List.iter (fun (pkg : pkg_info) ->
239 if List.length pkg.owners = 1 then begin
240 let handle = List.hd pkg.owners in
241 let existing = try Hashtbl.find unique_by_handle handle with Not_found -> [] in
242 Hashtbl.replace unique_by_handle handle (pkg.name :: existing)
243 end
244 ) all_packages;
245
246 (* Update member infos with unique packages *)
247 let update_member m =
248 let unique = try Hashtbl.find unique_by_handle m.handle with Not_found -> [] in
249 { m with unique_packages = List.sort String.compare unique }
250 in
251
252 let all_members = local_member :: member_infos in
253 let members = List.map update_member all_members in
254
255 { local_handle; registry_name; registry_description; members; common_repos; unique_repos; all_packages }
256
257(** Escape HTML special characters *)
258let html_escape s =
259 let buf = Buffer.create (String.length s) in
260 String.iter (function
261 | '<' -> Buffer.add_string buf "<"
262 | '>' -> Buffer.add_string buf ">"
263 | '&' -> Buffer.add_string buf "&"
264 | '"' -> Buffer.add_string buf """
265 | c -> Buffer.add_char buf c
266 ) s;
267 Buffer.contents buf
268
269(** External link SVG icon *)
270let external_link_icon =
271 {|<svg class="ext-icon" viewBox="0 0 12 12" fill="none" stroke="currentColor" stroke-width="1.5"><path d="M3.5 3H9V8.5M9 3L3 9"/></svg>|}
272
273(** Format fork relationship as short string *)
274let format_relationship = function
275 | Forks.Same_url -> "="
276 | Forks.Same_commit -> "sync"
277 | Forks.I_am_ahead n -> Printf.sprintf "+%d" n
278 | Forks.I_am_behind n -> Printf.sprintf "-%d" n
279 | Forks.Diverged { my_ahead; their_ahead; _ } -> Printf.sprintf "+%d/-%d" my_ahead their_ahead
280 | Forks.Unrelated -> "unrel"
281 | Forks.Not_fetched -> "?"
282
283(** Generate HTML from site data *)
284let generate_html data =
285 let buf = Buffer.create 16384 in
286 let add = Buffer.add_string buf in
287
288 (* Build member lookups *)
289 let member_urls = Hashtbl.create 16 in
290 let member_names = Hashtbl.create 16 in
291 List.iter (fun m ->
292 Hashtbl.replace member_urls m.handle (m.monorepo_url, m.opam_url);
293 Hashtbl.replace member_names m.handle m.display_name
294 ) data.members;
295
296 (* Helper to get display name for handle *)
297 let get_name handle =
298 try Hashtbl.find member_names handle with Not_found -> handle
299 in
300
301 add {|<!DOCTYPE html>
302<html lang="en">
303<head>
304<meta charset="UTF-8">
305<meta name="viewport" content="width=device-width, initial-scale=1.0">
306<title>|};
307 add (html_escape data.registry_name);
308 add {|</title>
309<style>
310* { margin: 0; padding: 0; box-sizing: border-box; }
311body { font: 10pt/1.4 -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; color: #333; max-width: 900px; margin: 0 auto; padding: 12px; }
312h1 { font-size: 14pt; font-weight: 600; margin-bottom: 4px; }
313.subtitle { font-size: 9pt; color: #666; margin-bottom: 12px; border-bottom: 1px solid #ddd; padding-bottom: 8px; }
314h2 { font-size: 11pt; font-weight: 600; margin: 16px 0 8px; color: #444; }
315h3 { font-size: 10pt; font-weight: 600; margin: 12px 0 6px; color: #555; }
316a { color: #0066cc; text-decoration: none; }
317a:hover { text-decoration: underline; }
318a.ext { color: #0088aa; }
319a.ext:hover { color: #006688; }
320.ext-icon { width: 10px; height: 10px; margin-left: 2px; vertical-align: baseline; position: relative; top: 1px; }
321.members { display: grid; grid-template-columns: repeat(auto-fill, minmax(200px, 1fr)); gap: 8px; margin-bottom: 16px; }
322.member { background: #f8f8f8; padding: 8px; border-radius: 4px; border: 1px solid #e0e0e0; }
323.member-name { font-weight: 600; margin-bottom: 2px; }
324.member-handle { font-size: 8pt; color: #888; margin-bottom: 4px; }
325.member-stats { font-size: 9pt; color: #666; }
326.member-links { font-size: 9pt; margin-top: 4px; }
327.member-links a { margin-right: 8px; }
328.section { margin-bottom: 20px; }
329.summary { background: #fafafa; border: 1px solid #e8e8e8; border-radius: 4px; padding: 12px; margin-bottom: 16px; }
330.summary-title { font-weight: 600; margin-bottom: 8px; }
331.summary-list { font-size: 9pt; color: #555; line-height: 1.6; }
332.summary-item { display: inline-block; background: #fff; border: 1px solid #ddd; padding: 1px 6px; border-radius: 3px; margin: 2px 2px; }
333.summary-item a { color: #333; }
334.repo { margin-bottom: 12px; padding: 8px; background: #fafafa; border-radius: 4px; }
335.repo-header { display: flex; align-items: baseline; gap: 8px; margin-bottom: 4px; }
336.repo-name { font-weight: 600; }
337.repo-name a { color: #333; }
338.repo-packages { font-size: 9pt; color: #666; margin-bottom: 4px; }
339.pkg-list { list-style: none; margin: 4px 0 0 0; padding: 0; }
340.pkg-list li { padding: 1px 0; color: #555; font-size: 8pt; }
341.pkg-list li::before { content: "-"; color: #999; margin-right: 6px; }
342.pkg-list b { font-weight: 500; color: #444; }
343.repo-forks { margin-top: 6px; }
344.repo-forks summary { font-size: 9pt; color: #666; cursor: pointer; }
345.repo-forks summary:hover { color: #444; }
346.fork-list { margin-top: 4px; font-size: 9pt; display: flex; flex-wrap: wrap; gap: 4px 12px; }
347.fork-item { color: #555; }
348.fork-item a { margin-left: 4px; }
349.fork-status { font-family: monospace; font-size: 8pt; padding: 1px 4px; border-radius: 2px; margin-left: 4px; }
350.fork-status.ahead { background: #e6f4ea; color: #137333; }
351.fork-status.behind { background: #fce8e6; color: #c5221f; }
352.fork-status.diverged { background: #fef7e0; color: #b06000; }
353.fork-status.sync { background: #e8f0fe; color: #1a73e8; }
354.unique-section { margin-top: 12px; }
355.unique-member { margin-bottom: 8px; }
356.unique-member-name { font-weight: 500; font-size: 9pt; color: #555; }
357.unique-list { font-size: 9pt; color: #666; margin-top: 2px; }
358.intro { background: #f0f7ff; border: 1px solid #d0e3f5; border-radius: 4px; padding: 10px 12px; margin-bottom: 16px; font-size: 9pt; line-height: 1.5; color: #444; }
359footer { margin-top: 20px; padding-top: 8px; border-top: 1px solid #ddd; font-size: 9pt; color: #888; }
360</style>
361</head>
362<body>
363|};
364
365 (* Title and description *)
366 add (Printf.sprintf "<h1>%s</h1>\n" (html_escape data.registry_name));
367 (match data.registry_description with
368 | Some desc -> add (Printf.sprintf "<div class=\"subtitle\">%s</div>\n" (html_escape desc))
369 | None -> add "<div class=\"subtitle\"></div>\n");
370
371 (* Intro section *)
372 add {|<div class="intro">
373This is an experiment in large-scale agentic coding using OCaml and OxCaml, where we're building environments to exchange vibe code at scale.
374Managed by <a class="ext" href="https://tangled.org/anil.recoil.org/monopam">monopam|}; add external_link_icon; add {|</a>,
375with the central registry at <a class="ext" href="https://tangled.org/eeg.cl.cam.ac.uk/opamverse">opamverse|}; add external_link_icon; add {|</a>.
376</div>
377|};
378
379 (* Members section *)
380 add "<div class=\"section\">\n<h2>Members</h2>\n<div class=\"members\">\n";
381 List.iter (fun m ->
382 add "<div class=\"member\">\n";
383 add (Printf.sprintf "<div class=\"member-name\"><a href=\"https://%s\">%s</a></div>\n"
384 (html_escape m.handle) (html_escape m.display_name));
385 if m.display_name <> m.handle then
386 add (Printf.sprintf "<div class=\"member-handle\">%s</div>\n" (html_escape m.handle));
387 add (Printf.sprintf "<div class=\"member-stats\">%d packages" m.package_count);
388 if m.unique_packages <> [] then
389 add (Printf.sprintf ", %d unique" (List.length m.unique_packages));
390 add "</div>\n";
391 if m.monorepo_url <> "" || m.opam_url <> "" then begin
392 add "<div class=\"member-links\">";
393 if m.monorepo_url <> "" then
394 add (Printf.sprintf "<a class=\"ext\" href=\"%s\">mono%s</a>" (html_escape m.monorepo_url) external_link_icon);
395 if m.opam_url <> "" then
396 add (Printf.sprintf "<a class=\"ext\" href=\"%s\">opam%s</a>" (html_escape m.opam_url) external_link_icon);
397 add "</div>\n"
398 end;
399 add "</div>\n"
400 ) data.members;
401 add "</div>\n</div>\n";
402
403 (* Summary section *)
404 add "<div class=\"section\">\n";
405 add "<div class=\"summary\">\n";
406 add (Printf.sprintf "<div class=\"summary-title\">Common Libraries (%d repos, %d packages)</div>\n"
407 (List.length data.common_repos)
408 (List.fold_left (fun acc r -> acc + List.length r.ri_packages) 0 data.common_repos));
409 add "<div class=\"summary-list\">\n";
410 List.iter (fun r ->
411 add (Printf.sprintf "<span class=\"summary-item\"><a href=\"#%s\">%s</a> <span style=\"color:#888\">(%d)</span></span>\n"
412 (html_escape r.ri_name) (html_escape r.ri_name) (List.length r.ri_packages))
413 ) data.common_repos;
414 add "</div>\n</div>\n";
415
416 (* Member-specific summary *)
417 let members_with_unique = List.filter (fun m -> m.unique_packages <> []) data.members in
418 if members_with_unique <> [] then begin
419 add "<div class=\"summary\">\n";
420 add "<div class=\"summary-title\">Member-Specific Packages</div>\n";
421 add "<div class=\"unique-section\">\n";
422 List.iter (fun m ->
423 add "<div class=\"unique-member\">\n";
424 add (Printf.sprintf "<span class=\"unique-member-name\"><a href=\"https://%s\">%s</a>:</span> "
425 (html_escape m.handle) (html_escape m.display_name));
426 add "<span class=\"unique-list\">";
427 add (String.concat ", " (List.map html_escape m.unique_packages));
428 add "</span>\n";
429 add "</div>\n"
430 ) members_with_unique;
431 add "</div>\n</div>\n"
432 end;
433 add "</div>\n";
434
435 (* Detailed repos section *)
436 if data.common_repos <> [] then begin
437 add "<div class=\"section\">\n<h2>Repository Details</h2>\n";
438
439 List.iter (fun r ->
440 add (Printf.sprintf "<div class=\"repo\" id=\"%s\">\n" (html_escape r.ri_name));
441 add "<div class=\"repo-header\">";
442 add (Printf.sprintf "<span class=\"repo-name\"><a class=\"ext\" href=\"%s\">%s%s</a></span>"
443 (html_escape r.ri_dev_repo) (html_escape r.ri_name) external_link_icon);
444 add "</div>\n";
445
446 (* Packages list - compact with names *)
447 add "<div class=\"repo-packages\">";
448 let pkg_names = List.map (fun (p : pkg_info) -> p.name) r.ri_packages in
449 add (String.concat ", " (List.map html_escape pkg_names));
450 add "</div>\n";
451
452 (* Package descriptions as bullet list *)
453 let pkg_descs = List.filter_map (fun (p : pkg_info) ->
454 match p.synopsis with
455 | Some s -> Some (p.name, s)
456 | None -> None
457 ) r.ri_packages in
458 if pkg_descs <> [] then begin
459 add "<ul class=\"pkg-list\">\n";
460 List.iter (fun (name, desc) ->
461 add (Printf.sprintf "<li><b>%s</b>: %s</li>\n" (html_escape name) (html_escape desc))
462 ) pkg_descs;
463 add "</ul>\n"
464 end;
465
466 (* Forks - at repo level with names *)
467 if List.length r.ri_owners > 1 then begin
468 let owner_links = List.map (fun h ->
469 Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape h) (html_escape (get_name h))
470 ) (List.sort String.compare r.ri_owners) in
471 add "<details class=\"repo-forks\">\n";
472 add (Printf.sprintf "<summary>%d members (%s)</summary>\n"
473 (List.length r.ri_owners)
474 (String.concat ", " owner_links));
475 add "<div class=\"fork-list\">\n";
476 List.iter (fun handle ->
477 let mono_url, _opam_url =
478 try Hashtbl.find member_urls handle
479 with Not_found -> ("", "")
480 in
481 add "<span class=\"fork-item\">";
482 add (Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape handle) (html_escape (get_name handle)));
483 (* Add status if available *)
484 (match List.assoc_opt handle r.ri_fork_status with
485 | Some rel ->
486 let status_str = format_relationship rel in
487 let status_class =
488 match rel with
489 | Forks.Same_url | Forks.Same_commit -> "sync"
490 | Forks.I_am_ahead _ -> "ahead"
491 | Forks.I_am_behind _ -> "behind"
492 | Forks.Diverged _ -> "diverged"
493 | _ -> ""
494 in
495 if status_class <> "" then
496 add (Printf.sprintf "<span class=\"fork-status %s\">%s</span>" status_class status_str)
497 else
498 add (Printf.sprintf "<span class=\"fork-status\">%s</span>" status_str)
499 | None -> ());
500 if mono_url <> "" then
501 add (Printf.sprintf "<a class=\"ext\" href=\"%s/%s\">mono%s</a>"
502 (html_escape mono_url) (html_escape r.ri_name) external_link_icon);
503 add "</span>\n"
504 ) (List.sort String.compare r.ri_owners);
505 add "</div>\n</details>\n"
506 end;
507
508 add "</div>\n"
509 ) data.common_repos;
510
511 add "</div>\n"
512 end;
513
514 (* Footer with generation date *)
515 let now = Unix.gettimeofday () in
516 let tm = Unix.gmtime now in
517 let date_str = Printf.sprintf "%04d-%02d-%02d"
518 (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday in
519 add (Printf.sprintf "<footer>Generated by monopam on %s | %d members | %d repos | %d packages</footer>\n"
520 date_str (List.length data.members) (List.length data.common_repos + List.length data.unique_repos) (List.length data.all_packages));
521
522 add "</body>\n</html>\n";
523 Buffer.contents buf
524
525(** Generate the site and return the HTML content *)
526let generate ~fs ~config ?forks ~registry () =
527 let data = collect_data ~fs ~config ?forks ~registry () in
528 generate_html data
529
530(** Write the site to a file *)
531let write ~fs ~config ?forks ~registry ~output_path () =
532 let html = generate ~fs ~config ?forks ~registry () in
533 let eio_path = Eio.Path.(fs / Fpath.to_string output_path) in
534 Eio.Path.save ~create:(`Or_truncate 0o644) eio_path html;
535 Ok ()