monopam: reduce cyclomatic complexity in analyze, clean, generate_html, collect_data

+123 -140

lib/doctor.ml

··· 412 412 413 413 (** Strip ANSI escape codes from a string *) 414 414 let strip_ansi s = 415 - let buf = Buffer.create (String.length s) in 415 + let len = String.length s in 416 + let buf = Buffer.create len in 417 + let rec skip_escape j = 418 + if j >= len || s.[j] = 'm' then j + 1 else skip_escape (j + 1) 419 + in 416 420 let rec loop i = 417 - if i >= String.length s then Buffer.contents buf 418 - else if s.[i] = '\027' && i + 1 < String.length s && s.[i + 1] = '[' then 419 - (* Skip escape sequence until 'm' *) 420 - let rec skip j = 421 - if j >= String.length s then j 422 - else if s.[j] = 'm' then j + 1 423 - else skip (j + 1) 424 - in 425 - loop (skip (i + 2)) 421 + if i >= len then Buffer.contents buf 422 + else if s.[i] = '\027' && i + 1 < len && s.[i + 1] = '[' then 423 + loop (skip_escape (i + 2)) 426 424 else begin 427 425 Buffer.add_char buf s.[i]; 428 426 loop (i + 1) ··· 469 467 statuses; 470 468 Buffer.contents buf 471 469 470 + let format_commit buf (c : Git.Repository.log_entry) = 471 + let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 472 + Buffer.add_string buf 473 + (Printf.sprintf " - %s %s (%s)\n" short_hash c.subject c.author) 474 + 475 + let format_remote_commits buf r = 476 + if r.behind > 0 then begin 477 + Buffer.add_string buf 478 + (Printf.sprintf "**%s** (%s) - %d commits behind:\n" r.remote_name r.url 479 + r.behind); 480 + List.iter (format_commit buf) r.incoming_commits; 481 + Buffer.add_string buf "\n" 482 + end 483 + 484 + let format_repo_incoming buf repo_name remotes = 485 + let has_incoming = List.exists (fun r -> r.behind > 0) remotes in 486 + if has_incoming then begin 487 + Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_name); 488 + List.iter (format_remote_commits buf) remotes 489 + end 490 + 472 491 (** Build incoming commits summary for prompt *) 473 492 let build_incoming_summary remotes_by_repo = 474 493 let buf = Buffer.create 8192 in 475 494 Buffer.add_string buf "\n## Incoming Commits from Remotes\n\n"; 476 495 List.iter 477 - (fun (repo_name, remotes) -> 478 - let has_incoming = List.exists (fun r -> r.behind > 0) remotes in 479 - if has_incoming then begin 480 - Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_name); 481 - List.iter 482 - (fun r -> 483 - if r.behind > 0 then begin 484 - Buffer.add_string buf 485 - (Printf.sprintf "**%s** (%s) - %d commits behind:\n" 486 - r.remote_name r.url r.behind); 487 - List.iter 488 - (fun (c : Git.Repository.log_entry) -> 489 - let short_hash = 490 - String.sub c.hash 0 (min 7 (String.length c.hash)) 491 - in 492 - Buffer.add_string buf 493 - (Printf.sprintf " - %s %s (%s)\n" short_hash c.subject 494 - c.author)) 495 - r.incoming_commits; 496 - Buffer.add_string buf "\n" 497 - end) 498 - remotes 499 - end) 496 + (fun (repo_name, remotes) -> format_repo_incoming buf repo_name remotes) 500 497 remotes_by_repo; 501 498 Buffer.contents buf 502 499 ··· 904 901 905 902 (** {1 Main Analysis} *) 906 903 904 + (** Check repos for dirty state, returning warnings *) 905 + let check_dirty_repos ~fs ~config = 906 + let warnings = ref [] in 907 + let opam_repo = Config.Paths.opam_repo config in 908 + if Git.Repository.is_repo ~fs opam_repo then begin 909 + let repo = Git.Repository.open_repo ~fs opam_repo in 910 + if Git.Repository.is_dirty repo then 911 + warnings := "opam-repo has uncommitted changes" :: !warnings 912 + end; 913 + let monorepo = Config.Paths.monorepo config in 914 + if Git.Repository.is_repo ~fs monorepo then begin 915 + let repo = Git.Repository.open_repo ~fs monorepo in 916 + if Git.Repository.is_dirty repo then 917 + warnings := "monorepo has uncommitted changes" :: !warnings 918 + end; 919 + !warnings 920 + 921 + (** Build base repo_sync list from statuses *) 922 + let build_base_repos statuses = 923 + List.map 924 + (fun (status : Status.t) -> 925 + let name = Package.repo_name status.package in 926 + let local_sync = 927 + match status.subtree_sync with 928 + | Status.In_sync -> `In_sync 929 + | Status.Subtree_behind n -> `Behind n 930 + | Status.Subtree_ahead n -> `Ahead n 931 + | Status.Trees_differ | Status.Unknown -> `Needs_sync 932 + in 933 + let remote_ahead, remote_behind = 934 + match status.checkout with 935 + | Status.Clean ab -> (ab.ahead, ab.behind) 936 + | _ -> (0, 0) 937 + in 938 + { name; local_sync; remote_ahead; remote_behind; verse_analyses = [] }) 939 + statuses 940 + 941 + (** Build recommendations list from repos state *) 942 + let build_recommendations ~repos_need_sync ~repos_behind_upstream 943 + claude_recommendations = 944 + let recommendations = ref claude_recommendations in 945 + if 946 + repos_need_sync > 0 947 + && not 948 + (List.exists 949 + (fun r -> 950 + String.starts_with ~prefix:"Run monopam sync" r.description) 951 + !recommendations) 952 + then 953 + recommendations := 954 + { 955 + action_priority = Medium; 956 + description = 957 + Printf.sprintf "Run monopam sync to resolve %d local sync issues" 958 + repos_need_sync; 959 + command = Some "monopam sync"; 960 + } 961 + :: !recommendations; 962 + if 963 + repos_behind_upstream > 0 964 + && not 965 + (List.exists 966 + (fun r -> String.starts_with ~prefix:"Pull upstream" r.description) 967 + !recommendations) 968 + then 969 + recommendations := 970 + { 971 + action_priority = Medium; 972 + description = 973 + Printf.sprintf "Pull upstream changes for %d repos" 974 + repos_behind_upstream; 975 + command = Some "monopam sync"; 976 + } 977 + :: !recommendations; 978 + let priority_order = function 979 + | Critical -> 0 980 + | High -> 1 981 + | Medium -> 2 982 + | Low -> 3 983 + in 984 + List.sort 985 + (fun a b -> 986 + compare 987 + (priority_order a.action_priority) 988 + (priority_order b.action_priority)) 989 + !recommendations 990 + 907 991 (** Run the doctor analysis *) 908 992 let analyze ~proc ~fs ~config ~verse_config ~clock ?package ?(no_sync = false) 909 993 () = 910 994 let _ = no_sync in 911 - (* Sync is run at CLI level before calling analyze *) 912 995 let now = Eio.Time.now clock in 913 996 let now_ptime = 914 997 Ptime.of_float_s now |> Option.value ~default:(Ptime.v (0, 0L)) ··· 916 999 let timestamp = Ptime.to_rfc3339 now_ptime ~tz_offset_s:0 in 917 1000 let workspace = Fpath.to_string (Verse_config.root verse_config) in 918 1001 919 - (* Get status for all packages *) 920 1002 let packages = 921 1003 match 922 1004 Opam_repo.scan ~fs:(fs :> _ Eio.Path.t) (Config.Paths.opam_repo config) ··· 925 1007 | Error _ -> [] 926 1008 in 927 1009 let statuses = Status.compute_all ~fs ~config packages in 928 - 929 - (* Filter by package if specified *) 930 1010 let statuses = 931 1011 match package with 932 1012 | None -> statuses ··· 936 1016 statuses 937 1017 in 938 1018 939 - (* Build warnings list *) 940 - let warnings = ref [] in 941 - 942 - (* Check opam-repo for dirty state *) 943 - let opam_repo = Config.Paths.opam_repo config in 944 - if Git.Repository.is_repo ~fs opam_repo then begin 945 - let repo = Git.Repository.open_repo ~fs opam_repo in 946 - if Git.Repository.is_dirty repo then 947 - warnings := "opam-repo has uncommitted changes" :: !warnings 948 - end; 1019 + let warnings = check_dirty_repos ~fs ~config in 949 1020 950 - (* Check monorepo for dirty state *) 951 - let monorepo = Config.Paths.monorepo config in 952 - if Git.Repository.is_repo ~fs monorepo then begin 953 - let repo = Git.Repository.open_repo ~fs monorepo in 954 - if Git.Repository.is_dirty repo then 955 - warnings := "monorepo has uncommitted changes" :: !warnings 956 - end; 957 - 958 - (* Analyze all remotes for each checkout *) 959 1021 Log.app (fun m -> 960 1022 m "Analyzing remotes for %d repositories..." (List.length statuses)); 961 1023 let checkouts_root = Config.Paths.checkouts config in ··· 966 1028 let checkout_dir = Fpath.(checkouts_root / name) in 967 1029 match status.checkout with 968 1030 | Status.Missing | Status.Not_a_repo -> None 969 - | _ -> 970 - let remotes = analyze_checkout_remotes ~fs ~checkout_dir in 971 - Some (name, remotes)) 1031 + | _ -> Some (name, analyze_checkout_remotes ~fs ~checkout_dir)) 972 1032 statuses 973 1033 in 974 1034 975 - (* Count repos with incoming changes *) 976 1035 let repos_with_incoming = 977 1036 List.filter 978 1037 (fun (_name, remotes) -> List.exists (fun r -> r.behind > 0) remotes) 979 1038 remotes_by_repo 980 1039 in 981 1040 982 - (* Build repo sync info from status *) 983 - let base_repos = 984 - List.map 985 - (fun (status : Status.t) -> 986 - let name = Package.repo_name status.package in 987 - let local_sync = 988 - match status.subtree_sync with 989 - | Status.In_sync -> `In_sync 990 - | Status.Subtree_behind n -> `Behind n 991 - | Status.Subtree_ahead n -> `Ahead n 992 - | Status.Trees_differ -> `Needs_sync 993 - | Status.Unknown -> `Needs_sync 994 - in 995 - let remote_ahead, remote_behind = 996 - match status.checkout with 997 - | Status.Clean ab -> (ab.ahead, ab.behind) 998 - | _ -> (0, 0) 999 - in 1000 - { name; local_sync; remote_ahead; remote_behind; verse_analyses = [] }) 1001 - statuses 1002 - in 1041 + let base_repos = build_base_repos statuses in 1003 1042 1004 - (* If there are repos with incoming changes, analyze with Claude *) 1005 1043 let repos, claude_recommendations, claude_warnings = 1006 1044 if repos_with_incoming <> [] then begin 1007 1045 Log.app (fun m -> ··· 1009 1047 (List.length repos_with_incoming)); 1010 1048 let status_summary = build_status_summary statuses in 1011 1049 let incoming_summary = build_incoming_summary remotes_by_repo in 1012 - 1013 1050 match 1014 1051 Eio.Switch.run (fun sw -> 1015 1052 analyze_with_claude ~sw ~process_mgr:proc ~clock ~status_summary ··· 1017 1054 with 1018 1055 | Some json -> 1019 1056 let claude_repos, recs, warns = parse_claude_response json in 1020 - (* Merge Claude repos with base repos *) 1021 1057 let merged_repos = 1022 1058 List.map 1023 1059 (fun base_repo -> ··· 1042 1078 end 1043 1079 in 1044 1080 1045 - (* Compute summary *) 1046 1081 let repos_need_sync = 1047 1082 List.length (List.filter (fun r -> r.local_sync <> `In_sync) repos) 1048 1083 in ··· 1061 1096 } 1062 1097 in 1063 1098 1064 - (* Build recommendations: start with Claude's, add our own *) 1065 - let recommendations = ref claude_recommendations in 1066 - 1067 - (* Add recommendations for local sync issues *) 1068 - if 1069 - repos_need_sync > 0 1070 - && not 1071 - (List.exists 1072 - (fun r -> 1073 - String.starts_with ~prefix:"Run monopam sync" r.description) 1074 - !recommendations) 1075 - then 1076 - recommendations := 1077 - { 1078 - action_priority = Medium; 1079 - description = 1080 - Printf.sprintf "Run monopam sync to resolve %d local sync issues" 1081 - repos_need_sync; 1082 - command = Some "monopam sync"; 1083 - } 1084 - :: !recommendations; 1085 - 1086 - (* Add recommendations for repos behind upstream *) 1087 - if 1088 - repos_behind_upstream > 0 1089 - && not 1090 - (List.exists 1091 - (fun r -> String.starts_with ~prefix:"Pull upstream" r.description) 1092 - !recommendations) 1093 - then 1094 - recommendations := 1095 - { 1096 - action_priority = Medium; 1097 - description = 1098 - Printf.sprintf "Pull upstream changes for %d repos" 1099 - repos_behind_upstream; 1100 - command = Some "monopam sync"; 1101 - } 1102 - :: !recommendations; 1103 - 1104 - (* Sort recommendations by priority *) 1105 - let priority_order = function 1106 - | Critical -> 0 1107 - | High -> 1 1108 - | Medium -> 2 1109 - | Low -> 3 1110 - in 1111 1099 let recommendations = 1112 - List.sort 1113 - (fun a b -> 1114 - compare 1115 - (priority_order a.action_priority) 1116 - (priority_order b.action_priority)) 1117 - !recommendations 1100 + build_recommendations ~repos_need_sync ~repos_behind_upstream 1101 + claude_recommendations 1118 1102 in 1119 1103 1120 - let all_warnings = List.rev !warnings @ claude_warnings in 1121 1104 { 1122 1105 timestamp; 1123 1106 workspace; 1124 1107 report_summary; 1125 1108 repos; 1126 1109 recommendations; 1127 - warnings = all_warnings; 1110 + warnings = warnings @ claude_warnings; 1128 1111 } 1129 1112 1130 1113 (** Encode report to JSON string *)

+92 -80

lib/monopam.ml

··· 1040 1040 (* Use native subtree split + push to export commits to the checkout. 1041 1041 This preserves commit identity, ensuring round-trips converge. *) 1042 1042 let checkout_url = Uri.of_string (Fpath.to_string checkout_dir) in 1043 - Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir); 1044 1043 let git_repo = Git.Repository.open_repo ~fs monorepo in 1045 - (* Proactively verify and clear invalid cache before split *) 1046 - let _checked, errors = Git.Subtree.verify git_repo ~prefix () in 1047 - if errors <> [] then begin 1048 - Log.info (fun m -> 1049 - m "Clearing invalid cache for %s (%d errors)" prefix 1050 - (List.length errors)); 1051 - Git.Subtree.Cache.clear git_repo ~prefix 1052 - end; 1053 - match Git.Repository.read_ref git_repo "HEAD" with 1054 - | None -> Error (Git_error (Git_cli.Io_error "no HEAD ref found")) 1055 - | Some head -> ( 1056 - match Git.Subtree.split git_repo ~prefix ~head () with 1057 - | Ok None -> Error (Git_error (Git_cli.Subtree_prefix_missing prefix)) 1058 - | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 1059 - | Ok (Some split_hash) -> ( 1060 - (* Optionally clean history by removing unrelated merge commits *) 1061 - let final_hash = 1062 - if clean then ( 1063 - match Git.Subtree.fix git_repo ~prefix ~head:split_hash () with 1064 - | Ok (Some h) -> 1065 - Log.info (fun m -> m "Cleaned history for %s" prefix); 1066 - h 1067 - | Ok None -> split_hash 1068 - | Error (`Msg msg) -> 1069 - Log.warn (fun m -> m "Failed to clean %s: %s" prefix msg); 1070 - split_hash) 1071 - else split_hash 1072 - in 1073 - let refspec = 1074 - Git.Hash.to_hex final_hash ^ ":refs/heads/" ^ branch 1075 - in 1076 - match 1077 - Git_cli.push_refspec ~proc ~fs ~repo:monorepo ~url:checkout_url 1078 - ~refspec ~force:clean () 1079 - with 1080 - | Ok () -> Ok () 1081 - | Error e -> Error (Git_error e))) 1044 + let checkout_repo = Git.Repository.open_repo ~fs checkout_dir in 1045 + (* Fast path: if tree hashes match, nothing to push *) 1046 + let mono_tree = 1047 + Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix 1048 + in 1049 + let checkout_tree = 1050 + match Git.Repository.head checkout_repo with 1051 + | None -> None 1052 + | Some h -> ( 1053 + match Git.Repository.read checkout_repo h with 1054 + | Ok (Git.Value.Commit c) -> Some (Git.Commit.tree c) 1055 + | _ -> None) 1056 + in 1057 + if mono_tree = checkout_tree && mono_tree <> None then begin 1058 + Log.debug (fun m -> m "Skipping %s (trees match)" prefix); 1059 + Ok () 1060 + end 1061 + else begin 1062 + Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir); 1063 + (* Proactively verify and clear invalid cache before split *) 1064 + let _checked, errors = Git.Subtree.verify git_repo ~prefix () in 1065 + if errors <> [] then begin 1066 + Log.info (fun m -> 1067 + m "Clearing invalid cache for %s (%d errors)" prefix 1068 + (List.length errors)); 1069 + Git.Subtree.Cache.clear git_repo ~prefix 1070 + end; 1071 + match Git.Repository.read_ref git_repo "HEAD" with 1072 + | None -> Error (Git_error (Git_cli.Io_error "no HEAD ref found")) 1073 + | Some head -> ( 1074 + match Git.Subtree.split git_repo ~prefix ~head () with 1075 + | Ok None -> Error (Git_error (Git_cli.Subtree_prefix_missing prefix)) 1076 + | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 1077 + | Ok (Some split_hash) -> ( 1078 + (* Optionally clean history by removing unrelated merge commits *) 1079 + let final_hash = 1080 + if clean then ( 1081 + match 1082 + Git.Subtree.fix git_repo ~prefix ~head:split_hash () 1083 + with 1084 + | Ok (Some h) -> 1085 + Log.info (fun m -> m "Cleaned history for %s" prefix); 1086 + h 1087 + | Ok None -> split_hash 1088 + | Error (`Msg msg) -> 1089 + Log.warn (fun m -> m "Failed to clean %s: %s" prefix msg); 1090 + split_hash) 1091 + else split_hash 1092 + in 1093 + let refspec = 1094 + Git.Hash.to_hex final_hash ^ ":refs/heads/" ^ branch 1095 + in 1096 + match 1097 + Git_cli.push_refspec ~proc ~fs ~repo:monorepo ~url:checkout_url 1098 + ~refspec ~force:clean () 1099 + with 1100 + | Ok () -> Ok () 1101 + | Error e -> Error (Git_error e))) 1102 + end 1082 1103 end 1083 1104 1084 1105 let rec push ~proc ~fs ~config ?(packages = []) ?(upstream = false) ··· 1248 1269 push_repo "opam-repo" opam_repo 1249 1270 1250 1271 (* Clean empty commits from mono and all checkouts *) 1272 + 1273 + (** Write new_head to the current branch or HEAD *) 1274 + let write_cleaned_head repo new_head = 1275 + match Git.Repository.current_branch repo with 1276 + | Some branch -> 1277 + Git.Repository.write_ref repo ("refs/heads/" ^ branch) new_head 1278 + | None -> Git.Repository.write_ref repo "HEAD" new_head 1279 + 1280 + (** Apply a fix function and handle the result. Returns Some count on success. 1281 + *) 1282 + let apply_fix ~name ~repo ~dry_run ~fix_fn ~issue_count = 1283 + if dry_run then Some issue_count 1284 + else 1285 + match fix_fn () with 1286 + | Error (`Msg msg) -> 1287 + Log.warn (fun m -> m " Failed to clean %s: %s" name msg); 1288 + None 1289 + | Ok None -> 1290 + Log.warn (fun m -> m " %s: history became empty" name); 1291 + None 1292 + | Ok (Some new_head) -> 1293 + write_cleaned_head repo new_head; 1294 + Log.app (fun m -> m " ✓ %s cleaned" name); 1295 + Some issue_count 1296 + 1251 1297 let clean ~proc ~fs ~config ~dry_run ~force () = 1252 1298 let fs_t = fs_typed fs in 1253 1299 let mono = Config.Paths.monorepo config in 1254 1300 let checkouts = Config.Paths.checkouts config in 1255 1301 1256 - (* Clean mono using fix_mono (removes all empty commits) *) 1257 1302 let clean_mono () = 1258 1303 if not (Git.Repository.is_repo ~fs:fs_t mono) then None 1259 - else begin 1304 + else 1260 1305 let repo = Git.Repository.open_repo ~fs:fs_t mono in 1261 1306 match Git.Repository.head repo with 1262 1307 | None -> None ··· 1267 1312 Log.app (fun m -> 1268 1313 m "mono: %d empty commits (of %d checked)" (List.length issues) 1269 1314 checked); 1270 - if dry_run then Some (List.length issues) 1271 - else begin 1272 - match Git.Subtree.fix_mono repo ~head () with 1273 - | Error (`Msg msg) -> 1274 - Log.warn (fun m -> m " Failed to clean mono: %s" msg); 1275 - None 1276 - | Ok None -> 1277 - Log.warn (fun m -> m " mono: history became empty"); 1278 - None 1279 - | Ok (Some new_head) -> 1280 - (match Git.Repository.current_branch repo with 1281 - | Some branch -> 1282 - Git.Repository.write_ref repo ("refs/heads/" ^ branch) 1283 - new_head 1284 - | None -> Git.Repository.write_ref repo "HEAD" new_head); 1285 - Log.app (fun m -> m " ✓ mono cleaned"); 1286 - Some (List.length issues) 1287 - end 1315 + apply_fix ~name:"mono" ~repo ~dry_run 1316 + ~fix_fn:(fun () -> Git.Subtree.fix_mono repo ~head ()) 1317 + ~issue_count:(List.length issues) 1288 1318 end 1289 - end 1290 1319 in 1291 1320 1292 - (* Clean checkout using Subtree.fix (removes unrelated subtree merges) *) 1293 1321 let clean_checkout name = 1294 1322 let path = Fpath.(checkouts / name) in 1295 1323 if not (Git.Repository.is_repo ~fs:fs_t path) then None 1296 - else begin 1324 + else 1297 1325 let repo = Git.Repository.open_repo ~fs:fs_t path in 1298 1326 match Git.Repository.head repo with 1299 1327 | None -> None ··· 1304 1332 Log.app (fun m -> 1305 1333 m "%s: %d unrelated merges (of %d checked)" name 1306 1334 (List.length issues) checked); 1307 - if dry_run then Some (List.length issues) 1308 - else begin 1309 - match Git.Subtree.fix repo ~prefix:name ~head () with 1310 - | Error (`Msg msg) -> 1311 - Log.warn (fun m -> m " Failed to clean %s: %s" name msg); 1312 - None 1313 - | Ok None -> 1314 - Log.warn (fun m -> m " %s: history became empty" name); 1315 - None 1316 - | Ok (Some new_head) -> 1317 - (match Git.Repository.current_branch repo with 1318 - | Some branch -> 1319 - Git.Repository.write_ref repo ("refs/heads/" ^ branch) 1320 - new_head 1321 - | None -> Git.Repository.write_ref repo "HEAD" new_head); 1322 - Log.app (fun m -> m " ✓ %s cleaned" name); 1323 - Some (List.length issues) 1324 - end 1335 + apply_fix ~name ~repo ~dry_run 1336 + ~fix_fn:(fun () -> Git.Subtree.fix repo ~prefix:name ~head ()) 1337 + ~issue_count:(List.length issues) 1325 1338 end 1326 - end 1327 1339 in 1328 1340 1329 1341 (* Clean mono first *)

+281 -329

lib/site.ml

··· 66 66 | _ -> false 67 67 | exception _ -> false 68 68 69 - (** Collect site data from the workspace *) 70 - let collect_data ~fs ~config ?forks ~registry () = 71 - let local_handle = Verse_config.handle config in 72 - let local_opam_repo = Verse_config.opam_repo_path config in 73 - let verse_path = Verse_config.verse_path config in 74 - 75 - (* Scan local packages *) 76 - let local_pkgs = 77 - if dir_exists ~fs local_opam_repo then 78 - scan_member_packages ~fs local_opam_repo 79 - else [] 80 - in 81 - 82 - (* Build a map: package name -> list of (handle, pkg_info) *) 83 - let pkg_map : (string, (string * pkg_info) list) Hashtbl.t = 84 - Hashtbl.create 256 85 - in 86 - 87 - (* Add local packages *) 69 + (** Add packages to the package map *) 70 + let add_packages_to_map pkg_map handle pkgs = 88 71 List.iter 89 72 (fun pkg -> 90 73 let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in 91 - Hashtbl.replace pkg_map pkg.name ((local_handle, pkg) :: existing)) 92 - local_pkgs; 74 + Hashtbl.replace pkg_map pkg.name ((handle, pkg) :: existing)) 75 + pkgs 93 76 94 - let registry_name = registry.Verse_registry.name in 95 - let registry_description = registry.Verse_registry.description in 96 - 97 - (* Build handle -> display name lookup *) 98 - let handle_to_name = Hashtbl.create 16 in 77 + (** Build handle -> display name lookup from registry *) 78 + let build_handle_names registry = 79 + let tbl = Hashtbl.create 16 in 99 80 List.iter 100 81 (fun (m : Verse_registry.member) -> 101 82 let display = match m.name with Some n -> n | None -> m.handle in 102 - Hashtbl.replace handle_to_name m.handle display) 83 + Hashtbl.replace tbl m.handle display) 103 84 registry.Verse_registry.members; 85 + tbl 104 86 105 - (* Get tracked handles from verse directory, excluding local handle *) 87 + (** Scan tracked members and return member_info list *) 88 + let scan_tracked_members ~fs ~verse_path ~local_handle ~pkg_map ~registry 89 + ~handle_to_name = 106 90 let tracked_handles = 107 91 if dir_exists ~fs verse_path then 108 92 let eio_path = Eio.Path.(fs / Fpath.to_string verse_path) in ··· 115 99 with Eio.Io _ -> [] 116 100 else [] 117 101 in 102 + List.filter_map 103 + (fun handle -> 104 + let opam_path = Fpath.(verse_path / (handle ^ "-opam")) in 105 + if not (dir_exists ~fs opam_path) then None 106 + else begin 107 + let pkgs = scan_member_packages ~fs opam_path in 108 + add_packages_to_map pkg_map handle pkgs; 109 + let member = Verse_registry.member registry ~handle in 110 + let display_name = 111 + try Hashtbl.find handle_to_name handle with Not_found -> handle 112 + in 113 + Some 114 + { 115 + handle; 116 + display_name; 117 + monorepo_url = 118 + (match member with Some m -> m.monorepo | None -> ""); 119 + opam_url = (match member with Some m -> m.opamrepo | None -> ""); 120 + package_count = List.length pkgs; 121 + unique_packages = []; 122 + } 123 + end) 124 + tracked_handles 118 125 119 - (* Scan each tracked member's opam repo *) 120 - let member_infos = 121 - List.filter_map 122 - (fun handle -> 123 - let opam_path = Fpath.(verse_path / (handle ^ "-opam")) in 124 - if dir_exists ~fs opam_path then begin 125 - let pkgs = scan_member_packages ~fs opam_path in 126 - (* Add to package map *) 127 - List.iter 128 - (fun pkg -> 129 - let existing = 130 - try Hashtbl.find pkg_map pkg.name with Not_found -> [] 131 - in 132 - Hashtbl.replace pkg_map pkg.name ((handle, pkg) :: existing)) 133 - pkgs; 134 - (* Look up member in registry for URLs *) 135 - let member = Verse_registry.member registry ~handle in 136 - let display_name = 137 - try Hashtbl.find handle_to_name handle with Not_found -> handle 126 + (** Build all_packages list from package map *) 127 + let build_all_packages pkg_map = 128 + Hashtbl.fold 129 + (fun _name entries acc -> 130 + match entries with 131 + | [] -> acc 132 + | (_, pkg) :: _ as all -> 133 + let owners = List.map fst all in 134 + let synopsis = List.find_map (fun (_, p) -> p.synopsis) all in 135 + let depends = 136 + List.concat_map (fun (_, p) -> p.depends) all 137 + |> List.sort_uniq String.compare 138 138 in 139 - Some 140 - { 141 - handle; 142 - display_name; 143 - monorepo_url = 144 - (match member with Some m -> m.monorepo | None -> ""); 145 - opam_url = (match member with Some m -> m.opamrepo | None -> ""); 146 - package_count = List.length pkgs; 147 - unique_packages = []; 148 - (* Will be filled in later *) 149 - } 150 - end 151 - else None) 152 - tracked_handles 153 - in 154 - 155 - (* Add local member info *) 156 - let local_member = 157 - let member = Verse_registry.member registry ~handle:local_handle in 158 - let display_name = 159 - try Hashtbl.find handle_to_name local_handle 160 - with Not_found -> local_handle 161 - in 162 - { 163 - handle = local_handle; 164 - display_name; 165 - monorepo_url = (match member with Some m -> m.monorepo | None -> ""); 166 - opam_url = (match member with Some m -> m.opamrepo | None -> ""); 167 - package_count = List.length local_pkgs; 168 - unique_packages = []; 169 - } 170 - in 139 + { pkg with owners; synopsis; depends } :: acc) 140 + pkg_map [] 141 + |> List.sort (fun a b -> String.compare a.name b.name) 171 142 172 - (* Build final package list with owners *) 173 - let all_packages = 174 - Hashtbl.fold 175 - (fun _name entries acc -> 176 - match entries with 177 - | [] -> acc 178 - | (_, pkg) :: _ as all -> 179 - let owners = List.map fst all in 180 - (* Pick the best synopsis (first non-None) *) 181 - let synopsis = List.find_map (fun (_, p) -> p.synopsis) all in 182 - (* Merge depends from all sources *) 183 - let depends = 184 - List.concat_map (fun (_, p) -> p.depends) all 185 - |> List.sort_uniq String.compare 186 - in 187 - { pkg with owners; synopsis; depends } :: acc) 188 - pkg_map [] 189 - |> List.sort (fun a b -> String.compare a.name b.name) 190 - in 143 + (** Build repo_info list from packages *) 144 + let build_all_repos all_packages forks = 145 + let all_pkg_names = Hashtbl.create 256 in 146 + List.iter (fun p -> Hashtbl.replace all_pkg_names p.name ()) all_packages; 191 147 192 - (* Build set of all package names for dependency counting *) 193 - let all_pkg_names = 194 - List.fold_left 195 - (fun s p -> 196 - Hashtbl.replace s p.name (); 197 - s) 198 - (Hashtbl.create 256) all_packages 199 - in 200 - 201 - (* Group packages by repo *) 202 - let repos_map : (string, pkg_info list) Hashtbl.t = Hashtbl.create 64 in 148 + let repos_map = Hashtbl.create 64 in 203 149 List.iter 204 150 (fun (pkg : pkg_info) -> 205 151 let existing = ··· 208 154 Hashtbl.replace repos_map pkg.repo_name (pkg :: existing)) 209 155 all_packages; 210 156 211 - (* Build forks status lookup from forks data if provided *) 212 - let forks_by_repo : (string, (string * Forks.relationship) list) Hashtbl.t = 213 - Hashtbl.create 64 214 - in 157 + let forks_by_repo = Hashtbl.create 64 in 215 158 (match forks with 216 159 | Some f -> 217 160 List.iter ··· 223 166 f.Forks.repos 224 167 | None -> ()); 225 168 226 - (* Build repo_info list with dependency counts *) 227 - let all_repos = 228 - Hashtbl.fold 229 - (fun repo_name pkgs acc -> 230 - let dev_repo = (List.hd pkgs).dev_repo in 231 - let owners = 232 - List.sort_uniq String.compare 233 - (List.concat_map (fun (p : pkg_info) -> p.owners) pkgs) 234 - in 235 - let fork_status = 236 - try Hashtbl.find forks_by_repo repo_name with Not_found -> [] 237 - in 238 - (* Count dependencies that are in our package set *) 239 - let dep_count = 240 - List.concat_map (fun (p : pkg_info) -> p.depends) pkgs 241 - |> List.filter (fun d -> Hashtbl.mem all_pkg_names d) 242 - |> List.sort_uniq String.compare 243 - |> List.length 244 - in 245 - { 246 - ri_name = repo_name; 247 - ri_dev_repo = dev_repo; 248 - ri_packages = List.sort (fun a b -> String.compare a.name b.name) pkgs; 249 - ri_owners = owners; 250 - ri_fork_status = fork_status; 251 - ri_dep_count = dep_count; 252 - } 253 - :: acc) 254 - repos_map [] 255 - (* Sort by dependency count descending (apps with most deps first), then by name *) 256 - |> List.sort (fun a b -> 257 - let cmp = compare b.ri_dep_count a.ri_dep_count in 258 - if cmp <> 0 then cmp else String.compare a.ri_name b.ri_name) 169 + Hashtbl.fold 170 + (fun repo_name pkgs acc -> 171 + let dev_repo = (List.hd pkgs).dev_repo in 172 + let owners = 173 + List.sort_uniq String.compare 174 + (List.concat_map (fun (p : pkg_info) -> p.owners) pkgs) 175 + in 176 + let fork_status = 177 + try Hashtbl.find forks_by_repo repo_name with Not_found -> [] 178 + in 179 + let dep_count = 180 + List.concat_map (fun (p : pkg_info) -> p.depends) pkgs 181 + |> List.filter (fun d -> Hashtbl.mem all_pkg_names d) 182 + |> List.sort_uniq String.compare 183 + |> List.length 184 + in 185 + { 186 + ri_name = repo_name; 187 + ri_dev_repo = dev_repo; 188 + ri_packages = List.sort (fun a b -> String.compare a.name b.name) pkgs; 189 + ri_owners = owners; 190 + ri_fork_status = fork_status; 191 + ri_dep_count = dep_count; 192 + } 193 + :: acc) 194 + repos_map [] 195 + |> List.sort (fun a b -> 196 + let cmp = compare b.ri_dep_count a.ri_dep_count in 197 + if cmp <> 0 then cmp else String.compare a.ri_name b.ri_name) 198 + 199 + (** Collect site data from the workspace *) 200 + let collect_data ~fs ~config ?forks ~registry () = 201 + let local_handle = Verse_config.handle config in 202 + let local_opam_repo = Verse_config.opam_repo_path config in 203 + let verse_path = Verse_config.verse_path config in 204 + 205 + let local_pkgs = 206 + if dir_exists ~fs local_opam_repo then 207 + scan_member_packages ~fs local_opam_repo 208 + else [] 259 209 in 260 210 261 - (* Separate common and unique repos *) 211 + let pkg_map = Hashtbl.create 256 in 212 + add_packages_to_map pkg_map local_handle local_pkgs; 213 + 214 + let handle_to_name = build_handle_names registry in 215 + 216 + let member_infos = 217 + scan_tracked_members ~fs ~verse_path ~local_handle ~pkg_map ~registry 218 + ~handle_to_name 219 + in 220 + 221 + let local_member = 222 + let member = Verse_registry.member registry ~handle:local_handle in 223 + let display_name = 224 + try Hashtbl.find handle_to_name local_handle 225 + with Not_found -> local_handle 226 + in 227 + { 228 + handle = local_handle; 229 + display_name; 230 + monorepo_url = (match member with Some m -> m.monorepo | None -> ""); 231 + opam_url = (match member with Some m -> m.opamrepo | None -> ""); 232 + package_count = List.length local_pkgs; 233 + unique_packages = []; 234 + } 235 + in 236 + 237 + let all_packages = build_all_packages pkg_map in 238 + let all_repos = build_all_repos all_packages forks in 262 239 let common_repos = 263 240 List.filter (fun r -> List.length r.ri_owners > 1) all_repos 264 241 in ··· 266 243 List.filter (fun r -> List.length r.ri_owners = 1) all_repos 267 244 in 268 245 269 - (* Compute unique packages per member *) 270 246 let unique_by_handle = Hashtbl.create 32 in 271 247 List.iter 272 248 (fun (pkg : pkg_info) -> ··· 279 255 end) 280 256 all_packages; 281 257 282 - (* Update member infos with unique packages *) 283 258 let update_member m = 284 259 let unique = 285 260 try Hashtbl.find unique_by_handle m.handle with Not_found -> [] ··· 287 262 { m with unique_packages = List.sort String.compare unique } 288 263 in 289 264 290 - let all_members = local_member :: member_infos in 291 - let members = List.map update_member all_members in 265 + let members = List.map update_member (local_member :: member_infos) in 292 266 293 267 { 294 268 local_handle; 295 - registry_name; 296 - registry_description; 269 + registry_name = registry.Verse_registry.name; 270 + registry_description = registry.Verse_registry.description; 297 271 members; 298 272 common_repos; 299 273 unique_repos; ··· 328 302 | Forks.Unrelated -> "unrel" 329 303 | Forks.Not_fetched -> "?" 330 304 331 - (** Generate HTML from site data *) 332 - let generate_html data = 333 - let buf = Buffer.create 16384 in 334 - let add = Buffer.add_string buf in 335 - 336 - (* Build member lookups *) 337 - let member_urls = Hashtbl.create 16 in 338 - let member_names = Hashtbl.create 16 in 339 - List.iter 340 - (fun m -> 341 - Hashtbl.replace member_urls m.handle (m.monorepo_url, m.opam_url); 342 - Hashtbl.replace member_names m.handle m.display_name) 343 - data.members; 344 - 345 - (* Helper to get display name for handle *) 346 - let get_name handle = 347 - try Hashtbl.find member_names handle with Not_found -> handle 348 - in 349 - 350 - add 351 - {|<!DOCTYPE html> 352 - <html lang="en"> 353 - <head> 354 - <meta charset="UTF-8"> 355 - <meta name="viewport" content="width=device-width, initial-scale=1.0"> 356 - <title>|}; 357 - add (html_escape data.registry_name); 358 - add 359 - {|</title> 360 - <style> 361 - * { margin: 0; padding: 0; box-sizing: border-box; } 305 + (** CSS styles for the site *) 306 + let site_css = 307 + {|* { margin: 0; padding: 0; box-sizing: border-box; } 362 308 body { font: 10pt/1.4 -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; color: #333; max-width: 900px; margin: 0 auto; padding: 12px; } 363 309 h1 { font-size: 14pt; font-weight: 600; margin-bottom: 4px; } 364 310 .subtitle { font-size: 9pt; color: #666; margin-bottom: 12px; border-bottom: 1px solid #ddd; padding-bottom: 8px; } ··· 407 353 .unique-member-name { font-weight: 500; font-size: 9pt; color: #555; } 408 354 .unique-list { font-size: 9pt; color: #666; margin-top: 2px; } 409 355 .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; } 410 - footer { margin-top: 20px; padding-top: 8px; border-top: 1px solid #ddd; font-size: 9pt; color: #888; } 411 - </style> 412 - </head> 413 - <body> 414 - |}; 356 + footer { margin-top: 20px; padding-top: 8px; border-top: 1px solid #ddd; font-size: 9pt; color: #888; }|} 357 + 358 + (** Generate member card HTML *) 359 + let generate_member_card buf m = 360 + let add = Buffer.add_string buf in 361 + add "<div class=\"member\">\n"; 362 + add 363 + (Printf.sprintf 364 + "<div class=\"member-name\"><a href=\"https://%s\">%s</a></div>\n" 365 + (html_escape m.handle) 366 + (html_escape m.display_name)); 367 + if m.display_name <> m.handle then 368 + add 369 + (Printf.sprintf "<div class=\"member-handle\">%s</div>\n" 370 + (html_escape m.handle)); 371 + add (Printf.sprintf "<div class=\"member-stats\">%d packages" m.package_count); 372 + if m.unique_packages <> [] then 373 + add (Printf.sprintf ", %d unique" (List.length m.unique_packages)); 374 + add "</div>\n"; 375 + if m.monorepo_url <> "" || m.opam_url <> "" then begin 376 + add "<div class=\"member-links\">"; 377 + if m.monorepo_url <> "" then 378 + add 379 + (Printf.sprintf "<a class=\"ext\" href=\"%s\">mono%s</a>" 380 + (html_escape m.monorepo_url) 381 + external_link_icon); 382 + if m.opam_url <> "" then 383 + add 384 + (Printf.sprintf "<a class=\"ext\" href=\"%s\">opam%s</a>" 385 + (html_escape m.opam_url) external_link_icon); 386 + add "</div>\n" 387 + end; 388 + add "</div>\n" 389 + 390 + (** Generate repo detail HTML *) 391 + let generate_repo_detail buf ~member_urls ~get_name r = 392 + let add = Buffer.add_string buf in 393 + add 394 + (Printf.sprintf "<div class=\"repo\" id=\"%s\">\n" (html_escape r.ri_name)); 395 + add "<div class=\"repo-header\">"; 396 + add 397 + (Printf.sprintf 398 + "<span class=\"repo-name\"><a class=\"ext\" href=\"%s\">%s%s</a></span>" 399 + (html_escape r.ri_dev_repo) 400 + (html_escape r.ri_name) external_link_icon); 401 + add "</div>\n"; 402 + 403 + add "<div class=\"repo-packages\">"; 404 + let pkg_names = List.map (fun (p : pkg_info) -> p.name) r.ri_packages in 405 + add (String.concat ", " (List.map html_escape pkg_names)); 406 + add "</div>\n"; 407 + 408 + let pkg_descs = 409 + List.filter_map 410 + (fun (p : pkg_info) -> 411 + match p.synopsis with Some s -> Some (p.name, s) | None -> None) 412 + r.ri_packages 413 + in 414 + if pkg_descs <> [] then begin 415 + add "<ul class=\"pkg-list\">\n"; 416 + List.iter 417 + (fun (name, desc) -> 418 + add 419 + (Printf.sprintf "<li><b>%s</b>: %s</li>\n" (html_escape name) 420 + (html_escape desc))) 421 + pkg_descs; 422 + add "</ul>\n" 423 + end; 424 + 425 + if List.length r.ri_owners > 1 then begin 426 + let owner_links = 427 + List.map 428 + (fun h -> 429 + Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape h) 430 + (html_escape (get_name h))) 431 + (List.sort String.compare r.ri_owners) 432 + in 433 + add "<details class=\"repo-forks\">\n"; 434 + add 435 + (Printf.sprintf "<summary>%d members (%s)</summary>\n" 436 + (List.length r.ri_owners) 437 + (String.concat ", " owner_links)); 438 + add "<div class=\"fork-list\">\n"; 439 + List.iter 440 + (fun handle -> 441 + let mono_url, _opam_url = 442 + try Hashtbl.find member_urls handle with Not_found -> ("", "") 443 + in 444 + add "<span class=\"fork-item\">"; 445 + add 446 + (Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape handle) 447 + (html_escape (get_name handle))); 448 + (match List.assoc_opt handle r.ri_fork_status with 449 + | Some rel -> 450 + let status_str = format_relationship rel in 451 + let status_class = 452 + match rel with 453 + | Forks.Same_url | Forks.Same_commit -> "sync" 454 + | Forks.I_am_ahead _ -> "ahead" 455 + | Forks.I_am_behind _ -> "behind" 456 + | Forks.Diverged _ -> "diverged" 457 + | _ -> "" 458 + in 459 + if status_class <> "" then 460 + add 461 + (Printf.sprintf "<span class=\"fork-status %s\">%s</span>" 462 + status_class status_str) 463 + else 464 + add 465 + (Printf.sprintf "<span class=\"fork-status\">%s</span>" 466 + status_str) 467 + | None -> ()); 468 + if mono_url <> "" then 469 + add 470 + (Printf.sprintf "<a class=\"ext\" href=\"%s/%s\">mono%s</a>" 471 + (html_escape mono_url) (html_escape r.ri_name) external_link_icon); 472 + add "</span>\n") 473 + (List.sort String.compare r.ri_owners); 474 + add "</div>\n</details>\n" 475 + end; 476 + add "</div>\n" 477 + 478 + (** Generate HTML from site data *) 479 + let generate_html data = 480 + let buf = Buffer.create 16384 in 481 + let add = Buffer.add_string buf in 482 + 483 + let member_urls = Hashtbl.create 16 in 484 + let member_names = Hashtbl.create 16 in 485 + List.iter 486 + (fun m -> 487 + Hashtbl.replace member_urls m.handle (m.monorepo_url, m.opam_url); 488 + Hashtbl.replace member_names m.handle m.display_name) 489 + data.members; 490 + 491 + let get_name handle = 492 + try Hashtbl.find member_names handle with Not_found -> handle 493 + in 494 + 495 + add "<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n"; 496 + add "<meta charset=\"UTF-8\">\n"; 497 + add 498 + "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n"; 499 + add (Printf.sprintf "<title>%s</title>\n" (html_escape data.registry_name)); 500 + add "<style>\n"; 501 + add site_css; 502 + add "\n</style>\n</head>\n<body>\n"; 415 503 416 - (* Title and description *) 417 504 add (Printf.sprintf "<h1>%s</h1>\n" (html_escape data.registry_name)); 418 505 (match data.registry_description with 419 506 | Some desc -> ··· 421 508 (Printf.sprintf "<div class=\"subtitle\">%s</div>\n" (html_escape desc)) 422 509 | None -> add "<div class=\"subtitle\"></div>\n"); 423 510 424 - (* Intro section *) 425 511 add 426 512 {|<div class="intro"> 427 513 This is an experiment in large-scale agentic coding using OCaml and OxCaml, where we're building environments to exchange vibe code at scale. ··· 435 521 </div> 436 522 |}; 437 523 438 - (* Members section *) 439 524 add "<div class=\"section\">\n<h2>Members</h2>\n<div class=\"members\">\n"; 440 - List.iter 441 - (fun m -> 442 - add "<div class=\"member\">\n"; 443 - add 444 - (Printf.sprintf 445 - "<div class=\"member-name\"><a href=\"https://%s\">%s</a></div>\n" 446 - (html_escape m.handle) 447 - (html_escape m.display_name)); 448 - if m.display_name <> m.handle then 449 - add 450 - (Printf.sprintf "<div class=\"member-handle\">%s</div>\n" 451 - (html_escape m.handle)); 452 - add 453 - (Printf.sprintf "<div class=\"member-stats\">%d packages" 454 - m.package_count); 455 - if m.unique_packages <> [] then 456 - add (Printf.sprintf ", %d unique" (List.length m.unique_packages)); 457 - add "</div>\n"; 458 - if m.monorepo_url <> "" || m.opam_url <> "" then begin 459 - add "<div class=\"member-links\">"; 460 - if m.monorepo_url <> "" then 461 - add 462 - (Printf.sprintf "<a class=\"ext\" href=\"%s\">mono%s</a>" 463 - (html_escape m.monorepo_url) 464 - external_link_icon); 465 - if m.opam_url <> "" then 466 - add 467 - (Printf.sprintf "<a class=\"ext\" href=\"%s\">opam%s</a>" 468 - (html_escape m.opam_url) external_link_icon); 469 - add "</div>\n" 470 - end; 471 - add "</div>\n") 472 - data.members; 525 + List.iter (generate_member_card buf) data.members; 473 526 add "</div>\n</div>\n"; 474 527 475 - (* Summary section *) 476 - add "<div class=\"section\">\n"; 477 - add "<div class=\"summary\">\n"; 528 + add "<div class=\"section\">\n<div class=\"summary\">\n"; 478 529 add 479 530 (Printf.sprintf 480 531 "<div class=\"summary-title\">Common Libraries (%d repos, %d \ ··· 495 546 data.common_repos; 496 547 add "</div>\n</div>\n"; 497 548 498 - (* Member-specific summary *) 499 549 let members_with_unique = 500 550 List.filter (fun m -> m.unique_packages <> []) data.members 501 551 in ··· 514 564 (html_escape m.display_name)); 515 565 add "<span class=\"unique-list\">"; 516 566 add (String.concat ", " (List.map html_escape m.unique_packages)); 517 - add "</span>\n"; 518 - add "</div>\n") 567 + add "</span>\n</div>\n") 519 568 members_with_unique; 520 569 add "</div>\n</div>\n" 521 570 end; 522 571 add "</div>\n"; 523 572 524 - (* Detailed repos section *) 525 573 if data.common_repos <> [] then begin 526 574 add "<div class=\"section\">\n<h2>Repository Details</h2>\n"; 527 - 528 575 List.iter 529 - (fun r -> 530 - add 531 - (Printf.sprintf "<div class=\"repo\" id=\"%s\">\n" 532 - (html_escape r.ri_name)); 533 - add "<div class=\"repo-header\">"; 534 - add 535 - (Printf.sprintf 536 - "<span class=\"repo-name\"><a class=\"ext\" \ 537 - href=\"%s\">%s%s</a></span>" 538 - (html_escape r.ri_dev_repo) 539 - (html_escape r.ri_name) external_link_icon); 540 - add "</div>\n"; 541 - 542 - (* Packages list - compact with names *) 543 - add "<div class=\"repo-packages\">"; 544 - let pkg_names = List.map (fun (p : pkg_info) -> p.name) r.ri_packages in 545 - add (String.concat ", " (List.map html_escape pkg_names)); 546 - add "</div>\n"; 547 - 548 - (* Package descriptions as bullet list *) 549 - let pkg_descs = 550 - List.filter_map 551 - (fun (p : pkg_info) -> 552 - match p.synopsis with Some s -> Some (p.name, s) | None -> None) 553 - r.ri_packages 554 - in 555 - if pkg_descs <> [] then begin 556 - add "<ul class=\"pkg-list\">\n"; 557 - List.iter 558 - (fun (name, desc) -> 559 - add 560 - (Printf.sprintf "<li><b>%s</b>: %s</li>\n" (html_escape name) 561 - (html_escape desc))) 562 - pkg_descs; 563 - add "</ul>\n" 564 - end; 565 - 566 - (* Forks - at repo level with names *) 567 - if List.length r.ri_owners > 1 then begin 568 - let owner_links = 569 - List.map 570 - (fun h -> 571 - Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape h) 572 - (html_escape (get_name h))) 573 - (List.sort String.compare r.ri_owners) 574 - in 575 - add "<details class=\"repo-forks\">\n"; 576 - add 577 - (Printf.sprintf "<summary>%d members (%s)</summary>\n" 578 - (List.length r.ri_owners) 579 - (String.concat ", " owner_links)); 580 - add "<div class=\"fork-list\">\n"; 581 - List.iter 582 - (fun handle -> 583 - let mono_url, _opam_url = 584 - try Hashtbl.find member_urls handle with Not_found -> ("", "") 585 - in 586 - add "<span class=\"fork-item\">"; 587 - add 588 - (Printf.sprintf "<a href=\"https://%s\">%s</a>" 589 - (html_escape handle) 590 - (html_escape (get_name handle))); 591 - (* Add status if available *) 592 - (match List.assoc_opt handle r.ri_fork_status with 593 - | Some rel -> 594 - let status_str = format_relationship rel in 595 - let status_class = 596 - match rel with 597 - | Forks.Same_url | Forks.Same_commit -> "sync" 598 - | Forks.I_am_ahead _ -> "ahead" 599 - | Forks.I_am_behind _ -> "behind" 600 - | Forks.Diverged _ -> "diverged" 601 - | _ -> "" 602 - in 603 - if status_class <> "" then 604 - add 605 - (Printf.sprintf "<span class=\"fork-status %s\">%s</span>" 606 - status_class status_str) 607 - else 608 - add 609 - (Printf.sprintf "<span class=\"fork-status\">%s</span>" 610 - status_str) 611 - | None -> ()); 612 - if mono_url <> "" then 613 - add 614 - (Printf.sprintf "<a class=\"ext\" href=\"%s/%s\">mono%s</a>" 615 - (html_escape mono_url) (html_escape r.ri_name) 616 - external_link_icon); 617 - add "</span>\n") 618 - (List.sort String.compare r.ri_owners); 619 - add "</div>\n</details>\n" 620 - end; 621 - 622 - add "</div>\n") 576 + (generate_repo_detail buf ~member_urls ~get_name) 623 577 data.common_repos; 624 - 625 578 add "</div>\n" 626 579 end; 627 580 628 - (* Footer with generation date *) 629 581 let now = Unix.gettimeofday () in 630 582 let tm = Unix.gmtime now in 631 583 let date_str =

Configure Feed

Configure Feed