jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1open Cmdliner
2
3let setup_logging style_renderer level verbose_http =
4 Fmt_tty.setup_std_outputs ?style_renderer ();
5 Logs.set_reporter (Logs_fmt.reporter ());
6 (* Set global log level for monopam's own logs *)
7 Logs.set_level level;
8 (* Use Requests.Cmd.setup_log_sources to configure HTTP logging separately.
9 This allows -v to show app logs without HTTP protocol details,
10 while --verbose-http enables full HTTP tracing. *)
11 Requests.Cmd.setup_log_sources ~verbose_http level
12
13let logging_term =
14 let verbose_http_term =
15 Term.(
16 const (fun ws -> ws.Requests.Cmd.value)
17 $ Requests.Cmd.verbose_http_term "monopam")
18 in
19 Term.(
20 const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ()
21 $ verbose_http_term)
22
23let package_arg =
24 let doc = "Package name. If not specified, operates on all packages." in
25 Arg.(value & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
26
27(* Load config from opamverse.toml *)
28let load_config env =
29 let fs = Eio.Stdenv.fs env in
30 Monopam.Config.load ~fs ()
31
32let with_config env f =
33 match load_config env with
34 | Ok config -> f config
35 | Error msg ->
36 Fmt.epr "Error loading config: %s@." msg;
37 Fmt.epr "Run 'monopam init' first to create a workspace.@.";
38 `Error (false, "configuration error")
39
40(* Status command *)
41
42let status_cmd =
43 let doc = "Show synchronization status of all packages" in
44 let man =
45 [
46 `S Manpage.s_description;
47 `P
48 "Displays package status showing both local sync state (monorepo vs \
49 checkout) and remote sync state (checkout vs upstream).";
50 `S "STATUS COLUMNS";
51 `P "Each repository shows two sync indicators:";
52 `I ("local:", "Sync between your monorepo (mono/) and checkout (src/)");
53 `I ("remote:", "Sync between your checkout (src/) and upstream git remote");
54 `S "LOCAL SYNC INDICATORS";
55 `I ("local:=", "Monorepo and checkout are in sync");
56 `I
57 ( "local:+N",
58 "Monorepo has N commits not yet in checkout (run $(b,monopam sync))"
59 );
60 `I
61 ( "local:-N",
62 "Checkout has N commits not yet in monorepo (run $(b,monopam sync))"
63 );
64 `I ("local:sync", "Trees differ, needs sync (run $(b,monopam sync))");
65 `S "REMOTE SYNC INDICATORS";
66 `I ("remote:=", "Checkout and upstream remote are in sync");
67 `I
68 ( "remote:+N",
69 "Checkout has N commits to push (run $(b,monopam sync --remote))" );
70 `I ("remote:-N", "Upstream has N commits to pull (run $(b,monopam sync))");
71 `I ("remote:+N/-M", "Diverged: checkout +N ahead, upstream +M ahead");
72 `S "FORK ANALYSIS";
73 `P "If tracking other members via verse, shows fork comparison:";
74 `I ("+N", "They have N commits you don't have");
75 `I ("-N", "You have N commits they don't have");
76 `I ("=", "Same commit or same URL");
77 `I ("~", "Not in your workspace (use --all to list)");
78 `S "NEXT STEPS";
79 `P "Based on the status output:";
80 `I ("local:+N or local:-N", "Run $(b,monopam sync) to synchronize");
81 `I ("remote:-N", "Run $(b,monopam sync) to pull upstream changes");
82 `I ("remote:+N", "Run $(b,monopam sync --remote) to push to upstream");
83 ]
84 in
85 let info = Cmd.info "status" ~doc ~man in
86 let all_arg =
87 let doc = "Show all repos including those not in your workspace." in
88 Arg.(value & flag & info [ "all"; "a" ] ~doc)
89 in
90 let run show_all () =
91 Eio_main.run @@ fun env ->
92 with_config env @@ fun config ->
93 let fs = Eio.Stdenv.fs env in
94 let proc = Eio.Stdenv.process_mgr env in
95 match Monopam.status ~proc ~fs ~config () with
96 | Ok statuses ->
97 (* Load sources.toml for origin indicators *)
98 let sources =
99 let mono_path = Monopam.Config.Paths.monorepo config in
100 let sources_path = Fpath.(mono_path / "sources.toml") in
101 match Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with
102 | Ok s -> Some s
103 | Error _ -> None
104 in
105 Fmt.pr "%a" (Monopam.Status.pp_summary ?sources) statuses;
106 (* Check for unregistered opam files *)
107 (match Monopam.discover_packages ~fs ~config () with
108 | Ok pkgs ->
109 let unregistered =
110 Monopam.find_unregistered_opam_files ~fs ~config pkgs
111 in
112 if unregistered <> [] then begin
113 (* Get local handle abbreviation *)
114 let handle_abbrev =
115 match Monopam.Verse_config.load ~fs () with
116 | Ok vc -> (
117 let h = Monopam.Verse_config.handle vc in
118 match String.split_on_char '.' h with
119 | first :: _ ->
120 if String.length first <= 4 then first
121 else String.sub first 0 3
122 | [] -> h)
123 | Error _ -> "local"
124 in
125 Fmt.pr "%a %a\n"
126 Fmt.(styled `Bold string)
127 "Unregistered:"
128 Fmt.(styled `Faint int)
129 (List.length unregistered);
130 List.iter
131 (fun (_r, p) ->
132 Fmt.pr " %-22s %a\n" p
133 Fmt.(styled `Faint (fun ppf s -> pf ppf "%s~" s))
134 handle_abbrev)
135 unregistered
136 end
137 | Error _ -> ());
138 (* Fork analysis *)
139 (match Monopam.Verse_config.load ~fs () with
140 | Error _ -> ()
141 | Ok verse_config ->
142 let forks =
143 Monopam.Forks.compute ~proc ~fs ~verse_config
144 ~monopam_config:config ()
145 in
146 if forks.repos <> [] then
147 Fmt.pr "%a" (Monopam.Forks.pp_summary' ~show_all) forks);
148 `Ok ()
149 | Error e ->
150 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
151 `Error (false, "status failed")
152 in
153 Cmd.v info Term.(ret (const run $ all_arg $ logging_term))
154
155(* Sync command *)
156
157let sync_cmd =
158 let doc = "Synchronize monorepo with upstream repositories" in
159 let man =
160 [
161 `S Manpage.s_description;
162 `P
163 "$(b,This is the primary command for all workflows.) It performs both \
164 push and pull operations in the correct order to fully synchronize \
165 your monorepo with upstream repositories.";
166 `S "COMMON USAGE";
167 `I ("monopam sync", "Full sync: push local changes + pull remote changes");
168 `I ("monopam sync --remote", "Full sync + push to upstream git remotes");
169 `I ("monopam sync eio", "Sync only the eio repository");
170 `I ("monopam sync --skip-push", "Pull only: skip exporting local changes");
171 `I ("monopam sync --skip-pull", "Push only: skip fetching remote changes");
172 `S Manpage.s_examples;
173 `P "After making changes:";
174 `Pre
175 "cd mono\n\
176 # ... edit files ...\n\
177 git add -A && git commit -m \"Add feature\"\n\
178 monopam sync --remote # sync and push upstream";
179 `P "Pull latest from all upstreams (no local changes to export):";
180 `Pre "monopam sync --skip-push";
181 `P "Export local changes for review without pulling:";
182 `Pre "monopam sync --skip-pull";
183 `S "PHASES";
184 `P "The sync command executes these phases in order:";
185 `I ("1. Validate", "Abort if the monorepo has uncommitted changes");
186 `I
187 ( "2. Push",
188 "Export monorepo changes to checkouts (parallel) [--skip-push skips]"
189 );
190 `I ("3. Fetch", "Clone/fetch from remotes (parallel) [--skip-pull skips]");
191 `I ("4. Merge", "Fast-forward merge checkouts [--skip-pull skips]");
192 `I ("5. Subtree", "Pull subtrees into monorepo [--skip-pull skips]");
193 `I ("6. Finalize", "Update README.md, CLAUDE.md, and dune-project");
194 `I ("7. Remote", "Push to upstream remotes if --remote (parallel)");
195 `S "SKIP OPTIONS";
196 `I
197 ( "--skip-push",
198 "Skip exporting monorepo changes to checkouts. Use when you know you \
199 have no local changes to export." );
200 `I
201 ( "--skip-pull",
202 "Skip fetching and pulling from remotes. Use when you only want to \
203 export local changes without pulling remote updates." );
204 `S "PREREQUISITES";
205 `P "Before running sync:";
206 `I
207 ( "-",
208 "Commit all changes in the monorepo: $(b,git add -A && git commit)" );
209 `I ("-", "For --remote: ensure git credentials/SSH keys are configured");
210 ]
211 in
212 let info = Cmd.info "sync" ~doc ~man in
213 let remote_arg =
214 let doc =
215 "Also push each checkout to its upstream git remote after syncing."
216 in
217 Arg.(value & flag & info [ "remote" ] ~doc)
218 in
219 let skip_push_arg =
220 let doc = "Skip exporting monorepo changes to checkouts." in
221 Arg.(value & flag & info [ "skip-push" ] ~doc)
222 in
223 let skip_pull_arg =
224 let doc = "Skip fetching and pulling from remotes." in
225 Arg.(value & flag & info [ "skip-pull" ] ~doc)
226 in
227 let run package remote skip_push skip_pull () =
228 Eio_main.run @@ fun env ->
229 with_config env @@ fun config ->
230 let fs = Eio.Stdenv.fs env in
231 let proc = Eio.Stdenv.process_mgr env in
232 match
233 Monopam.sync ~proc ~fs ~config ?package ~remote ~skip_push ~skip_pull ()
234 with
235 | Ok summary ->
236 if summary.errors = [] then `Ok ()
237 else begin
238 Fmt.epr "Sync completed with %d errors.@."
239 (List.length summary.errors);
240 `Ok ()
241 end
242 | Error e ->
243 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
244 `Error (false, "sync failed")
245 in
246 Cmd.v info
247 Term.(
248 ret
249 (const run $ package_arg $ remote_arg $ skip_push_arg $ skip_pull_arg
250 $ logging_term))
251
252(* Changes command *)
253
254let changes_cmd =
255 let doc = "Generate changelog entries using Claude AI" in
256 let man =
257 [
258 `S Manpage.s_description;
259 `P "Analyzes git commit history and generates user-facing changelogs.";
260 `P
261 "By default, generates weekly entries. Use --daily to generate daily \
262 entries instead.";
263 `P "Changes are stored in the .changes directory at the monorepo root:";
264 `I (".changes/<repo>.json", "Weekly changelog entries");
265 `I (".changes/<repo>-daily.json", "Daily changelog entries");
266 `I
267 ( ".changes/YYYYMMDD.json",
268 "Aggregated daily entries (default with --daily)" );
269 `P "Also generates aggregated markdown files at the monorepo root:";
270 `I ("CHANGES.md", "Aggregated weekly changelog");
271 `I ("DAILY-CHANGES.md", "Aggregated daily changelog");
272 `P "Each entry includes:";
273 `I ("summary", "A one-line summary of the most important change");
274 `I ("changes", "Up to 5 bullet points describing user-facing changes");
275 `I ("commit_range", "The range of commits included in the entry");
276 `P
277 "Claude AI analyzes commits and generates changelog text focused on \
278 user-facing changes. Internal refactoring, CI tweaks, and typo fixes \
279 are automatically filtered out.";
280 `P
281 "Repositories with no user-facing changes will have blank entries \
282 (empty summary and changes) rather than 'no changes' text.";
283 `P
284 "When using --daily, an aggregated JSON file is generated by default \
285 for the poe Zulip bot broadcasting system. Use --no-aggregate to \
286 skip.";
287 `P
288 "If a per-repo-per-day JSON file already exists for a past day, that \
289 repo is skipped for that day to avoid redundant Claude API calls.";
290 ]
291 in
292 let info = Cmd.info "changes" ~doc ~man in
293 let daily =
294 let doc = "Generate daily changelog entries instead of weekly" in
295 Arg.(value & flag & info [ "daily"; "d" ] ~doc)
296 in
297 let weeks =
298 let doc =
299 "Number of past weeks to analyze (default: 1, current week only). \
300 Ignored if --daily is set."
301 in
302 Arg.(value & opt int 1 & info [ "w"; "weeks" ] ~doc)
303 in
304 let days =
305 let doc =
306 "Number of past days to analyze when using --daily (default: 1, today \
307 only)"
308 in
309 Arg.(value & opt int 1 & info [ "days" ] ~doc)
310 in
311 let history =
312 let doc =
313 "Number of recent entries to include in aggregated markdown (default: 12 \
314 for weekly, 30 for daily)"
315 in
316 Arg.(value & opt int 12 & info [ "history" ] ~doc)
317 in
318 let dry_run =
319 let doc = "Preview changes without writing files" in
320 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
321 in
322 let no_aggregate =
323 let doc =
324 "Skip generating .changes/YYYYMMDD.json aggregated file (--daily \
325 generates it by default)"
326 in
327 Arg.(value & flag & info [ "no-aggregate" ] ~doc)
328 in
329 let run package daily weeks days history dry_run no_aggregate () =
330 Eio_main.run @@ fun env ->
331 with_config env @@ fun config ->
332 let fs = Eio.Stdenv.fs env in
333 let proc = Eio.Stdenv.process_mgr env in
334 let clock = Eio.Stdenv.clock env in
335 let result =
336 if daily then begin
337 (* Use 30 as default history for daily if not explicitly set *)
338 let history = if history = 12 then 30 else history in
339 (* Aggregate by default for daily, unless --no-aggregate is passed *)
340 let aggregate = not no_aggregate in
341 Monopam.changes_daily ~proc ~fs ~config ~clock ?package ~days ~history
342 ~dry_run ~aggregate ()
343 end
344 else
345 Monopam.changes ~proc ~fs ~config ~clock ?package ~weeks ~history
346 ~dry_run ()
347 in
348 match result with
349 | Ok () ->
350 if dry_run then Fmt.pr "Dry run complete.@."
351 else if daily then Fmt.pr "Daily changelog updated.@."
352 else Fmt.pr "Weekly changelog updated.@.";
353 `Ok ()
354 | Error e ->
355 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
356 `Error (false, "changes failed")
357 in
358 Cmd.v info
359 Term.(
360 ret
361 (const run $ package_arg $ daily $ weeks $ days $ history $ dry_run
362 $ no_aggregate $ logging_term))
363
364(* Opam commands *)
365
366let opam_sync_cmd =
367 let doc = "Sync opam files from monorepo to opam-repo" in
368 let man =
369 [
370 `S Manpage.s_description;
371 `P
372 "Copies .opam files from monorepo subtrees to the opam-repo overlay. \
373 This ensures your opam overlay reflects any changes you made to .opam \
374 files in the monorepo.";
375 `S "HOW IT WORKS";
376 `P "For each package in your opam overlay:";
377 `I
378 ( "1.",
379 "Reads the .opam file from the monorepo subtree (e.g., \
380 mono/eio/eio.opam)" );
381 `I
382 ( "2.",
383 "Compares with the opam-repo version (e.g., \
384 opam-repo/packages/eio/eio.dev/opam)" );
385 `I ("3.", "If different, copies monorepo → opam-repo");
386 `I ("4.", "Stages and commits changes in opam-repo");
387 `S "PRECEDENCE";
388 `P "Local always wins: the monorepo version is the source of truth.";
389 `S Manpage.s_examples;
390 `P "Sync all packages:";
391 `Pre "monopam opam sync";
392 `P "Sync a specific package:";
393 `Pre "monopam opam sync eio";
394 ]
395 in
396 let info = Cmd.info "sync" ~doc ~man in
397 let run package () =
398 Eio_main.run @@ fun env ->
399 with_config env @@ fun config ->
400 let fs = Eio.Stdenv.fs env in
401 let proc = Eio.Stdenv.process_mgr env in
402 match Monopam.sync_opam_files ~proc ~fs ~config ?package () with
403 | Ok result ->
404 if result.synced = [] then Fmt.pr "All opam files already in sync.@."
405 else Fmt.pr "Synced %d opam files.@." (List.length result.synced);
406 `Ok ()
407 | Error e ->
408 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
409 `Error (false, "opam sync failed")
410 in
411 Cmd.v info Term.(ret (const run $ package_arg $ logging_term))
412
413let opam_cmd =
414 let doc = "Opam metadata management" in
415 let man =
416 [
417 `S Manpage.s_description;
418 `P
419 "Commands for managing opam metadata between your monorepo and the \
420 opam-repo overlay.";
421 `S "COMMANDS";
422 `I ("sync", "Sync .opam files from monorepo subtrees to opam-repo");
423 ]
424 in
425 let info = Cmd.info "opam" ~doc ~man in
426 Cmd.group info [ opam_sync_cmd ]
427
428(* Init command - initialize a new monopam workspace *)
429
430let init_root_arg =
431 let doc =
432 "Path to workspace root directory. Defaults to current directory."
433 in
434 Arg.(
435 value
436 & opt (some (conv (Fpath.of_string, Fpath.pp))) None
437 & info [ "root" ] ~docv:"PATH" ~doc)
438
439let init_handle_arg =
440 let doc = "Your handle (e.g., alice.bsky.social)" in
441 Arg.(
442 required & opt (some string) None & info [ "handle" ] ~docv:"HANDLE" ~doc)
443
444let init_cmd =
445 let doc = "Initialize a new monopam workspace" in
446 let man =
447 [
448 `S Manpage.s_description;
449 `P
450 "Creates a new monopam workspace for monorepo development. The workspace \
451 lets you manage your own monorepo and optionally browse and track other \
452 developers' monorepos.";
453 `S "WORKSPACE STRUCTURE";
454 `P
455 "The init command creates the following directory structure at the \
456 workspace root:";
457 `I ("mono/", "Your monorepo - use with standard monopam commands");
458 `I ("src/", "Your source checkouts - individual git repos");
459 `I ("verse/", "Other users' monorepos, organized by handle");
460 `P "Configuration and data are stored in XDG directories:";
461 `I ("~/.config/monopam/opamverse.toml", "Workspace configuration");
462 `I
463 ( "~/.local/share/monopam/opamverse-registry/",
464 "Git clone of the community registry" );
465 `S "CONFIGURATION FILE";
466 `P "The opamverse.toml file has the following structure:";
467 `Pre
468 "[workspace]\n\
469 root = \"/path/to/workspace\"\n\
470 default_branch = \"main\"\n\n\
471 [paths]\n\
472 mono = \"mono\"\n\
473 src = \"src\"\n\
474 verse = \"verse\"\n\n\
475 [identity]\n\
476 handle = \"yourname.bsky.social\"";
477 `S "HANDLE VALIDATION";
478 `P
479 "The handle you provide identifies you in the community. \
480 It should be a valid domain name (e.g., yourname.bsky.social or \
481 your-domain.com).";
482 `S "REGISTRY";
483 `P
484 "The registry is a git repository containing an opamverse.toml file \
485 that lists community members and their monorepo URLs. The default \
486 registry is at: https://tangled.org/eeg.cl.cam.ac.uk/opamverse";
487 `S Manpage.s_examples;
488 `P "Initialize a workspace in the current directory:";
489 `Pre "monopam init --handle alice.bsky.social";
490 `P "Initialize with explicit root path:";
491 `Pre "monopam init --root ~/my-workspace --handle alice.bsky.social";
492 ]
493 in
494 let info = Cmd.info "init" ~doc ~man in
495 let run root handle () =
496 Eio_main.run @@ fun env ->
497 let fs = Eio.Stdenv.fs env in
498 let proc = Eio.Stdenv.process_mgr env in
499 let root =
500 match root with
501 | Some r -> r
502 | None -> (
503 let cwd_path = Eio.Stdenv.cwd env in
504 let _, cwd_str = (cwd_path :> _ Eio.Path.t) in
505 match Fpath.of_string cwd_str with
506 | Ok p -> p
507 | Error (`Msg _) -> Fpath.v ".")
508 in
509 match Monopam.Verse.init ~proc ~fs ~root ~handle () with
510 | Ok () ->
511 Fmt.pr "Workspace initialized at %a@." Fpath.pp root;
512 `Ok ()
513 | Error e ->
514 Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e;
515 `Error (false, "init failed")
516 in
517 Cmd.v info
518 Term.(ret (const run $ init_root_arg $ init_handle_arg $ logging_term))
519
520(* Verse commands *)
521
522(* Helper to load verse config from XDG *)
523let with_verse_config env f =
524 let fs = Eio.Stdenv.fs env in
525 match Monopam.Verse_config.load ~fs () with
526 | Ok config -> f config
527 | Error msg ->
528 Fmt.epr "Error loading opamverse config: %s@." msg;
529 Fmt.epr "Run 'monopam init' to create a workspace.@.";
530 `Error (false, "configuration error")
531
532let verse_members_cmd =
533 let doc = "List registry members" in
534 let man =
535 [
536 `S Manpage.s_description;
537 `P
538 "Lists all members registered in the opamverse community registry. \
539 This shows everyone who has published their monorepo for \
540 collaboration.";
541 `P
542 "The registry is automatically pulled (git pull) when running this \
543 command to ensure you see the latest members.";
544 `S "REGISTRY FORMAT";
545 `P
546 "The registry is a git repository containing an opamverse.toml file \
547 with the following structure:";
548 `Pre
549 "[registry]\n\
550 name = \"tangled-community\"\n\n\
551 [[members]]\n\
552 handle = \"alice.bsky.social\"\n\
553 monorepo = \"https://github.com/alice/mono\"\n\n\
554 [[members]]\n\
555 handle = \"bob.example.com\"\n\
556 monorepo = \"https://github.com/bob/mono\"";
557 `S "OUTPUT";
558 `P "Each line shows a member's handle and their monorepo git URL:";
559 `Pre
560 "alice.bsky.social -> https://github.com/alice/mono\n\
561 bob.example.com -> https://github.com/bob/mono";
562 `S "ADDING YOURSELF";
563 `P
564 "To add yourself to the registry, submit a pull request to the \
565 registry repository adding your entry to opamverse.toml.";
566 ]
567 in
568 let info = Cmd.info "members" ~doc ~man in
569 let run () =
570 Eio_main.run @@ fun env ->
571 with_verse_config env @@ fun config ->
572 let fs = Eio.Stdenv.fs env in
573 let proc = Eio.Stdenv.process_mgr env in
574 match Monopam.Verse.members ~proc ~fs ~config () with
575 | Ok members ->
576 Fmt.pr "@[<v>%a@]@."
577 Fmt.(list ~sep:cut Monopam.Verse_registry.pp_member)
578 members;
579 `Ok ()
580 | Error e ->
581 Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e;
582 `Error (false, "members failed")
583 in
584 Cmd.v info Term.(ret (const run $ logging_term))
585
586let verse_fork_cmd =
587 let doc = "Fork a package from a verse member's repository" in
588 let man =
589 [
590 `S Manpage.s_description;
591 `P
592 "Fork a package from a verse member's opam repository into your workspace. \
593 This creates entries in your opam-repo with your fork URL as the dev-repo.";
594 `P
595 "The command finds all packages sharing the same git repository and forks \
596 them together. For example, if you fork 'cohttp', it will also fork \
597 cohttp-eio, cohttp-lwt, etc.";
598 `S "WHAT IT DOES";
599 `P "For the specified package:";
600 `I ("1.", "Looks up the package in <handle>'s opam-repo (verse/<handle>-opam/)");
601 `I ("2.", "Finds all packages from the same git repository");
602 `I ("3.", "Creates entries in your opam-repo with your fork URL");
603 `P "After forking:";
604 `I ("1.", "Commit the new opam files: $(b,cd opam-repo && git add -A && git commit)");
605 `I ("2.", "Run $(b,monopam sync) to pull the fork into your monorepo");
606 `S "PREREQUISITES";
607 `P "Before forking:";
608 `I ("-", "Run $(b,monopam verse pull <handle>) to sync the member's opam-repo");
609 `I ("-", "Create a fork of the repository on GitHub/GitLab/etc.");
610 `S Manpage.s_examples;
611 `P "Fork a package from a verse member:";
612 `Pre "monopam fork http2 --from sadiq.bsky.social --url git@github.com:me/http2.git";
613 `P "Preview what would be forked (multi-package repos):";
614 `Pre "monopam fork cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git --dry-run\n\
615 Would fork 5 packages from cohttp repository:\n\
616 \ cohttp\n\
617 \ cohttp-eio\n\
618 \ cohttp-lwt\n\
619 \ cohttp-async\n\
620 \ cohttp-mirage";
621 `P "After forking, commit and sync:";
622 `Pre "cd opam-repo && git add -A && git commit -m \"Fork cohttp\"\n\
623 monopam sync";
624 `S "ERRORS";
625 `P
626 "The command will fail if any package from the source repo already exists \
627 in your opam-repo. Remove conflicting packages first with:";
628 `Pre "rm -rf opam-repo/packages/<package-name>";
629 ]
630 in
631 let info = Cmd.info "fork" ~doc ~man in
632 let package_arg =
633 let doc = "Package name to fork (e.g., 'cohttp', 'eio')" in
634 Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
635 in
636 let from_arg =
637 let doc = "Verse member handle to fork from (e.g., 'avsm.bsky.social')" in
638 Arg.(required & opt (some string) None & info [ "from" ] ~docv:"HANDLE" ~doc)
639 in
640 let url_arg =
641 let doc = "Git URL of your fork (e.g., 'git@github.com:you/repo.git')" in
642 Arg.(required & opt (some string) None & info [ "url" ] ~docv:"URL" ~doc)
643 in
644 let dry_run_arg =
645 let doc = "Show what would be forked without making changes" in
646 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
647 in
648 let run package handle fork_url dry_run () =
649 Eio_main.run @@ fun env ->
650 with_verse_config env @@ fun config ->
651 let fs = Eio.Stdenv.fs env in
652 let proc = Eio.Stdenv.process_mgr env in
653 match Monopam.Verse.fork ~proc ~fs ~config ~handle ~package ~fork_url ~dry_run () with
654 | Ok result ->
655 if dry_run then begin
656 Fmt.pr "Would fork %d package(s) from %s:@."
657 (List.length result.packages_forked) result.source_handle;
658 List.iter (fun p -> Fmt.pr " %s@." p) result.packages_forked
659 end else begin
660 (* Update sources.toml with fork information *)
661 let mono_path = Monopam.Verse_config.mono_path config in
662 let sources_path = Fpath.(mono_path / "sources.toml") in
663 let sources =
664 match Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with
665 | Ok s -> s
666 | Error _ -> Monopam.Sources_registry.empty
667 in
668 let entry = Monopam.Sources_registry.{
669 url = result.fork_url;
670 upstream = Some result.upstream_url;
671 branch = None;
672 reason = Some (Fmt.str "Forked from %s" result.source_handle);
673 origin = Some Join; (* Forked from verse = joined *)
674 } in
675 let sources = Monopam.Sources_registry.add sources ~subtree:result.subtree_name entry in
676 (match Monopam.Sources_registry.save ~fs:(fs :> _ Eio.Path.t) sources_path sources with
677 | Ok () ->
678 Fmt.pr "Updated sources.toml with fork entry for %s@." result.subtree_name
679 | Error msg ->
680 Fmt.epr "Warning: Failed to update sources.toml: %s@." msg);
681 Fmt.pr "Forked %d package(s): %a@."
682 (List.length result.packages_forked)
683 Fmt.(list ~sep:(any ", ") string) result.packages_forked;
684 Fmt.pr "@.Next steps:@.";
685 Fmt.pr " 1. cd opam-repo && git add -A && git commit -m \"Fork ...\"@.";
686 Fmt.pr " 2. monopam sync@."
687 end;
688 `Ok ()
689 | Error e ->
690 Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e;
691 `Error (false, "fork failed")
692 in
693 Cmd.v info Term.(ret (const run $ package_arg $ from_arg $ url_arg $ dry_run_arg $ logging_term))
694
695let verse_cmd =
696 let doc = "Verse member operations" in
697 let man =
698 [
699 `S Manpage.s_description;
700 `P
701 "Commands for working with verse community members. The verse system \
702 enables federated collaboration across multiple developers' monorepos.";
703 `P
704 "Members are identified by handles - typically domain names like \
705 'yourname.bsky.social' or 'your-domain.com'.";
706 `S "NOTE";
707 `P
708 "The $(b,monopam init) command creates your workspace and \
709 $(b,monopam sync) automatically syncs verse members. These commands \
710 are for additional verse-specific operations.";
711 `S "COMMANDS";
712 `I ("members", "List all members in the community registry");
713 `I ("fork <pkg> --from <handle> --url <url>", "Fork a package from a verse member");
714 `S Manpage.s_examples;
715 `P "List all community members:";
716 `Pre "monopam verse members";
717 `P "Fork a package from another member:";
718 `Pre "monopam verse fork cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git";
719 ]
720 in
721 let info = Cmd.info "verse" ~doc ~man in
722 Cmd.group info
723 [
724 verse_members_cmd;
725 verse_fork_cmd;
726 ]
727
728(* Diff command *)
729
730let diff_cmd =
731 let doc = "Show diffs from verse members for repos needing attention" in
732 let man =
733 [
734 `S Manpage.s_description;
735 `P
736 "Shows commit diffs from verse members for repositories where they have \
737 commits you don't have. This helps you see what changes are available \
738 from collaborators.";
739 `S "OUTPUT";
740 `P "First shows the verse status summary, then for each repository where \
741 a verse member is ahead:";
742 `I ("Repository name", "With the handle and relationship");
743 `I ("Commits", "List of commits they have that you don't (max 20)");
744 `S "RELATIONSHIPS";
745 `I ("+N", "They have N commits you don't have");
746 `I ("+N/-M", "Diverged: they have N new commits, you have M new commits");
747 `S "CACHING";
748 `P "Remote fetches are cached for 1 hour to improve performance. \
749 Use $(b,--refresh) to force fresh fetches from all remotes.";
750 `S Manpage.s_examples;
751 `P "Show diffs for all repos needing attention (uses cache):";
752 `Pre "monopam diff";
753 `P "Show diff for a specific repository:";
754 `Pre "monopam diff ocaml-eio";
755 `P "Show patches for all commits:";
756 `Pre "monopam diff -p";
757 `P "Show patch for a specific commit (from diff output):";
758 `Pre "monopam diff abc1234";
759 `P "Force fresh fetches from all remotes:";
760 `Pre "monopam diff --refresh";
761 ]
762 in
763 let info = Cmd.info "diff" ~doc ~man in
764 let arg =
765 let doc = "Repository name or commit SHA. If a 7+ character hex string, shows \
766 the patch for that commit. Otherwise filters to that repository. \
767 If not specified, shows diffs for all repos needing attention." in
768 Arg.(value & pos 0 (some string) None & info [] ~docv:"REPO|SHA" ~doc)
769 in
770 let refresh_arg =
771 let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in
772 Arg.(value & flag & info [ "refresh"; "r" ] ~doc)
773 in
774 let patch_arg =
775 let doc = "Show full patch content for each commit." in
776 Arg.(value & flag & info [ "patch"; "p" ] ~doc)
777 in
778 let run arg refresh patch () =
779 Eio_main.run @@ fun env ->
780 with_config env @@ fun config ->
781 with_verse_config env @@ fun verse_config ->
782 let fs = Eio.Stdenv.fs env in
783 let proc = Eio.Stdenv.process_mgr env in
784 (* Check if arg looks like a commit SHA *)
785 match arg with
786 | Some sha when Monopam.is_commit_sha sha ->
787 (* Show patch for specific commit *)
788 (match Monopam.diff_show_commit ~proc ~fs ~config ~verse_config ~sha ~refresh () with
789 | Some info ->
790 let short_hash = String.sub info.commit_hash 0 (min 7 (String.length info.commit_hash)) in
791 Fmt.pr "%a %s (%s/%s)@.@.%s@."
792 Fmt.(styled `Yellow string) short_hash
793 info.commit_subject
794 info.commit_repo info.commit_handle
795 info.commit_patch;
796 `Ok ()
797 | None ->
798 Fmt.epr "Commit %s not found in any verse diff@." sha;
799 `Error (false, "commit not found"))
800 | repo ->
801 let result = Monopam.diff ~proc ~fs ~config ~verse_config ?repo ~refresh ~patch () in
802 Fmt.pr "%a" (Monopam.pp_diff_result ~show_patch:patch) result;
803 `Ok ()
804 in
805 Cmd.v info Term.(ret (const run $ arg $ refresh_arg $ patch_arg $ logging_term))
806
807(* Pull command - pull from verse members *)
808
809let pull_cmd =
810 let doc = "Pull commits from a verse member's forks" in
811 let man =
812 [
813 `S Manpage.s_description;
814 `P
815 "Pulls commits from a verse member's forks into your local checkouts. \
816 This merges their changes into your checkout branches, making them \
817 ready to be synced to the monorepo via $(b,monopam sync).";
818 `S "WORKFLOW";
819 `P "The typical workflow for incorporating changes from collaborators:";
820 `I ("1.", "$(b,monopam diff) - See what changes are available");
821 `I ("2.", "$(b,monopam pull <handle>) - Pull changes from a collaborator");
822 `I ("3.", "$(b,monopam sync) - Sync changes into your monorepo");
823 `S "MERGING BEHAVIOR";
824 `P "When you're behind (they have commits you don't):";
825 `I ("Fast-forward", "If your branch has no new commits, a fast-forward merge is used.");
826 `P "When branches have diverged (both have new commits):";
827 `I ("Merge commit", "A merge commit is created to combine the histories.");
828 `S Manpage.s_examples;
829 `P "Pull all changes from a verse member:";
830 `Pre "monopam pull avsm.bsky.social";
831 `P "Pull changes for a specific repository:";
832 `Pre "monopam pull avsm.bsky.social eio";
833 `P "Force fresh fetches before pulling:";
834 `Pre "monopam pull --refresh avsm.bsky.social";
835 ]
836 in
837 let info = Cmd.info "pull" ~doc ~man in
838 let handle_arg =
839 let doc = "The verse member handle to pull from (e.g., avsm.bsky.social)." in
840 Arg.(required & pos 0 (some string) None & info [] ~docv:"HANDLE" ~doc)
841 in
842 let repo_arg =
843 let doc = "Optional repository to pull from. If not specified, pulls from all \
844 repositories where the handle has commits you don't have." in
845 Arg.(value & pos 1 (some string) None & info [] ~docv:"REPO" ~doc)
846 in
847 let refresh_arg =
848 let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in
849 Arg.(value & flag & info [ "refresh"; "r" ] ~doc)
850 in
851 let run handle repo refresh () =
852 Eio_main.run @@ fun env ->
853 with_config env @@ fun config ->
854 with_verse_config env @@ fun verse_config ->
855 let fs = Eio.Stdenv.fs env in
856 let proc = Eio.Stdenv.process_mgr env in
857 match Monopam.pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo ~refresh () with
858 | Ok result ->
859 Fmt.pr "%a" Monopam.pp_handle_pull_result result;
860 if result.repos_failed <> [] then
861 `Error (false, "some repos failed to pull")
862 else if result.repos_pulled = [] then begin
863 Fmt.pr "Nothing to pull from %s@." handle;
864 `Ok ()
865 end
866 else begin
867 Fmt.pr "@.Run $(b,monopam sync) to merge changes into your monorepo.@.";
868 `Ok ()
869 end
870 | Error e ->
871 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
872 `Error (false, "pull failed")
873 in
874 Cmd.v info Term.(ret (const run $ handle_arg $ repo_arg $ refresh_arg $ logging_term))
875
876(* Cherrypick command *)
877
878let cherrypick_cmd =
879 let doc = "Cherry-pick a specific commit from a verse member's fork" in
880 let man =
881 [
882 `S Manpage.s_description;
883 `P
884 "Applies a specific commit from a verse member's fork to your local checkout. \
885 Use $(b,monopam diff) to see available commits and their hashes.";
886 `S "WORKFLOW";
887 `P "The typical workflow for cherry-picking specific commits:";
888 `I ("1.", "$(b,monopam diff) - See available commits with their hashes");
889 `I ("2.", "$(b,monopam diff <sha>) - View the full patch for a commit");
890 `I ("3.", "$(b,monopam cherrypick <sha>) - Apply that commit");
891 `I ("4.", "$(b,monopam sync) - Sync changes into your monorepo");
892 `S Manpage.s_examples;
893 `P "Cherry-pick a commit:";
894 `Pre "monopam cherrypick abc1234";
895 `P "View a commit's patch first, then cherry-pick:";
896 `Pre "monopam diff abc1234";
897 `Pre "monopam cherrypick abc1234";
898 ]
899 in
900 let info = Cmd.info "cherrypick" ~doc ~man in
901 let sha_arg =
902 let doc = "The commit SHA (or prefix) to cherry-pick. Must be at least 7 characters." in
903 Arg.(required & pos 0 (some string) None & info [] ~docv:"SHA" ~doc)
904 in
905 let refresh_arg =
906 let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in
907 Arg.(value & flag & info [ "refresh"; "r" ] ~doc)
908 in
909 let run sha refresh () =
910 Eio_main.run @@ fun env ->
911 with_config env @@ fun config ->
912 with_verse_config env @@ fun verse_config ->
913 let fs = Eio.Stdenv.fs env in
914 let proc = Eio.Stdenv.process_mgr env in
915 match Monopam.cherrypick ~proc ~fs ~config ~verse_config ~sha ~refresh () with
916 | Ok result ->
917 Fmt.pr "%a" Monopam.pp_cherrypick_result result;
918 Fmt.pr "Run $(b,monopam sync) to merge changes into your monorepo.@.";
919 `Ok ()
920 | Error e ->
921 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
922 `Error (false, "cherrypick failed")
923 in
924 Cmd.v info Term.(ret (const run $ sha_arg $ refresh_arg $ logging_term))
925
926(* Doctor command *)
927
928let doctor_cmd =
929 let doc = "Claude-powered workspace health analysis" in
930 let man =
931 [
932 `S Manpage.s_description;
933 `P
934 "Analyzes your workspace health and provides actionable \
935 recommendations. Uses Claude AI to analyze commits from verse \
936 collaborators, categorizing them by type, priority, and risk level.";
937 `S "WHAT IT DOES";
938 `P "The doctor command:";
939 `I ("1.", "Syncs the workspace (unless $(b,--no-sync) is specified)");
940 `I ("2.", "Checks local sync status (monorepo vs checkouts)");
941 `I ("3.", "Checks remote sync status (checkouts vs upstream)");
942 `I ("4.", "Analyzes fork relationships with verse members");
943 `I ("5.", "Uses Claude to categorize and prioritize their commits");
944 `I ("6.", "Generates actionable recommendations");
945 `P
946 "The status output from $(b,monopam status) is automatically included \
947 in the prompt sent to Claude, so Claude doesn't need to run it \
948 separately.";
949 `S "OUTPUT FORMATS";
950 `P "By default, outputs human-readable text with colors.";
951 `P "Use $(b,--json) for JSON output suitable for tooling.";
952 `S Manpage.s_examples;
953 `P "Run full analysis (syncs first):";
954 `Pre "monopam doctor";
955 `P "Run analysis without syncing first:";
956 `Pre "monopam doctor --no-sync";
957 `P "Analyze a specific repo:";
958 `Pre "monopam doctor eio";
959 `P "Output as JSON:";
960 `Pre "monopam doctor --json";
961 ]
962 in
963 let info = Cmd.info "doctor" ~doc ~man in
964 let json_arg =
965 let doc = "Output as JSON instead of formatted text." in
966 Arg.(value & flag & info [ "json" ] ~doc)
967 in
968 let no_sync_arg =
969 let doc = "Skip running sync before analysis." in
970 Arg.(value & flag & info [ "no-sync" ] ~doc)
971 in
972 let run package json no_sync () =
973 Eio_main.run @@ fun env ->
974 with_config env @@ fun config ->
975 with_verse_config env @@ fun verse_config ->
976 let fs = Eio.Stdenv.fs env in
977 let proc = Eio.Stdenv.process_mgr env in
978 let clock = Eio.Stdenv.clock env in
979 (* Run sync before analysis unless --no-sync is specified *)
980 if not no_sync then begin
981 Fmt.pr "Syncing workspace before analysis...@.";
982 match Monopam.sync ~proc ~fs ~config ?package () with
983 | Ok _summary -> ()
984 | Error e ->
985 Fmt.pr "Warning: sync failed: %a@." Monopam.pp_error_with_hint e;
986 Fmt.pr "Continuing with analysis...@."
987 end;
988 let report =
989 Monopam.Doctor.analyze ~proc ~fs ~config ~verse_config ~clock ?package
990 ~no_sync ()
991 in
992 if json then print_endline (Monopam.Doctor.to_json report)
993 else Fmt.pr "%a@." Monopam.Doctor.pp_report report;
994 `Ok ()
995 in
996 Cmd.v info
997 Term.(ret (const run $ package_arg $ json_arg $ no_sync_arg $ logging_term))
998
999(* Feature commands *)
1000
1001let feature_name_arg =
1002 let doc = "Feature name (used for both worktree directory and branch)" in
1003 Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc)
1004
1005let feature_add_cmd =
1006 let doc = "Create a new feature worktree for parallel development" in
1007 let man =
1008 [
1009 `S Manpage.s_description;
1010 `P
1011 "Creates a git worktree at $(b,root/work/<name>) with a new branch named \
1012 $(b,<name>). This allows parallel development on separate branches, \
1013 useful for having multiple Claude instances working on different features.";
1014 `S "HOW IT WORKS";
1015 `P "The command:";
1016 `I ("1.", "Creates the $(b,work/) directory if it doesn't exist");
1017 `I ("2.", "Creates a git worktree at $(b,work/<name>)");
1018 `I ("3.", "Checks out a new branch named $(b,<name>)");
1019 `S Manpage.s_examples;
1020 `P "Create a feature worktree:";
1021 `Pre "monopam feature add my-feature\n\
1022 cd work/my-feature\n\
1023 # Now you can work here independently";
1024 `P "Have multiple Claudes work in parallel:";
1025 `Pre "# Terminal 1\n\
1026 monopam feature add auth-system\n\
1027 cd work/auth-system && claude\n\n\
1028 # Terminal 2\n\
1029 monopam feature add api-refactor\n\
1030 cd work/api-refactor && claude";
1031 ]
1032 in
1033 let info = Cmd.info "add" ~doc ~man in
1034 let run name () =
1035 Eio_main.run @@ fun env ->
1036 with_verse_config env @@ fun verse_config ->
1037 let fs = Eio.Stdenv.fs env in
1038 let proc = Eio.Stdenv.process_mgr env in
1039 match Monopam.Feature.add ~proc ~fs ~config:verse_config ~name () with
1040 | Ok entry ->
1041 Fmt.pr "Created feature worktree '%s' at %a@." entry.name Fpath.pp entry.path;
1042 Fmt.pr "@.To start working:@.";
1043 Fmt.pr " cd %a@." Fpath.pp entry.path;
1044 `Ok ()
1045 | Error e ->
1046 Fmt.epr "Error: %a@." Monopam.Feature.pp_error_with_hint e;
1047 `Error (false, "feature add failed")
1048 in
1049 Cmd.v info Term.(ret (const run $ feature_name_arg $ logging_term))
1050
1051let feature_remove_cmd =
1052 let doc = "Remove a feature worktree" in
1053 let man =
1054 [
1055 `S Manpage.s_description;
1056 `P
1057 "Removes the git worktree at $(b,root/work/<name>). The branch is not \
1058 deleted, so you can recreate the worktree later if needed.";
1059 `S "OPTIONS";
1060 `I ("--force", "Remove even if there are uncommitted changes");
1061 `S Manpage.s_examples;
1062 `P "Remove a completed feature worktree:";
1063 `Pre "monopam feature remove my-feature";
1064 `P "Force remove with uncommitted changes:";
1065 `Pre "monopam feature remove my-feature --force";
1066 ]
1067 in
1068 let info = Cmd.info "remove" ~doc ~man in
1069 let force_arg =
1070 let doc = "Remove even if there are uncommitted changes." in
1071 Arg.(value & flag & info [ "force"; "f" ] ~doc)
1072 in
1073 let run name force () =
1074 Eio_main.run @@ fun env ->
1075 with_verse_config env @@ fun verse_config ->
1076 let fs = Eio.Stdenv.fs env in
1077 let proc = Eio.Stdenv.process_mgr env in
1078 match Monopam.Feature.remove ~proc ~fs ~config:verse_config ~name ~force () with
1079 | Ok () ->
1080 Fmt.pr "Removed feature worktree '%s'.@." name;
1081 `Ok ()
1082 | Error e ->
1083 Fmt.epr "Error: %a@." Monopam.Feature.pp_error_with_hint e;
1084 `Error (false, "feature remove failed")
1085 in
1086 Cmd.v info Term.(ret (const run $ feature_name_arg $ force_arg $ logging_term))
1087
1088let feature_list_cmd =
1089 let doc = "List all feature worktrees" in
1090 let man =
1091 [
1092 `S Manpage.s_description;
1093 `P "Lists all git worktrees in the $(b,root/work/) directory.";
1094 `S Manpage.s_examples;
1095 `Pre "monopam feature list";
1096 ]
1097 in
1098 let info = Cmd.info "list" ~doc ~man in
1099 let run () =
1100 Eio_main.run @@ fun env ->
1101 with_verse_config env @@ fun verse_config ->
1102 let fs = Eio.Stdenv.fs env in
1103 let proc = Eio.Stdenv.process_mgr env in
1104 let entries = Monopam.Feature.list ~proc ~fs ~config:verse_config () in
1105 if entries = [] then
1106 Fmt.pr "No feature worktrees found.@."
1107 else begin
1108 Fmt.pr "Feature worktrees:@.";
1109 List.iter (fun entry ->
1110 Fmt.pr " %s -> %a (branch: %s)@."
1111 entry.Monopam.Feature.name
1112 Fpath.pp entry.Monopam.Feature.path
1113 entry.Monopam.Feature.branch
1114 ) entries
1115 end;
1116 `Ok ()
1117 in
1118 Cmd.v info Term.(ret (const run $ logging_term))
1119
1120let feature_cmd =
1121 let doc = "Manage feature worktrees for parallel development" in
1122 let man =
1123 [
1124 `S Manpage.s_description;
1125 `P
1126 "Feature worktrees allow parallel development on separate branches of \
1127 the monorepo. This is useful for having multiple Claude instances \
1128 working on different features simultaneously.";
1129 `S "WORKSPACE STRUCTURE";
1130 `P "Feature worktrees are created in the $(b,work/) directory:";
1131 `Pre "root/\n\
1132 ├── mono/ # Main monorepo\n\
1133 ├── work/\n\
1134 │ ├── feature-a/ # Worktree on branch 'feature-a'\n\
1135 │ └── feature-b/ # Worktree on branch 'feature-b'\n\
1136 └── ...";
1137 `S "COMMANDS";
1138 `I ("add <name>", "Create a new feature worktree");
1139 `I ("remove <name>", "Remove a feature worktree");
1140 `I ("list", "List all feature worktrees");
1141 `S "WORKFLOW";
1142 `P "Typical workflow for parallel development:";
1143 `Pre "# Create feature worktrees\n\
1144 monopam feature add auth-system\n\
1145 monopam feature add api-cleanup\n\n\
1146 # Work in each worktree independently\n\
1147 cd work/auth-system && claude\n\
1148 cd work/api-cleanup && claude\n\n\
1149 # When done, merge branches back to main\n\
1150 cd mono\n\
1151 git merge auth-system\n\
1152 git merge api-cleanup\n\n\
1153 # Clean up worktrees\n\
1154 monopam feature remove auth-system\n\
1155 monopam feature remove api-cleanup";
1156 ]
1157 in
1158 let info = Cmd.info "feature" ~doc ~man in
1159 Cmd.group info [ feature_add_cmd; feature_remove_cmd; feature_list_cmd ]
1160
1161(* Devcontainer command *)
1162
1163let default_devcontainer_url =
1164 "https://raw.githubusercontent.com/avsm/claude-ocaml-devcontainer/refs/heads/main/.devcontainer/devcontainer.json"
1165
1166let devcontainer_cmd =
1167 let doc = "Setup and enter a devcontainer environment" in
1168 let man =
1169 [
1170 `S Manpage.s_description;
1171 `P
1172 "Creates and enters a devcontainer environment for OCaml development \
1173 with monopam and Claude. If the target directory doesn't have a \
1174 .devcontainer configuration, it will be created automatically.";
1175 `P
1176 "This is the recommended way to get started with monopam. The \
1177 devcontainer provides a consistent environment with OCaml, opam, \
1178 and all required tools pre-installed.";
1179 `S "WHAT IT DOES";
1180 `P "For a new directory (no .devcontainer/):";
1181 `I ("1.", "Creates the target directory if needed");
1182 `I ("2.", "Creates .devcontainer/ subdirectory");
1183 `I ("3.", "Downloads devcontainer.json from the template repository");
1184 `I ("4.", "Builds and starts the devcontainer");
1185 `I ("5.", "Opens an interactive shell inside the container");
1186 `P "For an existing directory with .devcontainer/:";
1187 `I ("1.", "Starts the devcontainer if not running");
1188 `I ("2.", "Opens an interactive shell inside the container");
1189 `S Manpage.s_options;
1190 `P "Use $(b,--url) to specify a custom devcontainer.json URL if you want \
1191 to use a different base configuration.";
1192 `S Manpage.s_examples;
1193 `P "Create a new devcontainer workspace:";
1194 `Pre "monopam devcontainer ~/my-ocaml-project";
1195 `P "Enter an existing devcontainer:";
1196 `Pre "monopam devcontainer ~/my-ocaml-project";
1197 `P "Use a custom devcontainer.json:";
1198 `Pre "monopam devcontainer --url https://example.com/devcontainer.json ~/project";
1199 ]
1200 in
1201 let info = Cmd.info "devcontainer" ~doc ~man in
1202 let path_arg =
1203 let doc = "Target directory for the devcontainer workspace." in
1204 Arg.(required & pos 0 (some string) None & info [] ~docv:"PATH" ~doc)
1205 in
1206 let url_arg =
1207 let doc = "URL to fetch devcontainer.json from. Defaults to the claude-ocaml-devcontainer template." in
1208 Arg.(value & opt string default_devcontainer_url & info ["url"] ~docv:"URL" ~doc)
1209 in
1210 let run path url () =
1211 (* Resolve to absolute path *)
1212 let abs_path =
1213 if Filename.is_relative path then
1214 Filename.concat (Sys.getcwd ()) path
1215 else path
1216 in
1217 let devcontainer_dir = Filename.concat abs_path ".devcontainer" in
1218 let devcontainer_json = Filename.concat devcontainer_dir "devcontainer.json" in
1219 (* Check if .devcontainer exists *)
1220 let needs_init = not (Sys.file_exists devcontainer_dir && Sys.is_directory devcontainer_dir) in
1221 if needs_init then begin
1222 Fmt.pr "Initializing devcontainer in %s...@." abs_path;
1223 (* Create directories *)
1224 (try Unix.mkdir abs_path 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
1225 (try Unix.mkdir devcontainer_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
1226 (* Fetch devcontainer.json using curl *)
1227 Fmt.pr "Fetching devcontainer.json from %s...@." url;
1228 let curl_cmd = Printf.sprintf "curl -fsSL '%s' -o '%s'" url devcontainer_json in
1229 let ret = Sys.command curl_cmd in
1230 if ret <> 0 then begin
1231 Fmt.epr "Error: Failed to fetch devcontainer.json (curl exit code %d)@." ret;
1232 exit 1
1233 end;
1234 Fmt.pr "Created %s@." devcontainer_json;
1235 (* Build and start the devcontainer *)
1236 Fmt.pr "Building devcontainer (this may take a while on first run)...@.";
1237 let up_cmd = Printf.sprintf "npx @devcontainers/cli up --workspace-folder '%s' --remove-existing-container" abs_path in
1238 let ret = Sys.command up_cmd in
1239 if ret <> 0 then begin
1240 Fmt.epr "Error: Failed to start devcontainer (exit code %d)@." ret;
1241 exit 1
1242 end
1243 end;
1244 (* Exec into the devcontainer *)
1245 Fmt.pr "Entering devcontainer...@.";
1246 let exec_cmd = Printf.sprintf "npx @devcontainers/cli exec --workspace-folder '%s' bash -l" abs_path in
1247 let ret = Sys.command exec_cmd in
1248 if ret <> 0 then
1249 `Error (false, Printf.sprintf "devcontainer exec failed with code %d" ret)
1250 else
1251 `Ok ()
1252 in
1253 Cmd.v info Term.(ret (const run $ path_arg $ url_arg $ logging_term))
1254
1255(* Confirmation prompt *)
1256let confirm prompt =
1257 Printf.printf "%s [y/N] %!" prompt;
1258 match In_channel.(input_line stdin) with
1259 | Some s -> String.lowercase_ascii (String.trim s) = "y"
1260 | None -> false
1261
1262(* Prompt for optional string input *)
1263let prompt_string prompt =
1264 Printf.printf "%s %!" prompt;
1265 match In_channel.(input_line stdin) with
1266 | Some s ->
1267 let s = String.trim s in
1268 if s = "" then None else Some s
1269 | None -> None
1270
1271(* Fork command *)
1272
1273let fork_cmd =
1274 let doc = "Fork a monorepo subtree into its own repository" in
1275 let man =
1276 [
1277 `S Manpage.s_description;
1278 `P
1279 "Splits a monorepo subdirectory into its own git repository and \
1280 establishes a proper subtree relationship. This creates src/<name>/ \
1281 with the extracted history, then re-adds mono/<name>/ as a subtree.";
1282 `S "FORK MODES";
1283 `P "The fork command handles two scenarios:";
1284 `I ("Subtree with history", "For subtrees added via $(b,git subtree add) or \
1285 $(b,monopam join), the command uses $(b,git subtree split) to extract \
1286 the full commit history into the new repository.");
1287 `I ("Fresh package", "For packages created directly in mono/ without subtree \
1288 history, the command copies the files and creates an initial commit. \
1289 This is useful for new packages you've developed locally.");
1290 `S "WHAT IT DOES";
1291 `P "The fork command performs a complete workflow in one step:";
1292 `I ("1.", "Analyzes mono/<name>/ to detect fork mode");
1293 `I ("2.", "Builds an action plan and shows discovery details");
1294 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)");
1295 `I ("4.", "Creates a new git repo at src/<name>/");
1296 `I ("5.", "Extracts history (subtree split) or copies files (fresh package)");
1297 `I ("6.", "Removes mono/<name>/ from git and commits");
1298 `I ("7.", "Re-adds mono/<name>/ as a proper subtree from src/<name>/");
1299 `I ("8.", "Updates sources.toml with $(b,origin = \"fork\")");
1300 `S "AFTER FORKING";
1301 `P "After forking, the subtree relationship is fully established:";
1302 `I ("-", "mono/<name>/ is now a proper git subtree of src/<name>/");
1303 `I ("-", "$(b,monopam sync) will push/pull changes correctly");
1304 `I ("-", "No need for manual $(b,git rm) or $(b,monopam rejoin)");
1305 `P "To push to a remote:";
1306 `Pre "cd src/<name> && git push -u origin main";
1307 `S Manpage.s_examples;
1308 `P "Fork a subtree with local-only repo:";
1309 `Pre "monopam fork my-lib";
1310 `P "Fork with a remote push URL:";
1311 `Pre "monopam fork my-lib git@github.com:me/my-lib.git";
1312 `P "Preview what would be done:";
1313 `Pre "monopam fork my-lib --dry-run";
1314 `P "Fork without confirmation:";
1315 `Pre "monopam fork my-lib --yes";
1316 ]
1317 in
1318 let info = Cmd.info "fork" ~doc ~man in
1319 let name_arg =
1320 let doc = "Name of the subtree to fork (directory name under mono/)" in
1321 Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc)
1322 in
1323 let url_arg =
1324 let doc = "Optional remote URL to add as 'origin' for pushing" in
1325 Arg.(value & pos 1 (some string) None & info [] ~docv:"URL" ~doc)
1326 in
1327 let dry_run_arg =
1328 let doc = "Show what would be done without making changes" in
1329 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
1330 in
1331 let yes_arg =
1332 let doc = "Assume yes to all prompts (for automation)" in
1333 Arg.(value & flag & info [ "yes"; "y" ] ~doc)
1334 in
1335 let run name url dry_run yes () =
1336 Eio_main.run @@ fun env ->
1337 with_verse_config env @@ fun config ->
1338 let fs = Eio.Stdenv.fs env in
1339 let proc = Eio.Stdenv.process_mgr env in
1340 (* Get URL: use provided, or try to derive from dune-project, or prompt *)
1341 let url =
1342 match url with
1343 | Some _ -> url
1344 | None ->
1345 (* Try to get default from dune-project *)
1346 let mono_path = Monopam.Config.mono_path config in
1347 let subtree_path = Fpath.(mono_path / name) in
1348 let knot = Monopam.Config.knot config in
1349 let suggested = Monopam.Fork_join.suggest_push_url ~fs ~knot subtree_path in
1350 if yes || dry_run then
1351 suggested (* Use suggested or None without prompting *)
1352 else begin
1353 match suggested with
1354 | Some default_url ->
1355 Fmt.pr "Remote push URL [%s]: %!" default_url;
1356 (match prompt_string "" with
1357 | None -> Some default_url (* User pressed enter, use default *)
1358 | Some entered -> Some entered)
1359 | None ->
1360 Fmt.pr "Remote push URL (leave empty to skip): %!";
1361 prompt_string ""
1362 end
1363 in
1364 (* Build the plan *)
1365 match Monopam.Fork_join.plan_fork ~proc ~fs ~config ~name ?push_url:url ~dry_run () with
1366 | Error e ->
1367 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1368 `Error (false, "fork failed")
1369 | Ok plan ->
1370 (* Print discovery and actions *)
1371 Fmt.pr "Analyzing fork request for '%s'...@.@." name;
1372 Fmt.pr "Discovery:@.%a@." Monopam.Fork_join.pp_discovery plan.discovery;
1373 (match url with
1374 | Some u -> Fmt.pr " Remote URL: %s@." u
1375 | None -> ());
1376 Fmt.pr "@.Actions to perform:@.";
1377 List.iteri (fun i action ->
1378 Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action
1379 ) plan.actions;
1380 Fmt.pr "@.";
1381 (* Prompt for confirmation unless --yes or --dry-run *)
1382 let proceed =
1383 if dry_run then begin
1384 Fmt.pr "(dry-run mode - no changes will be made)@.";
1385 true
1386 end else if yes then
1387 true
1388 else
1389 confirm "Proceed?"
1390 in
1391 if not proceed then begin
1392 Fmt.pr "Cancelled.@.";
1393 `Ok ()
1394 end else begin
1395 (* Execute the plan *)
1396 match Monopam.Fork_join.execute_fork_plan ~proc ~fs plan with
1397 | Ok result ->
1398 if not dry_run then begin
1399 Fmt.pr "%a@." Monopam.Fork_join.pp_fork_result result;
1400 Fmt.pr "@.Next steps:@.";
1401 Fmt.pr " 1. Review the new repo: cd src/%s@." result.name;
1402 match url with
1403 | Some _ -> Fmt.pr " 2. Push to remote: git push -u origin main@."
1404 | None -> Fmt.pr " 2. Add a remote: git remote add origin <url>@."
1405 end;
1406 `Ok ()
1407 | Error e ->
1408 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1409 `Error (false, "fork failed")
1410 end
1411 in
1412 Cmd.v info Term.(ret (const run $ name_arg $ url_arg $ dry_run_arg $ yes_arg $ logging_term))
1413
1414(* Join command *)
1415
1416let join_cmd =
1417 let doc = "Bring an external repository into the monorepo" in
1418 let man =
1419 [
1420 `S Manpage.s_description;
1421 `P
1422 "Clones an external git repository and adds it as a subtree in the \
1423 monorepo. This is the inverse of $(b,monopam fork).";
1424 `S "JOIN MODES";
1425 `P "The join command handles multiple scenarios:";
1426 `I ("URL join", "Clone from a git URL and add as subtree (default).");
1427 `I ("Local directory join", "Import from a local filesystem path. If the \
1428 path is a git repo, uses it directly. If not, initializes a new repo.");
1429 `I ("Verse join", "Join from a verse member's repository using $(b,--from).");
1430 `S "WHAT IT DOES";
1431 `P "The join command:";
1432 `I ("1.", "Analyzes the source (URL or local path)");
1433 `I ("2.", "Builds an action plan and shows discovery details");
1434 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)");
1435 `I ("4.", "Clones/copies the repository to src/<name>/");
1436 `I ("5.", "Uses $(b,git subtree add) to bring into monorepo");
1437 `I ("6.", "Updates sources.toml with $(b,origin = \"join\")");
1438 `S "JOINING FROM VERSE";
1439 `P "To join a package from a verse member, use $(b,--from):";
1440 `Pre "monopam join --from avsm.bsky.social --url git@github.com:me/cohttp.git cohttp";
1441 `P "This will:";
1442 `I ("-", "Look up the package in their opam-repo");
1443 `I ("-", "Find all packages from the same git repository");
1444 `I ("-", "Create opam entries pointing to your fork");
1445 `I ("-", "Clone and add the subtree");
1446 `S "AFTER JOINING";
1447 `P "After joining, work with the subtree normally:";
1448 `I ("1.", "Make changes in mono/<name>/");
1449 `I ("2.", "Commit in mono/");
1450 `I ("3.", "Run $(b,monopam sync --remote) to push upstream");
1451 `S Manpage.s_examples;
1452 `P "Join a repository:";
1453 `Pre "monopam join https://github.com/someone/some-lib";
1454 `P "Join from a local directory:";
1455 `Pre "monopam join /path/to/local/repo --as my-lib";
1456 `P "Join with explicit name using --url:";
1457 `Pre "monopam join --url https://tangled.org/handle/sortal sortal";
1458 `P "Join with a custom name using --as:";
1459 `Pre "monopam join https://github.com/someone/some-lib --as my-lib";
1460 `P "Join with upstream tracking (for forks):";
1461 `Pre "monopam join https://github.com/me/cohttp --upstream https://github.com/mirage/cohttp";
1462 `P "Join from a verse member:";
1463 `Pre "monopam join cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git";
1464 `P "Preview what would be done:";
1465 `Pre "monopam join https://github.com/someone/lib --dry-run";
1466 `P "Join without confirmation:";
1467 `Pre "monopam join https://github.com/someone/lib --yes";
1468 ]
1469 in
1470 let info = Cmd.info "join" ~doc ~man in
1471 let url_or_pkg_arg =
1472 let doc = "Git URL, local path, or subtree name (when using --url)" in
1473 Arg.(required & pos 0 (some string) None & info [] ~docv:"SOURCE" ~doc)
1474 in
1475 let as_arg =
1476 let doc = "Override subtree directory name" in
1477 Arg.(value & opt (some string) None & info [ "as" ] ~docv:"NAME" ~doc)
1478 in
1479 let upstream_arg =
1480 let doc = "Original upstream URL (for tracking forks)" in
1481 Arg.(value & opt (some string) None & info [ "upstream" ] ~docv:"URL" ~doc)
1482 in
1483 let from_arg =
1484 let doc = "Verse member handle to join from (requires --url)" in
1485 Arg.(value & opt (some string) None & info [ "from" ] ~docv:"HANDLE" ~doc)
1486 in
1487 let fork_url_arg =
1488 let doc = "Git URL to clone from (makes positional arg the subtree name)" in
1489 Arg.(value & opt (some string) None & info [ "url" ] ~docv:"URL" ~doc)
1490 in
1491 let dry_run_arg =
1492 let doc = "Show what would be done without making changes" in
1493 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
1494 in
1495 let yes_arg =
1496 let doc = "Assume yes to all prompts (for automation)" in
1497 Arg.(value & flag & info [ "yes"; "y" ] ~doc)
1498 in
1499 let run url_or_pkg as_name upstream from fork_url dry_run yes () =
1500 Eio_main.run @@ fun env ->
1501 with_verse_config env @@ fun config ->
1502 let fs = Eio.Stdenv.fs env in
1503 let proc = Eio.Stdenv.process_mgr env in
1504 match from with
1505 | Some handle ->
1506 (* Join from verse member - requires --url for your fork *)
1507 (* Uses legacy API as it involves verse-specific operations *)
1508 (match fork_url with
1509 | None ->
1510 Fmt.epr "Error: --url is required when using --from@.";
1511 `Error (false, "--url required")
1512 | Some fork_url ->
1513 match Monopam.Fork_join.join_from_verse ~proc ~fs ~config ~verse_config:config
1514 ~package:url_or_pkg ~handle ~fork_url ~dry_run () with
1515 | Ok result ->
1516 if dry_run then begin
1517 Fmt.pr "Would join '%s' from %s:@." result.name (Option.value ~default:"verse" result.from_handle);
1518 Fmt.pr " Source: %s@." result.source_url;
1519 Option.iter (fun u -> Fmt.pr " Upstream: %s@." u) result.upstream_url;
1520 Fmt.pr " Packages: %a@." Fmt.(list ~sep:(any ", ") string) result.packages_added
1521 end else begin
1522 Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result;
1523 Fmt.pr "@.Next steps:@.";
1524 Fmt.pr " 1. Commit the opam changes: cd opam-repo && git add -A && git commit@.";
1525 Fmt.pr " 2. Run $(b,monopam sync) to synchronize@."
1526 end;
1527 `Ok ()
1528 | Error e ->
1529 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1530 `Error (false, "join failed"))
1531 | None ->
1532 (* Normal join from URL or local path - use plan-based workflow *)
1533 let source = match fork_url with Some u -> u | None -> url_or_pkg in
1534 let name = match fork_url with Some _ -> Some url_or_pkg | None -> as_name in
1535 (* Build the plan *)
1536 match Monopam.Fork_join.plan_join ~proc ~fs ~config ~source ?name ?upstream ~dry_run () with
1537 | Error e ->
1538 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1539 `Error (false, "join failed")
1540 | Ok plan ->
1541 (* Print discovery and actions *)
1542 let is_local = Monopam.Fork_join.is_local_path source in
1543 Fmt.pr "Analyzing join request...@.@.";
1544 Fmt.pr "Discovery:@.";
1545 Fmt.pr " Source: %s (%s)@." source
1546 (if is_local then "local directory" else "remote URL");
1547 Fmt.pr "%a" Monopam.Fork_join.pp_discovery plan.discovery;
1548 Fmt.pr "@.Actions to perform:@.";
1549 List.iteri (fun i action ->
1550 Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action
1551 ) plan.actions;
1552 Fmt.pr "@.";
1553 (* Prompt for confirmation unless --yes or --dry-run *)
1554 let proceed =
1555 if dry_run then begin
1556 Fmt.pr "(dry-run mode - no changes will be made)@.";
1557 true
1558 end else if yes then
1559 true
1560 else
1561 confirm "Proceed?"
1562 in
1563 if not proceed then begin
1564 Fmt.pr "Cancelled.@.";
1565 `Ok ()
1566 end else begin
1567 (* Execute the plan *)
1568 match Monopam.Fork_join.execute_join_plan ~proc ~fs plan with
1569 | Ok result ->
1570 if not dry_run then begin
1571 Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result;
1572 Fmt.pr "@.Next steps:@.";
1573 Fmt.pr " 1. Run $(b,monopam sync) to synchronize@."
1574 end;
1575 `Ok ()
1576 | Error e ->
1577 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1578 `Error (false, "join failed")
1579 end
1580 in
1581 Cmd.v info Term.(ret (const run $ url_or_pkg_arg $ as_arg $ upstream_arg $ from_arg $ fork_url_arg $ dry_run_arg $ yes_arg $ logging_term))
1582
1583(* Rejoin command *)
1584
1585let rejoin_cmd =
1586 let doc = "Add a source checkout back into the monorepo as a subtree" in
1587 let man =
1588 [
1589 `S Manpage.s_description;
1590 `P
1591 "Adds an existing src/<name>/ repository back into mono/<name>/ as a \
1592 subtree. This is useful after forking a package and removing it from \
1593 the monorepo with $(b,git rm).";
1594 `S "WORKFLOW";
1595 `P "Typical workflow for removing and re-adding a package:";
1596 `I ("1.", "Fork the package: $(b,monopam fork my-lib)");
1597 `I ("2.", "Remove from monorepo: $(b,git rm -r mono/my-lib && git commit)");
1598 `I ("3.", "Work on it in src/my-lib/");
1599 `I ("4.", "Re-add to monorepo: $(b,monopam rejoin my-lib)");
1600 `S "REQUIREMENTS";
1601 `P "For rejoin to work:";
1602 `I ("-", "src/<name>/ must exist and be a git repository");
1603 `I ("-", "mono/<name>/ must NOT exist (was removed)");
1604 `S "WHAT IT DOES";
1605 `P "The rejoin command:";
1606 `I ("1.", "Verifies src/<name>/ exists and is a git repo");
1607 `I ("2.", "Verifies mono/<name>/ does not exist");
1608 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)");
1609 `I ("4.", "Uses $(b,git subtree add) to bring src/<name>/ into mono/<name>/");
1610 `S Manpage.s_examples;
1611 `P "Re-add a package from src/:";
1612 `Pre "monopam rejoin my-lib";
1613 `P "Preview what would be done:";
1614 `Pre "monopam rejoin my-lib --dry-run";
1615 `P "Rejoin without confirmation:";
1616 `Pre "monopam rejoin my-lib --yes";
1617 ]
1618 in
1619 let info = Cmd.info "rejoin" ~doc ~man in
1620 let name_arg =
1621 let doc = "Name of the subtree to rejoin (directory name under src/)" in
1622 Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc)
1623 in
1624 let dry_run_arg =
1625 let doc = "Show what would be done without making changes" in
1626 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
1627 in
1628 let yes_arg =
1629 let doc = "Assume yes to all prompts (for automation)" in
1630 Arg.(value & flag & info [ "yes"; "y" ] ~doc)
1631 in
1632 let run name dry_run yes () =
1633 Eio_main.run @@ fun env ->
1634 with_verse_config env @@ fun config ->
1635 let fs = Eio.Stdenv.fs env in
1636 let proc = Eio.Stdenv.process_mgr env in
1637 (* Build the plan *)
1638 match Monopam.Fork_join.plan_rejoin ~proc ~fs ~config ~name ~dry_run () with
1639 | Error e ->
1640 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1641 `Error (false, "rejoin failed")
1642 | Ok plan ->
1643 (* Print discovery and actions *)
1644 Fmt.pr "Analyzing rejoin request for '%s'...@.@." name;
1645 Fmt.pr "Discovery:@.%a@." Monopam.Fork_join.pp_discovery plan.discovery;
1646 Fmt.pr "@.Actions to perform:@.";
1647 List.iteri (fun i action ->
1648 Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action
1649 ) plan.actions;
1650 Fmt.pr "@.";
1651 (* Prompt for confirmation unless --yes or --dry-run *)
1652 let proceed =
1653 if dry_run then begin
1654 Fmt.pr "(dry-run mode - no changes will be made)@.";
1655 true
1656 end else if yes then
1657 true
1658 else
1659 confirm "Proceed?"
1660 in
1661 if not proceed then begin
1662 Fmt.pr "Cancelled.@.";
1663 `Ok ()
1664 end else begin
1665 (* Execute the plan *)
1666 match Monopam.Fork_join.execute_join_plan ~proc ~fs plan with
1667 | Ok result ->
1668 if not dry_run then begin
1669 Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result;
1670 Fmt.pr "@.Next steps:@.";
1671 Fmt.pr " 1. Commit the changes: git add -A && git commit@.";
1672 Fmt.pr " 2. Run $(b,monopam sync) to synchronize@."
1673 end;
1674 `Ok ()
1675 | Error e ->
1676 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e;
1677 `Error (false, "rejoin failed")
1678 end
1679 in
1680 Cmd.v info Term.(ret (const run $ name_arg $ dry_run_arg $ yes_arg $ logging_term))
1681
1682(* Site command *)
1683
1684let site_cmd =
1685 let doc = "Generate a static HTML site representing the monoverse map" in
1686 let man =
1687 [
1688 `S Manpage.s_description;
1689 `P
1690 "Generates a static index.html file that maps the monoverse, showing all \
1691 verse members, their packages, and the relationships between them.";
1692 `S "OUTPUT";
1693 `P "The generated site includes:";
1694 `I ("Members", "All verse members with links to their monorepo and opam repos");
1695 `I ("Summary", "Overview of common libraries and member-specific packages");
1696 `I ("Repository Details", "Each shared repo with packages and fork status");
1697 `S "FORK STATUS";
1698 `P "Use $(b,--status) to include fork relationship information:";
1699 `I ("+N", "You are N commits ahead of them");
1700 `I ("-N", "They are N commits ahead of you");
1701 `I ("+N/-M", "Diverged: you have N new, they have M new");
1702 `I ("sync", "Same commit");
1703 `S "DESIGN";
1704 `P "The HTML is designed to be:";
1705 `I ("-", "Simple and clean with a 10pt font");
1706 `I ("-", "Responsive and compact");
1707 `I ("-", "External links marked with icon and teal color");
1708 `S Manpage.s_examples;
1709 `P "Generate site to default location (mono/index.html):";
1710 `Pre "monopam site";
1711 `P "Generate site with fork status (slower, fetches remotes):";
1712 `Pre "monopam site --status";
1713 `P "Generate site to custom location:";
1714 `Pre "monopam site -o /var/www/monoverse/index.html";
1715 `P "Print HTML to stdout:";
1716 `Pre "monopam site --stdout";
1717 ]
1718 in
1719 let info = Cmd.info "site" ~doc ~man in
1720 let output_arg =
1721 let doc = "Output file path. Defaults to mono/index.html." in
1722 Arg.(value & opt (some string) None & info [ "o"; "output" ] ~docv:"FILE" ~doc)
1723 in
1724 let stdout_arg =
1725 let doc = "Print HTML to stdout instead of writing to file." in
1726 Arg.(value & flag & info [ "stdout" ] ~doc)
1727 in
1728 let status_arg =
1729 let doc = "Include fork status (ahead/behind) for each repository. \
1730 This fetches from remotes and may be slower." in
1731 Arg.(value & flag & info [ "status"; "s" ] ~doc)
1732 in
1733 let run output to_stdout with_status () =
1734 Eio_main.run @@ fun env ->
1735 with_config env @@ fun monopam_config ->
1736 with_verse_config env @@ fun verse_config ->
1737 let fs = Eio.Stdenv.fs env in
1738 let proc = Eio.Stdenv.process_mgr env in
1739 (* Pull/clone registry to get latest metadata *)
1740 Fmt.pr "Syncing registry...@.";
1741 let registry =
1742 match Monopam.Verse_registry.clone_or_pull ~proc ~fs:(fs :> _ Eio.Path.t) ~config:verse_config () with
1743 | Ok r -> r
1744 | Error msg ->
1745 Fmt.epr "Warning: Could not sync registry: %s@." msg;
1746 Monopam.Verse_registry.{ name = "opamverse"; description = None; members = [] }
1747 in
1748 (* Compute forks if --status is requested *)
1749 let forks =
1750 if with_status then begin
1751 Fmt.pr "Computing fork status...@.";
1752 Some (Monopam.Forks.compute ~proc ~fs:(fs :> _ Eio.Path.t)
1753 ~verse_config ~monopam_config ())
1754 end else None
1755 in
1756 if to_stdout then begin
1757 let html = Monopam.Site.generate ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry () in
1758 print_string html;
1759 `Ok ()
1760 end else begin
1761 let output_path =
1762 match output with
1763 | Some p -> (
1764 match Fpath.of_string p with
1765 | Ok fp -> fp
1766 | Error (`Msg _) -> Fpath.v p)
1767 | None -> Fpath.(Monopam.Verse_config.mono_path verse_config / "index.html")
1768 in
1769 match Monopam.Site.write ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry ~output_path () with
1770 | Ok () ->
1771 Fmt.pr "Site generated: %a@." Fpath.pp output_path;
1772 `Ok ()
1773 | Error msg ->
1774 Fmt.epr "Error: %s@." msg;
1775 `Error (false, "site generation failed")
1776 end
1777 in
1778 Cmd.v info Term.(ret (const run $ output_arg $ stdout_arg $ status_arg $ logging_term))
1779
1780(* Main command group *)
1781
1782let main_cmd =
1783 let doc = "Manage opam overlay with git subtree monorepo" in
1784 let man =
1785 [
1786 `S Manpage.s_description;
1787 `P
1788 "Monopam synchronizes packages between an opam overlay repository, \
1789 individual git checkouts, and a monorepo using git subtrees.";
1790 `P
1791 "Monopam is designed to run inside a devcontainer that provides a \
1792 consistent OCaml development environment with all required tools \
1793 pre-installed.";
1794 `S "QUICK START";
1795 `P "Start by creating a devcontainer workspace:";
1796 `Pre
1797 "monopam devcontainer ~/tangled";
1798 `P "Inside the devcontainer, initialize your workspace:";
1799 `Pre
1800 "cd ~/tangled\n\
1801 monopam init --handle yourname.bsky.social\n\
1802 cd mono";
1803 `P "Daily workflow:";
1804 `Pre
1805 "cd ~/tangled/mono\n\
1806 monopam sync # sync local and remote (most common)\n\
1807 # ... make edits ...\n\
1808 git add -A && git commit # commit your changes\n\
1809 monopam sync --remote # sync and push to upstream";
1810 `S "DIRECTORY STRUCTURE";
1811 `P "Monopam manages three directory trees:";
1812 `I
1813 ( "mono/",
1814 "The monorepo combining all packages as git subtrees. This is where \
1815 you make changes." );
1816 `I
1817 ( "src/",
1818 "Individual git checkouts of each unique repository. Used for review \
1819 and manual operations." );
1820 `I
1821 ( "opam-repo/",
1822 "The opam overlay repository containing package metadata." );
1823 `S "WORKFLOW";
1824 `P "The recommended workflow uses $(b,sync) as the primary command:";
1825 `I
1826 ( "1. monopam sync",
1827 "Synchronize your monorepo with all upstream repos. This both \
1828 exports your local changes to checkouts AND pulls remote changes." );
1829 `I ("2. Edit code", "Make changes in the mono/ directory");
1830 `I ("3. git commit", "Commit your changes in mono/");
1831 `I
1832 ( "4. monopam sync --remote",
1833 "Sync again, including pushing to upstream git remotes" );
1834 `P "For finer control over the sync phases:";
1835 `I
1836 ( "monopam sync --skip-pull",
1837 "Export monorepo changes to checkouts only (skip fetching remotes)" );
1838 `I
1839 ( "monopam sync --skip-push",
1840 "Pull remote changes only (skip exporting local changes)" );
1841 `S "CHECKING STATUS";
1842 `P "Run $(b,monopam status) to see the state of all repositories:";
1843 `I ("local:+N", "Your monorepo is N commits ahead of the checkout");
1844 `I ("local:-N", "The checkout is N commits ahead of your monorepo");
1845 `I ("local:sync", "Trees differ but need syncing (run $(b,monopam sync))");
1846 `I ("remote:+N", "Your checkout is N commits ahead of upstream");
1847 `I ("remote:-N", "Upstream is N commits ahead (run $(b,monopam sync))");
1848 `S "COMMON TASKS";
1849 `I ("Start fresh", "monopam init --handle you.bsky.social");
1850 `I ("Check status", "monopam status");
1851 `I ("Sync everything", "monopam sync");
1852 `I ("Sync and push upstream", "monopam sync --remote");
1853 `I ("Sync one package", "monopam sync <package-name>");
1854 `S "CONFIGURATION";
1855 `P
1856 "Run $(b,monopam init --handle <handle>) to create a workspace. \
1857 Configuration is stored in ~/.config/monopam/opamverse.toml.";
1858 `P "Workspace structure:";
1859 `Pre
1860 "root/\n\
1861 ├── mono/ # Your monorepo (work here)\n\
1862 ├── src/ # Git checkouts (for review)\n\
1863 ├── opam-repo/ # Opam overlay\n\
1864 └── verse/ # Other members' monorepos";
1865 `S "TROUBLESHOOTING";
1866 `I
1867 ( "\"Dirty packages\" error",
1868 "You have uncommitted changes. Run: cd mono && git status" );
1869 `I
1870 ( "\"local:sync\" in status",
1871 "The monorepo and checkout are out of sync. Run: monopam sync" );
1872 `I
1873 ( "Merge conflicts",
1874 "Resolve conflicts in mono/, commit, then run: monopam sync" );
1875 `S Manpage.s_commands;
1876 `P "Use $(b,monopam COMMAND --help) for help on a specific command.";
1877 ]
1878 in
1879 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in
1880 Cmd.group info
1881 [ 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; rejoin_cmd; devcontainer_cmd; site_cmd ]
1882
1883let () = exit (Cmd.eval main_cmd)