My aggregated monorepo of OCaml code, automaintained
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Squashed 'monopam/' changes from d0cac4f..369891e

369891e Fix monopam sync idempotency: skip subtree pulls when already in sync
9852f70 Merge verse commands into mainline monopam commands
5cc0a98 Fix CLI help: remove tangled auth login, fix nonexistent push command
6fd4281 Add site command to generate static HTML monoverse map

git-subtree-dir: monopam
git-subtree-split: 369891e890ee47eb7bec76b1a3231f634833edc7

+830 -276
+157 -255
bin/main.ml
··· 55 55 | Ok config -> f config 56 56 | Error msg -> 57 57 Fmt.epr "Error loading config: %s@." msg; 58 - Fmt.epr "Run 'monopam verse init' first to create a workspace.@."; 58 + Fmt.epr "Run 'monopam init' first to create a workspace.@."; 59 59 `Error (false, "configuration error") 60 60 61 61 (* Status command *) ··· 446 446 let info = Cmd.info "opam" ~doc ~man in 447 447 Cmd.group info [ opam_sync_cmd ] 448 448 449 - (* Verse commands *) 449 + (* Init command - initialize a new monopam workspace *) 450 450 451 - (* Helper to load verse config from XDG *) 452 - let with_verse_config env f = 453 - let fs = Eio.Stdenv.fs env in 454 - match Monopam.Verse_config.load ~fs () with 455 - | Ok config -> f config 456 - | Error msg -> 457 - Fmt.epr "Error loading opamverse config: %s@." msg; 458 - Fmt.epr "Run 'monopam verse init' to create a workspace.@."; 459 - `Error (false, "configuration error") 460 - 461 - let verse_root_arg = 451 + let init_root_arg = 462 452 let doc = 463 453 "Path to workspace root directory. Defaults to current directory." 464 454 in ··· 467 457 & opt (some (conv (Fpath.of_string, Fpath.pp))) None 468 458 & info [ "root" ] ~docv:"PATH" ~doc) 469 459 470 - let verse_handle_arg = 471 - let doc = "Tangled handle (e.g., alice.bsky.social)" in 460 + let init_handle_arg = 461 + let doc = "Your handle (e.g., alice.bsky.social)" in 472 462 Arg.( 473 463 required & opt (some string) None & info [ "handle" ] ~docv:"HANDLE" ~doc) 474 464 475 - let verse_handle_opt_pos_arg = 476 - let doc = 477 - "Tangled handle. If not specified, operates on all tracked members." 478 - in 479 - Arg.(value & pos 0 (some string) None & info [] ~docv:"HANDLE" ~doc) 480 - 481 - let verse_init_cmd = 482 - let doc = "Initialize a new opamverse workspace" in 465 + let init_cmd = 466 + let doc = "Initialize a new monopam workspace" in 483 467 let man = 484 468 [ 485 469 `S Manpage.s_description; 486 470 `P 487 - "Creates a new opamverse workspace for federated monorepo \ 488 - collaboration. An opamverse workspace lets you browse and track other \ 489 - developers' monorepos alongside your own."; 471 + "Creates a new monopam workspace for monorepo development. The workspace \ 472 + lets you manage your own monorepo and optionally browse and track other \ 473 + developers' monorepos."; 490 474 `S "WORKSPACE STRUCTURE"; 491 475 `P 492 476 "The init command creates the following directory structure at the \ ··· 511 495 verse = \"verse\"\n\n\ 512 496 [identity]\n\ 513 497 handle = \"yourname.bsky.social\""; 514 - `S "AUTHENTICATION"; 515 - `P "Before running init, you must authenticate with the tangled network:"; 516 - `Pre "tangled auth login"; 498 + `S "HANDLE VALIDATION"; 517 499 `P 518 - "The handle you provide is validated against the AT Protocol identity \ 519 - system to ensure it exists and you are authenticated."; 500 + "The handle you provide identifies you in the community. \ 501 + It should be a valid domain name (e.g., yourname.bsky.social or \ 502 + your-domain.com)."; 520 503 `S "REGISTRY"; 521 504 `P 522 - "The opamverse registry is a git repository containing an \ 523 - opamverse.toml file that lists community members and their monorepo \ 524 - URLs. The default registry is at: \ 525 - https://tangled.org/eeg.cl.cam.ac.uk/opamverse"; 505 + "The registry is a git repository containing an opamverse.toml file \ 506 + that lists community members and their monorepo URLs. The default \ 507 + registry is at: https://tangled.org/eeg.cl.cam.ac.uk/opamverse"; 526 508 `S Manpage.s_examples; 527 - `P "Initialize a workspace in ~/tangled:"; 528 - `Pre "cd ~/tangled\nmonopam verse init --handle alice.bsky.social"; 509 + `P "Initialize a workspace in the current directory:"; 510 + `Pre "monopam init --handle alice.bsky.social"; 529 511 `P "Initialize with explicit root path:"; 530 - `Pre "monopam verse init --root ~/my-workspace --handle alice.bsky.social"; 512 + `Pre "monopam init --root ~/my-workspace --handle alice.bsky.social"; 531 513 ] 532 514 in 533 515 let info = Cmd.info "init" ~doc ~man in ··· 547 529 in 548 530 match Monopam.Verse.init ~proc ~fs ~root ~handle () with 549 531 | Ok () -> 550 - Fmt.pr "Monoverse workspace initialized at %a@." Fpath.pp root; 532 + Fmt.pr "Workspace initialized at %a@." Fpath.pp root; 551 533 `Ok () 552 534 | Error e -> 553 535 Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e; 554 536 `Error (false, "init failed") 555 537 in 556 538 Cmd.v info 557 - Term.(ret (const run $ verse_root_arg $ verse_handle_arg $ logging_term)) 539 + Term.(ret (const run $ init_root_arg $ init_handle_arg $ logging_term)) 540 + 541 + (* Verse commands *) 542 + 543 + (* Helper to load verse config from XDG *) 544 + let with_verse_config env f = 545 + let fs = Eio.Stdenv.fs env in 546 + match Monopam.Verse_config.load ~fs () with 547 + | Ok config -> f config 548 + | Error msg -> 549 + Fmt.epr "Error loading opamverse config: %s@." msg; 550 + Fmt.epr "Run 'monopam init' to create a workspace.@."; 551 + `Error (false, "configuration error") 558 552 559 553 let verse_members_cmd = 560 554 let doc = "List registry members" in ··· 610 604 in 611 605 Cmd.v info Term.(ret (const run $ logging_term)) 612 606 613 - let verse_pull_cmd = 614 - let doc = "Sync all registry members to local workspace" in 615 - let man = 616 - [ 617 - `S Manpage.s_description; 618 - `P 619 - "Clones or pulls all members from the opamverse registry. For each \ 620 - member, syncs both their monorepo and opam overlay repository."; 621 - `S "WHAT IT DOES"; 622 - `P "For each member in the registry:"; 623 - `I ("1.", "Clones or pulls their monorepo to verse/<handle>/"); 624 - `I ("2.", "Clones or pulls their opam repo to verse/<handle>-opam/"); 625 - `S "SCOPE"; 626 - `P "With a handle argument: syncs only that specific member."; 627 - `P "Without arguments: syncs all members in the registry."; 628 - `S "ERROR HANDLING"; 629 - `P 630 - "If a sync fails for one member (e.g., network error), the error is \ 631 - reported but other members are still synced."; 632 - `S Manpage.s_examples; 633 - `Pre 634 - "# Sync all registry members\n\ 635 - monopam verse pull\n\n\ 636 - # Sync a specific member\n\ 637 - monopam verse pull alice.bsky.social\n\n\ 638 - # Browse their code\n\ 639 - ls verse/alice.bsky.social/"; 640 - ] 641 - in 642 - let info = Cmd.info "pull" ~doc ~man in 643 - let run handle () = 644 - Eio_main.run @@ fun env -> 645 - with_verse_config env @@ fun config -> 646 - let fs = Eio.Stdenv.fs env in 647 - let proc = Eio.Stdenv.process_mgr env in 648 - match Monopam.Verse.pull ~proc ~fs ~config ?handle () with 649 - | Ok () -> 650 - Fmt.pr "Sync completed.@."; 651 - `Ok () 652 - | Error e -> 653 - Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e; 654 - `Error (false, "pull failed") 655 - in 656 - Cmd.v info Term.(ret (const run $ verse_handle_opt_pos_arg $ logging_term)) 657 - 658 - let verse_sync_cmd = 659 - let doc = "Sync the workspace" in 660 - let man = 661 - [ 662 - `S Manpage.s_description; 663 - `P 664 - "Synchronizes your entire opamverse workspace with the latest upstream \ 665 - changes. This is the command to run regularly to stay up to date."; 666 - `S "WHAT IT DOES"; 667 - `P "The sync command performs two operations:"; 668 - `I 669 - ( "1.", 670 - "Updates the registry: git pull in \ 671 - ~/.local/share/monopam/opamverse-registry/" ); 672 - `I ("2.", "Pulls all tracked members: git pull in each verse/<handle>/"); 673 - `S "USE CASES"; 674 - `P "Run sync when you want to:"; 675 - `I ("-", "See if any new members have joined the community"); 676 - `I ("-", "Get the latest code from all tracked members"); 677 - `I ("-", "Catch up after being away for a while"); 678 - `S "COMPARISON WITH PULL"; 679 - `P 680 - "'verse sync' updates the registry AND pulls members. 'verse pull' \ 681 - only pulls members (skips registry update)."; 682 - `S Manpage.s_examples; 683 - `Pre 684 - "# Daily sync routine\n\ 685 - cd ~/tangled\n\ 686 - monopam verse sync\n\ 687 - monopam verse status"; 688 - ] 689 - in 690 - let info = Cmd.info "sync" ~doc ~man in 691 - let run () = 692 - Eio_main.run @@ fun env -> 693 - with_verse_config env @@ fun config -> 694 - let fs = Eio.Stdenv.fs env in 695 - let proc = Eio.Stdenv.process_mgr env in 696 - match Monopam.Verse.sync ~proc ~fs ~config () with 697 - | Ok () -> 698 - Fmt.pr "Sync completed.@."; 699 - `Ok () 700 - | Error e -> 701 - Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e; 702 - `Error (false, "sync failed") 703 - in 704 - Cmd.v info Term.(ret (const run $ logging_term)) 705 - 706 607 let verse_fork_cmd = 707 608 let doc = "Fork a package from a verse member's repository" in 708 609 let man = ··· 813 714 Cmd.v info Term.(ret (const run $ package_arg $ from_arg $ url_arg $ dry_run_arg $ logging_term)) 814 715 815 716 let verse_cmd = 816 - let doc = "Federated monorepo collaboration" in 717 + let doc = "Verse member operations" in 817 718 let man = 818 719 [ 819 720 `S Manpage.s_description; 820 721 `P 821 - "The opamverse system enables federated collaboration across multiple \ 822 - developers' monorepos. Each developer maintains their own monorepo \ 823 - (managed by standard monopam commands), and can track other \ 824 - developers' monorepos for code browsing, learning, and collaboration."; 825 - `P 826 - "Members are identified by tangled handles - decentralized identities \ 827 - from the AT Protocol network (the same system used by Bluesky)."; 828 - `S "QUICK START FOR NEW USERS"; 829 - `P "Run these commands in order to get started:"; 830 - `Pre 831 - "# Step 1: Authenticate with tangled (one-time setup)\n\ 832 - tangled auth login\n\n\ 833 - # Step 2: Create and initialize your workspace\n\ 834 - mkdir ~/tangled && cd ~/tangled\n\ 835 - monopam verse init --handle yourname.bsky.social\n\n\ 836 - # Step 3: Sync all community members\n\ 837 - monopam verse pull\n\n\ 838 - # Step 4: Browse their code\n\ 839 - ls verse/\n\ 840 - cd verse/alice.bsky.social && dune build\n\n\ 841 - # Step 5: Keep everything updated (run daily/weekly)\n\ 842 - monopam verse sync"; 843 - `S "KEY CONCEPTS"; 844 - `I 845 - ( "Workspace", 846 - "A directory containing your monorepo plus all registry members' \ 847 - repos" ); 848 - `I 849 - ( "Registry", 850 - "A git repository listing community members and their repo URLs" ); 851 - `I 852 - ( "Handle", 853 - "A tangled identity like 'alice.bsky.social' validated via AT \ 854 - Protocol" ); 855 - `S "WORKSPACE STRUCTURE"; 856 - `P "An opamverse workspace has this layout:"; 857 - `Pre 858 - "~/tangled/ # workspace root\n\ 859 - ├── mono/ # YOUR monorepo\n\ 860 - ├── src/ # YOUR fork checkouts\n\ 861 - ├── opam-repo/ # YOUR opam overlay\n\ 862 - └── verse/\n\ 863 - \ ├── alice.bsky.social/ # Alice's monorepo\n\ 864 - \ ├── alice.bsky.social-opam/ # Alice's opam overlay\n\ 865 - \ ├── bob.example.com/ # Bob's monorepo\n\ 866 - \ └── bob.example.com-opam/ # Bob's opam overlay"; 867 - `P "Configuration and data are stored in XDG directories:"; 868 - `Pre 869 - "~/.config/monopam/\n\ 870 - └── opamverse.toml # workspace configuration\n\n\ 871 - ~/.local/share/monopam/\n\ 872 - └── opamverse-registry/ # cloned registry git repo"; 873 - `S "COMMAND FLOW"; 874 - `P "The expected sequence of commands for typical workflows:"; 875 - `P "$(b,First-time setup) (once per machine):"; 876 - `Pre 877 - "tangled auth login # authenticate\n\ 878 - monopam verse init --handle you.bsky.social # create workspace"; 879 - `P "$(b,Syncing all members):"; 880 - `Pre 881 - "monopam verse pull # clone/pull all \ 882 - members\n\ 883 - monopam verse status # check status"; 884 - `P "$(b,Daily maintenance):"; 885 - `Pre 886 - "monopam verse sync # update everything\n\ 887 - monopam verse status # check for changes"; 888 - `P "$(b,Working in your own monorepo):"; 889 - `Pre 890 - "cd ~/tangled/mono\n\ 891 - monopam pull # fetch upstream \ 892 - changes\n\ 893 - # ... make edits ...\n\ 894 - monopam push # export to checkouts"; 895 - `S "INTEGRATION WITH MONOPAM"; 722 + "Commands for working with verse community members. The verse system \ 723 + enables federated collaboration across multiple developers' monorepos."; 896 724 `P 897 - "The verse system complements standard monopam commands. Your mono/ \ 898 - directory works exactly like a normal monopam-managed monorepo:"; 899 - `Pre 900 - "# Work in your monorepo\n\ 901 - cd ~/tangled/mono\n\ 902 - monopam status\n\ 903 - monopam pull\n\ 904 - # ... make changes ...\n\ 905 - monopam push"; 725 + "Members are identified by handles - typically domain names like \ 726 + 'yourname.bsky.social' or 'your-domain.com'."; 727 + `S "NOTE"; 906 728 `P 907 - "The verse/ directories are for reading and learning from others' \ 908 - code. You generally don't push to them (unless you're a \ 909 - collaborator)."; 910 - `S "REGISTRY FORMAT"; 911 - `P "The registry is a git repository containing opamverse.toml:"; 912 - `Pre 913 - "[registry]\n\ 914 - name = \"tangled-community\"\n\n\ 915 - [[members]]\n\ 916 - handle = \"alice.bsky.social\"\n\ 917 - monorepo = \"https://github.com/alice/mono\""; 918 - `P "Default registry: https://tangled.org/eeg.cl.cam.ac.uk/opamverse"; 919 - `S "COMMANDS REFERENCE"; 920 - `I ("init", "Create a new workspace with config and directories"); 921 - `I ("status", "Show members and their git status"); 922 - `I ("members", "List all members in the registry"); 923 - `I ("pull [<handle>]", "Clone/pull all members (or specific member)"); 924 - `I ("sync", "Update registry and pull all members"); 729 + "The $(b,monopam init) command creates your workspace and \ 730 + $(b,monopam sync) automatically syncs verse members. These commands \ 731 + are for additional verse-specific operations."; 732 + `S "COMMANDS"; 733 + `I ("members", "List all members in the community registry"); 925 734 `I ("fork <pkg> --from <handle> --url <url>", "Fork a package from a verse member"); 926 - `S "AUTHENTICATION"; 927 - `P 928 - "Handle validation uses the AT Protocol identity system. The tangled \ 929 - CLI stores session credentials that monopam verse commands reuse."; 930 - `P "If you see 'Not authenticated', run:"; 931 - `Pre "tangled auth login"; 735 + `S Manpage.s_examples; 736 + `P "List all community members:"; 737 + `Pre "monopam verse members"; 738 + `P "Fork a package from another member:"; 739 + `Pre "monopam verse fork cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git"; 932 740 ] 933 741 in 934 742 let info = Cmd.info "verse" ~doc ~man in 935 743 Cmd.group info 936 744 [ 937 - verse_init_cmd; 938 745 verse_members_cmd; 939 - verse_pull_cmd; 940 - verse_sync_cmd; 941 746 verse_fork_cmd; 942 747 ] 943 748 ··· 1668 1473 in 1669 1474 Cmd.v info Term.(ret (const run $ url_or_pkg_arg $ as_arg $ upstream_arg $ from_arg $ fork_url_arg $ dry_run_arg $ logging_term)) 1670 1475 1476 + (* Site command *) 1477 + 1478 + let site_cmd = 1479 + let doc = "Generate a static HTML site representing the monoverse map" in 1480 + let man = 1481 + [ 1482 + `S Manpage.s_description; 1483 + `P 1484 + "Generates a static index.html file that maps the monoverse, showing all \ 1485 + verse members, their packages, and the relationships between them."; 1486 + `S "OUTPUT"; 1487 + `P "The generated site includes:"; 1488 + `I ("Members", "All verse members with links to their monorepo and opam repos"); 1489 + `I ("Summary", "Overview of common libraries and member-specific packages"); 1490 + `I ("Repository Details", "Each shared repo with packages and fork status"); 1491 + `S "FORK STATUS"; 1492 + `P "Use $(b,--status) to include fork relationship information:"; 1493 + `I ("+N", "You are N commits ahead of them"); 1494 + `I ("-N", "They are N commits ahead of you"); 1495 + `I ("+N/-M", "Diverged: you have N new, they have M new"); 1496 + `I ("sync", "Same commit"); 1497 + `S "DESIGN"; 1498 + `P "The HTML is designed to be:"; 1499 + `I ("-", "Simple and clean with a 10pt font"); 1500 + `I ("-", "Responsive and compact"); 1501 + `I ("-", "External links marked with icon and teal color"); 1502 + `S Manpage.s_examples; 1503 + `P "Generate site to default location (mono/index.html):"; 1504 + `Pre "monopam site"; 1505 + `P "Generate site with fork status (slower, fetches remotes):"; 1506 + `Pre "monopam site --status"; 1507 + `P "Generate site to custom location:"; 1508 + `Pre "monopam site -o /var/www/monoverse/index.html"; 1509 + `P "Print HTML to stdout:"; 1510 + `Pre "monopam site --stdout"; 1511 + ] 1512 + in 1513 + let info = Cmd.info "site" ~doc ~man in 1514 + let output_arg = 1515 + let doc = "Output file path. Defaults to mono/index.html." in 1516 + Arg.(value & opt (some string) None & info [ "o"; "output" ] ~docv:"FILE" ~doc) 1517 + in 1518 + let stdout_arg = 1519 + let doc = "Print HTML to stdout instead of writing to file." in 1520 + Arg.(value & flag & info [ "stdout" ] ~doc) 1521 + in 1522 + let status_arg = 1523 + let doc = "Include fork status (ahead/behind) for each repository. \ 1524 + This fetches from remotes and may be slower." in 1525 + Arg.(value & flag & info [ "status"; "s" ] ~doc) 1526 + in 1527 + let run output to_stdout with_status () = 1528 + Eio_main.run @@ fun env -> 1529 + with_config env @@ fun monopam_config -> 1530 + with_verse_config env @@ fun verse_config -> 1531 + let fs = Eio.Stdenv.fs env in 1532 + let proc = Eio.Stdenv.process_mgr env in 1533 + (* Pull/clone registry to get latest metadata *) 1534 + Fmt.pr "Syncing registry...@."; 1535 + let registry = 1536 + match Monopam.Verse_registry.clone_or_pull ~proc ~fs:(fs :> _ Eio.Path.t) ~config:verse_config () with 1537 + | Ok r -> r 1538 + | Error msg -> 1539 + Fmt.epr "Warning: Could not sync registry: %s@." msg; 1540 + Monopam.Verse_registry.{ name = "opamverse"; description = None; members = [] } 1541 + in 1542 + (* Compute forks if --status is requested *) 1543 + let forks = 1544 + if with_status then begin 1545 + Fmt.pr "Computing fork status...@."; 1546 + Some (Monopam.Forks.compute ~proc ~fs:(fs :> _ Eio.Path.t) 1547 + ~verse_config ~monopam_config ()) 1548 + end else None 1549 + in 1550 + if to_stdout then begin 1551 + let html = Monopam.Site.generate ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry () in 1552 + print_string html; 1553 + `Ok () 1554 + end else begin 1555 + let output_path = 1556 + match output with 1557 + | Some p -> ( 1558 + match Fpath.of_string p with 1559 + | Ok fp -> fp 1560 + | Error (`Msg _) -> Fpath.v p) 1561 + | None -> Fpath.(Monopam.Verse_config.mono_path verse_config / "index.html") 1562 + in 1563 + match Monopam.Site.write ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry ~output_path () with 1564 + | Ok () -> 1565 + Fmt.pr "Site generated: %a@." Fpath.pp output_path; 1566 + `Ok () 1567 + | Error msg -> 1568 + Fmt.epr "Error: %s@." msg; 1569 + `Error (false, "site generation failed") 1570 + end 1571 + in 1572 + Cmd.v info Term.(ret (const run $ output_arg $ stdout_arg $ status_arg $ logging_term)) 1573 + 1671 1574 (* Main command group *) 1672 1575 1673 1576 let main_cmd = ··· 1689 1592 `P "Inside the devcontainer, initialize your workspace:"; 1690 1593 `Pre 1691 1594 "cd ~/tangled\n\ 1692 - monopam verse init --handle yourname.bsky.social\n\ 1595 + monopam init --handle yourname.bsky.social\n\ 1693 1596 cd mono"; 1694 1597 `P "Daily workflow:"; 1695 1598 `Pre ··· 1722 1625 `I 1723 1626 ( "4. monopam sync --remote", 1724 1627 "Sync again, including pushing to upstream git remotes" ); 1725 - `P "For finer control, use $(b,push) and $(b,pull) separately:"; 1628 + `P "For finer control over the sync phases:"; 1726 1629 `I 1727 - ( "monopam push", 1728 - "Export monorepo changes to checkouts (for manual review/push)" ); 1630 + ( "monopam sync --skip-pull", 1631 + "Export monorepo changes to checkouts only (skip fetching remotes)" ); 1729 1632 `I 1730 - ( "monopam pull", 1731 - "Pull remote changes into monorepo (when you know there are no local \ 1732 - changes)" ); 1633 + ( "monopam sync --skip-push", 1634 + "Pull remote changes only (skip exporting local changes)" ); 1733 1635 `S "CHECKING STATUS"; 1734 1636 `P "Run $(b,monopam status) to see the state of all repositories:"; 1735 1637 `I ("local:+N", "Your monorepo is N commits ahead of the checkout"); ··· 1738 1640 `I ("remote:+N", "Your checkout is N commits ahead of upstream"); 1739 1641 `I ("remote:-N", "Upstream is N commits ahead (run $(b,monopam sync))"); 1740 1642 `S "COMMON TASKS"; 1741 - `I ("Start fresh", "monopam verse init --handle you.bsky.social"); 1643 + `I ("Start fresh", "monopam init --handle you.bsky.social"); 1742 1644 `I ("Check status", "monopam status"); 1743 1645 `I ("Sync everything", "monopam sync"); 1744 1646 `I ("Sync and push upstream", "monopam sync --remote"); 1745 1647 `I ("Sync one package", "monopam sync <package-name>"); 1746 1648 `S "CONFIGURATION"; 1747 1649 `P 1748 - "Run $(b,monopam verse init --handle <handle>) to create a workspace. \ 1650 + "Run $(b,monopam init --handle <handle>) to create a workspace. \ 1749 1651 Configuration is stored in ~/.config/monopam/opamverse.toml."; 1750 1652 `P "Workspace structure:"; 1751 1653 `Pre ··· 1770 1672 in 1771 1673 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in 1772 1674 Cmd.group info 1773 - [ status_cmd; diff_cmd; pull_cmd; cherrypick_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd; feature_cmd; fork_cmd; join_cmd; devcontainer_cmd ] 1675 + [ init_cmd; status_cmd; diff_cmd; pull_cmd; cherrypick_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd; feature_cmd; fork_cmd; join_cmd; devcontainer_cmd; site_cmd ] 1774 1676 1775 1677 let () = exit (Cmd.eval main_cmd)
+1 -1
lib/feature.ml
··· 16 16 Some (Printf.sprintf "Run 'monopam feature remove %s' first if you want to recreate it" name) 17 17 | Feature_not_found name -> 18 18 Some (Printf.sprintf "Run 'monopam feature list' to see available features, or 'monopam feature add %s' to create it" name) 19 - | Config_error _ -> Some "Run 'monopam verse init' to create a workspace configuration" 19 + | Config_error _ -> Some "Run 'monopam init' to create a workspace configuration" 20 20 21 21 let pp_error_with_hint ppf e = 22 22 pp_error ppf e;
+1 -1
lib/fork_join.ml
··· 20 20 21 21 let error_hint = function 22 22 | Config_error _ -> 23 - Some "Run 'monopam verse init --handle <your-handle>' to create a workspace." 23 + Some "Run 'monopam init --handle <your-handle>' to create a workspace." 24 24 | Git_error (Git.Dirty_worktree _) -> 25 25 Some "Commit or stash your changes first: git status" 26 26 | Git_error _ -> None
+31 -4
lib/monopam.ml
··· 15 15 module Opam_transform = Opam_transform 16 16 module Sources_registry = Sources_registry 17 17 module Fork_join = Fork_join 18 + module Site = Site 18 19 19 20 let src = Logs.Src.create "monopam" ~doc:"Monopam operations" 20 21 ··· 44 45 let error_hint = function 45 46 | Config_error _ -> 46 47 Some 47 - "Run 'monopam verse init --handle <your-handle>' to create a workspace." 48 + "Run 'monopam init --handle <your-handle>' to create a workspace." 48 49 | Repo_error (Opam_repo.No_dev_repo _) -> 49 50 Some 50 51 "Add a 'dev-repo' field to the package's opam file pointing to a git \ ··· 1544 1545 ?(skip_pull = false) () = 1545 1546 let fs_t = fs_typed fs in 1546 1547 1548 + (* Step 0: Sync verse members if verse config exists and not skipping pull *) 1549 + (if not skip_pull then 1550 + match Verse_config.load ~fs:fs_t () with 1551 + | Error _ -> () (* No verse config = skip *) 1552 + | Ok verse_config -> 1553 + Log.app (fun m -> m "Syncing verse members..."); 1554 + match Verse.pull ~proc ~fs:fs_t ~config:verse_config () with 1555 + | Ok () -> () 1556 + | Error e -> Log.warn (fun m -> m "Verse sync: %a" Verse.pp_error e)); 1557 + 1547 1558 (* Clone from verse registry if repos don't exist *) 1548 1559 match clone_from_verse_if_needed ~proc ~fs:fs_t ~config () with 1549 1560 | Error e -> Error e ··· 1608 1619 List.assoc_opt (Package.name pkg) status_by_name 1609 1620 |> Option.fold ~none:true ~some:(fun s -> 1610 1621 sync_needs_push s.Status.subtree_sync) 1622 + in 1623 + let sync_needs_pull = function 1624 + | Status.Subtree_behind _ | Status.Trees_differ -> true 1625 + | Status.In_sync | Status.Subtree_ahead _ | Status.Unknown -> 1626 + false 1627 + in 1628 + let needs_pull pkg = 1629 + List.assoc_opt (Package.name pkg) status_by_name 1630 + |> Option.fold ~none:true ~some:(fun s -> 1631 + sync_needs_pull s.Status.subtree_sync) 1611 1632 in 1612 1633 1613 1634 (* Step 2: Push phase - export monorepo changes to checkouts (PARALLEL) *) ··· 1756 1777 m " Skipping subtree updates (local modifications)...") 1757 1778 end 1758 1779 else begin 1780 + (* OPTIMIZATION: skip packages already in sync *) 1781 + let to_pull, to_skip = List.partition needs_pull successfully_fetched in 1759 1782 Log.app (fun m -> m " Updating subtrees..."); 1760 - let fetched_count = List.length successfully_fetched in 1783 + if to_skip <> [] then 1784 + Log.app (fun m -> 1785 + m " Skipping %d already-synced subtrees" 1786 + (List.length to_skip)); 1787 + let pull_count = List.length to_pull in 1761 1788 List.iteri 1762 1789 (fun i pkg -> 1763 1790 Log.info (fun m -> 1764 - m "[%d/%d] Subtree %s" (i + 1) fetched_count 1791 + m "[%d/%d] Subtree %s" (i + 1) pull_count 1765 1792 (Package.subtree_prefix pkg)); 1766 1793 match pull_subtree ~proc ~fs ~config pkg with 1767 1794 | Ok _ -> () ··· 1774 1801 } 1775 1802 :: !subtree_errs 1776 1803 | Error _ -> ()) 1777 - successfully_fetched 1804 + to_pull 1778 1805 end; 1779 1806 ( fetch_errs, 1780 1807 unchanged,
+1
lib/monopam.mli
··· 39 39 module Opam_transform = Opam_transform 40 40 module Sources_registry = Sources_registry 41 41 module Fork_join = Fork_join 42 + module Site = Site 42 43 43 44 (** {1 High-Level Operations} *) 44 45
+535
lib/site.ml
··· 1 + (** Generate a static HTML site representing the monoverse map. *) 2 + 3 + (** Information about a package in the verse *) 4 + type 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) *) 14 + type 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 *) 24 + type 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 *) 34 + type 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 *) 45 + let 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 *) 59 + let 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 *) 67 + let 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 *) 258 + let html_escape s = 259 + let buf = Buffer.create (String.length s) in 260 + String.iter (function 261 + | '<' -> Buffer.add_string buf "&lt;" 262 + | '>' -> Buffer.add_string buf "&gt;" 263 + | '&' -> Buffer.add_string buf "&amp;" 264 + | '"' -> Buffer.add_string buf "&quot;" 265 + | c -> Buffer.add_char buf c 266 + ) s; 267 + Buffer.contents buf 268 + 269 + (** External link SVG icon *) 270 + let 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 *) 274 + let 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 *) 284 + let 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; } 311 + body { font: 10pt/1.4 -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; color: #333; max-width: 900px; margin: 0 auto; padding: 12px; } 312 + h1 { 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; } 314 + h2 { font-size: 11pt; font-weight: 600; margin: 16px 0 8px; color: #444; } 315 + h3 { font-size: 10pt; font-weight: 600; margin: 12px 0 6px; color: #555; } 316 + a { color: #0066cc; text-decoration: none; } 317 + a:hover { text-decoration: underline; } 318 + a.ext { color: #0088aa; } 319 + a.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; } 359 + footer { 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"> 373 + This is an experiment in large-scale agentic coding using OCaml and OxCaml, where we're building environments to exchange vibe code at scale. 374 + Managed by <a class="ext" href="https://tangled.org/anil.recoil.org/monopam">monopam|}; add external_link_icon; add {|</a>, 375 + with 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 *) 526 + let 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 *) 531 + let 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 ()
+82
lib/site.mli
··· 1 + (** Generate a static HTML site representing the monoverse map. 2 + 3 + The site command generates an index.html that shows: 4 + - All verse members with links to their repos 5 + - Summary of common libraries and member-specific packages 6 + - Detailed repository information with fork status *) 7 + 8 + (** {1 Types} *) 9 + 10 + (** Information about a package in the verse *) 11 + type pkg_info = { 12 + name : string; 13 + synopsis : string option; 14 + repo_name : string; 15 + dev_repo : string; (** Upstream git URL *) 16 + owners : string list; (** List of handles that have this package *) 17 + depends : string list; (** Package dependencies *) 18 + } 19 + 20 + (** Information about a repository (group of packages) *) 21 + type repo_info = { 22 + ri_name : string; 23 + ri_dev_repo : string; 24 + ri_packages : pkg_info list; 25 + ri_owners : string list; (** All handles that have any package from this repo *) 26 + ri_fork_status : (string * Forks.relationship) list; (** (handle, relationship) *) 27 + ri_dep_count : int; (** Number of dependencies (for sorting) *) 28 + } 29 + 30 + (** Information about a verse member *) 31 + type member_info = { 32 + handle : string; 33 + display_name : string; (** Name to display (from registry or handle) *) 34 + monorepo_url : string; 35 + opam_url : string; 36 + package_count : int; 37 + unique_packages : string list; (** Packages unique to this member *) 38 + } 39 + 40 + (** Aggregated site data *) 41 + type site_data = { 42 + local_handle : string; 43 + registry_name : string; 44 + registry_description : string option; 45 + members : member_info list; 46 + common_repos : repo_info list; (** Repos that exist in multiple members *) 47 + unique_repos : repo_info list; (** Repos unique to one member *) 48 + all_packages : pkg_info list; (** All packages *) 49 + } 50 + 51 + (** {1 Generation} *) 52 + 53 + val collect_data : 54 + fs:Eio.Fs.dir_ty Eio.Path.t -> 55 + config:Verse_config.t -> 56 + ?forks:Forks.t -> 57 + registry:Verse_registry.t -> 58 + unit -> 59 + site_data 60 + (** [collect_data ~fs ~config ?forks ~registry ()] scans the workspace and verse members 61 + to collect package information for the site. If [forks] is provided, 62 + includes fork status information for each repository. *) 63 + 64 + val generate : 65 + fs:Eio.Fs.dir_ty Eio.Path.t -> 66 + config:Verse_config.t -> 67 + ?forks:Forks.t -> 68 + registry:Verse_registry.t -> 69 + unit -> 70 + string 71 + (** [generate ~fs ~config ?forks ~registry ()] generates the HTML content for the site. *) 72 + 73 + val write : 74 + fs:Eio.Fs.dir_ty Eio.Path.t -> 75 + config:Verse_config.t -> 76 + ?forks:Forks.t -> 77 + registry:Verse_registry.t -> 78 + output_path:Fpath.t -> 79 + unit -> 80 + (unit, string) result 81 + (** [write ~fs ~config ?forks ~registry ~output_path ()] generates and writes the site 82 + to the specified output path. *)
+2 -2
lib/verse.ml
··· 26 26 let error_hint = function 27 27 | Config_error _ -> 28 28 Some 29 - "Run 'monopam verse init --handle <your-handle>' to create a workspace." 29 + "Run 'monopam init --handle <your-handle>' to create a workspace." 30 30 | Git_error (Git.Dirty_worktree _) -> 31 31 Some "Commit or stash your changes first: git status" 32 32 | Git_error (Git.Command_failed (cmd, _)) ··· 45 45 | Workspace_exists _ -> 46 46 Some "Use a different directory, or remove the existing workspace." 47 47 | Not_a_workspace _ -> 48 - Some "Run 'monopam verse init --handle <your-handle>' to create a workspace here." 48 + Some "Run 'monopam init --handle <your-handle>' to create a workspace here." 49 49 | Package_not_found (pkg, handle) -> 50 50 Some (Fmt.str "Run 'monopam verse pull %s' to sync their opam repo, then check package name: %s" handle pkg) 51 51 | Package_already_exists pkgs ->
+18 -13
lib/verse_registry.ml
··· 1 1 type member = { 2 2 handle : string; 3 + name : string option; 3 4 monorepo : string; 4 5 monorepo_branch : string option; 5 6 opamrepo : string; 6 7 opamrepo_branch : string option; 7 8 } 8 - type t = { name : string; members : member list } 9 + type t = { name : string; description : string option; members : member list } 9 10 10 11 let default_url = "https://tangled.org/eeg.cl.cam.ac.uk/opamverse" 11 12 ··· 27 28 let pp_member ppf m = 28 29 let mono_str = encode_url_with_branch m.monorepo m.monorepo_branch in 29 30 let opam_str = encode_url_with_branch m.opamrepo m.opamrepo_branch in 30 - Fmt.pf ppf "@[<hov 2>%s ->@ mono:%s@ opam:%s@]" m.handle mono_str opam_str 31 + let name_str = match m.name with Some n -> n | None -> m.handle in 32 + Fmt.pf ppf "@[<hov 2>%s (%s) ->@ mono:%s@ opam:%s@]" name_str m.handle mono_str opam_str 31 33 32 34 let pp ppf t = 33 - Fmt.pf ppf "@[<v>registry: %s@,members:@, @[<v>%a@]@]" t.name 35 + Fmt.pf ppf "@[<v>registry: %s%a@,members:@, @[<v>%a@]@]" t.name 36 + Fmt.(option (fun ppf s -> pf ppf "@,description: %s" s)) t.description 34 37 Fmt.(list ~sep:cut pp_member) 35 38 t.members 36 39 ··· 47 50 let member_codec : member Tomlt.t = 48 51 Tomlt.( 49 52 Table.( 50 - obj (fun handle monorepo_raw opamrepo_raw -> 53 + obj (fun handle name monorepo_raw opamrepo_raw -> 51 54 let monorepo, monorepo_branch = parse_url_with_branch monorepo_raw in 52 55 let opamrepo, opamrepo_branch = parse_url_with_branch opamrepo_raw in 53 - { handle; monorepo; monorepo_branch; opamrepo; opamrepo_branch }) 54 - |> mem "handle" string ~enc:(fun m -> m.handle) 55 - |> mem "monorepo" string ~enc:(fun m -> encode_url_with_branch m.monorepo m.monorepo_branch) 56 - |> mem "opamrepo" string ~enc:(fun m -> encode_url_with_branch m.opamrepo m.opamrepo_branch) 56 + { handle; name; monorepo; monorepo_branch; opamrepo; opamrepo_branch }) 57 + |> mem "handle" string ~enc:(fun (m : member) -> m.handle) 58 + |> opt_mem "name" string ~enc:(fun (m : member) -> m.name) 59 + |> mem "monorepo" string ~enc:(fun (m : member) -> encode_url_with_branch m.monorepo m.monorepo_branch) 60 + |> mem "opamrepo" string ~enc:(fun (m : member) -> encode_url_with_branch m.opamrepo m.opamrepo_branch) 57 61 |> finish)) 58 62 59 - type registry_info = { r_name : string } 63 + type registry_info = { r_name : string; r_description : string option } 60 64 61 65 let registry_info_codec : registry_info Tomlt.t = 62 66 Tomlt.( 63 67 Table.( 64 - obj (fun r_name -> { r_name }) 68 + obj (fun r_name r_description -> { r_name; r_description }) 65 69 |> mem "name" string ~enc:(fun r -> r.r_name) 70 + |> opt_mem "description" string ~enc:(fun r -> r.r_description) 66 71 |> finish)) 67 72 68 73 let codec : t Tomlt.t = 69 74 Tomlt.( 70 75 Table.( 71 76 obj (fun registry members -> 72 - { name = registry.r_name; members = Option.value ~default:[] members }) 73 - |> mem "registry" registry_info_codec ~enc:(fun t -> { r_name = t.name }) 77 + { name = registry.r_name; description = registry.r_description; members = Option.value ~default:[] members }) 78 + |> mem "registry" registry_info_codec ~enc:(fun t -> { r_name = t.name; r_description = t.description }) 74 79 |> opt_mem "members" (list member_codec) ~enc:(fun t -> 75 80 match t.members with [] -> None | ms -> Some ms) 76 81 |> finish)) 77 82 78 - let empty_registry = { name = "opamverse"; members = [] } 83 + let empty_registry = { name = "opamverse"; description = None; members = [] } 79 84 80 85 let load ~fs path = 81 86 let path_str = Fpath.to_string path in
+2
lib/verse_registry.mli
··· 7 7 8 8 type member = { 9 9 handle : string; (** Tangled handle (e.g., "alice.bsky.social") *) 10 + name : string option; (** Display name (e.g., "Alice Smith") *) 10 11 monorepo : string; (** Git URL of the member's monorepo *) 11 12 monorepo_branch : string option; (** Optional branch for monorepo (from URL#branch) *) 12 13 opamrepo : string; (** Git URL of the member's opam overlay repository *) ··· 19 20 20 21 type t = { 21 22 name : string; (** Registry name *) 23 + description : string option; (** Registry description *) 22 24 members : member list; (** List of registered members *) 23 25 } 24 26 (** The parsed registry contents. *)