forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1(** Root monorepo files: [dune-project], [README.md], [llms.txt], [CLAUDE.md].
2*)
3
4let src = Logs.Src.create "monopam.root" ~doc:"Monorepo root file generation"
5
6module Log = (val Logs.src_log src : Logs.LOG)
7
8type t = {
9 dune_project : string;
10 readme : string;
11 llms_txt : string;
12 claude_md : string;
13}
14
15let pp ppf t =
16 Fmt.pf ppf
17 "@[<v>dune-project: %d B@ README.md: %d B@ llms.txt: %d B@ CLAUDE.md: %d \
18 B@]"
19 (String.length t.dune_project)
20 (String.length t.readme) (String.length t.llms_txt)
21 (String.length t.claude_md)
22
23type diff = { file : string; expected : string; actual : string }
24
25(** {1 Static content: CLAUDE.md} *)
26
27let claude_md_header =
28 {|# Monorepo Development Guide
29
30This is a monorepo managed by `monopam`. Each subdirectory is a subtree
31from a separate upstream repository. You edit everything in one tree,
32build with dune, then `pull` and `push` to move changes in and out.
33
34> **Note:** Project-specific doctrine lives in `.claude/CLAUDE.md`
35> (committed, team-shared). User-local overrides belong in a
36> gitignored `.claude/CLAUDE.md` that shadows the committed one.
37
38## Quick Reference
39
40| Task | Command |
41|------------------------------------|------------------------------|
42| Check status | `monopam status` |
43| Fetch upstream changes | `monopam pull` |
44| Push changes to your remotes | `monopam push` |
45| Export to checkouts only (no push) | `monopam push --local` |
46| Operate on one package | `monopam <cmd> <name>` |
47| Build | `opam exec -- dune build` |
48| Test | `opam exec -- dune test` |
49|}
50
51let claude_md_daily_workflow =
52 {|## Daily Workflow
53
54```bash
55# 1. See what needs attention
56monopam status
57
58# 2. Pull latest upstream changes into the monorepo
59monopam pull
60
61# 3. Make your changes anywhere in the tree, build and test
62opam exec -- dune build && opam exec -- dune test
63
64# 4. Commit your changes to the monorepo (stage specific files — avoid
65# `git add -A`, which sweeps in unrelated edits other sessions may
66# have staged and can include secrets or build artefacts)
67git add path/to/file ...
68git commit -m "Description of changes"
69
70# 5. Lint: missing/unused opam deps and stale generated root files
71monopam lint
72
73# 6. Send them back to the upstream repos
74monopam push
75```
76
77`pull` and `push` are the sync verbs. Pulling first, building, testing,
78then pushing keeps the two directions decoupled so you always know what
79state you're in.
80|}
81
82let claude_md_status =
83 {|## Understanding Status Output
84
85Run `monopam status` to see the sync state:
86
87- `local:=` — Monorepo and checkout in sync
88- `local:+N` — Monorepo has N commits not in checkout (run `monopam push --local`)
89- `local:-N` — Checkout has N commits not in monorepo (run `monopam pull`)
90- `local:sync` — Trees differ; run `monopam pull` then `monopam push` to reconcile
91- `remote:=` — Checkout and upstream in sync
92- `remote:+N` — You have N commits to push (run `monopam push`)
93- `remote:-N` — Upstream has N commits to pull (run `monopam pull`)
94|}
95
96let claude_md_making_changes =
97 {|## Making Changes
98
991. **Edit code** in any subdirectory as normal
1002. **Build and test**: `opam exec -- dune build && opam exec -- dune test`
1013. **Commit** your changes: `git add <files>` for the specific paths you
102 touched, then `git commit` (avoid `git add -A` — concurrent sessions
103 may have staged unrelated work)
1044. **Lint**: `monopam lint` to flag missing/unused opam deps and stale
105 generated root files (run `monopam lint --fix` to regenerate)
1065. **Push**: `monopam push` to send them upstream
107
108## Important Notes
109
110- **Always commit before push**: `monopam push` only exports committed changes
111- **Check status first**: Run `monopam status` to see what needs attention
112- **One repo per directory**: Each subdirectory maps to exactly one git remote
113|}
114
115let claude_md_workflow =
116 String.concat "\n"
117 [ claude_md_daily_workflow; claude_md_status; claude_md_making_changes ]
118
119let claude_md_troubleshooting =
120 {|## Troubleshooting
121
122### `local:sync` in status
123The monorepo subtree and checkout have diverged trees and monopam can't
124pick a direction automatically. Pull first, then push:
125
126```bash
127monopam pull
128monopam push
129```
130
131### Merge conflicts after `monopam pull`
132Resolve conflicts in `mono/`, then stage the resolved files (not `-A`)
133and commit:
134
135```bash
136git add <resolved files>
137git commit -m "Resolve merge conflicts"
138monopam push # only if you want to publish the resolution
139```
140
141### Push fails with non-fast-forward
142Another monorepo (or a direct commit) got there first. Pull, rebuild, then
143retry:
144
145```bash
146monopam pull
147opam exec -- dune build && opam exec -- dune test
148monopam push
149```
150
151If the upstream history is intentionally diverged (e.g. after `git
152filter-repo`), `monopam push --force` overrides.
153
154### A checkout is missing
155Usually means `src/<repo>` hasn't been cloned yet. `monopam pull` will
156clone missing checkouts as part of its normal flow.
157
158## Getting Help
159
160```bash
161monopam --help # List of all commands
162monopam pull --help # Pull command help
163monopam push --help # Push command help
164monopam status --help # Status command help
165```
166|}
167
168let claude_md =
169 String.concat "\n"
170 [ claude_md_header; claude_md_workflow; claude_md_troubleshooting ]
171
172(** {1 README and llms.txt generation} *)
173
174let strip_git_plus url =
175 if String.starts_with ~prefix:"git+" url then
176 String.sub url 4 (String.length url - 4)
177 else url
178
179let repo_display_url pkg = strip_git_plus (Uri.to_string (Package.dev_repo pkg))
180
181let repo_cell_for ~repo ~url ~index =
182 if index <> 0 then ""
183 else if url = "" then Fmt.str "**%s**" repo
184 else Fmt.str "[**%s**](%s)" repo url
185
186let readme_row ~buf ~repo ~url ~index pkg =
187 let synopsis = Option.value ~default:"" (Package.synopsis pkg) in
188 let cell = repo_cell_for ~repo ~url ~index in
189 Buffer.add_string buf
190 (Fmt.str "| %s | %s | %s |\n" cell (Package.name pkg) synopsis)
191
192let readme_repo_group ~buf (repo, pkgs) =
193 let url = match pkgs with p :: _ -> repo_display_url p | [] -> "" in
194 List.iteri (fun i pkg -> readme_row ~buf ~repo ~url ~index:i pkg) pkgs
195
196let generate_readme pkgs =
197 let grouped = Ctx.group_by_repo pkgs in
198 let buf = Buffer.create 4096 in
199 Buffer.add_string buf "# Monorepo Package Index\n\n";
200 Buffer.add_string buf
201 "This monorepo contains the following packages, synchronized from their \
202 upstream repositories.\n\n";
203 Buffer.add_string buf "| Repository | Package | Synopsis |\n";
204 Buffer.add_string buf "|------------|---------|----------|\n";
205 List.iter (readme_repo_group ~buf) grouped;
206 Buffer.add_string buf "\n---\n\n";
207 Buffer.add_string buf
208 (Fmt.str "_Generated by monopam. %d packages from %d repositories._\n"
209 (List.length pkgs) (List.length grouped));
210 Buffer.contents buf
211
212let generate_llms_txt pkgs =
213 let grouped = Ctx.group_by_repo pkgs in
214 let buf = Buffer.create 4096 in
215 Buffer.add_string buf "# Blacksun Monorepo\n\n";
216 Buffer.add_string buf
217 "> OCaml packages for space systems, cryptography, protocols, and monorepo \
218 tooling.\n\n";
219 Buffer.add_string buf
220 "This monorepo aggregates OCaml libraries as git subtrees. Each package \
221 has its own README with API documentation and usage examples at the \
222 linked path.\n\n";
223 Buffer.add_string buf "## Packages\n\n";
224 List.iter
225 (fun (repo, pkgs) ->
226 List.iter
227 (fun pkg ->
228 let name = Package.name pkg in
229 let synopsis = Option.value ~default:"" (Package.synopsis pkg) in
230 Buffer.add_string buf
231 (Fmt.str "- [%s](%s/README.md): %s\n" name repo synopsis))
232 pkgs)
233 grouped;
234 Buffer.add_string buf "\n## Optional\n\n";
235 Buffer.add_string buf
236 "- [CLAUDE.md](CLAUDE.md): Development workflow and monorepo conventions\n";
237 Buffer.add_string buf
238 "- [README.md](README.md): Human-facing package index with upstream repo \
239 links\n";
240 Buffer.contents buf
241
242(** {1 dune-project generation}
243
244 Regenerated from scratch on every run. Identity fields — the project
245 [(name ...)] and the root package's [(maintainers ...)] / [(authors ...)] —
246 are carried forward from the existing dune-project when set, and guessed
247 from the global git user when absent. The guess lands in the file on the
248 first write, so it is preserved from that point on and hand-edits survive
249 regeneration. *)
250
251type identity = {
252 project_name : string;
253 maintainers : string list;
254 authors : string list;
255 using : Sexp.Value.t list;
256}
257
258let atom_field name stanzas =
259 List.find_map
260 (function
261 | Sexp.List [ Sexp.Atom n; Sexp.Atom v ] when n = name -> Some v
262 | _ -> None)
263 stanzas
264
265let string_list_field name stanzas =
266 List.find_map
267 (function
268 | Sexp.List (Sexp.Atom n :: rest) when n = name ->
269 Some
270 (List.filter_map
271 (function Sexp.Atom s -> Some s | Sexp.List _ -> None)
272 rest)
273 | _ -> None)
274 stanzas
275
276let guess_identity_string ~fs =
277 match Git_cli.global_git_user ~fs () with
278 | None -> None
279 | Some u -> Some (Fmt.str "%s <%s>" (Git.User.name u) (Git.User.email u))
280
281let identity ~fs content =
282 let guess = Option.to_list (guess_identity_string ~fs) in
283 let content = Dune_project.preprocess_dune_strings content in
284 let sexps =
285 match Sexp.Value.parse_string_many content with Ok s -> s | Error _ -> []
286 in
287 let project_name = Option.value ~default:"root" (atom_field "name" sexps) in
288 let root_package =
289 List.find_map
290 (function
291 | Sexp.List (Sexp.Atom "package" :: rest)
292 when atom_field "name" rest = Some project_name ->
293 Some rest
294 | _ -> None)
295 sexps
296 in
297 let from_package field =
298 match root_package with
299 | None -> None
300 | Some rest -> string_list_field field rest
301 in
302 let maintainers = Option.value ~default:guess (from_package "maintainers") in
303 let authors = Option.value ~default:guess (from_package "authors") in
304 let using =
305 List.filter
306 (function Sexp.List (Sexp.Atom "using" :: _) -> true | _ -> false)
307 sexps
308 in
309 { project_name; maintainers; authors; using }
310
311let format_string_list keyword items =
312 match items with
313 | [] -> ""
314 | _ ->
315 Fmt.str " (%s %s)\n" keyword
316 (String.concat " " (List.map (Fmt.str "%S") items))
317
318let generate_dune_project ident deps =
319 let buf = Buffer.create 1024 in
320 Buffer.add_string buf "(lang dune 3.21)\n";
321 List.iter
322 (fun sexp ->
323 Buffer.add_string buf (Sexp.Value.to_string_compact sexp);
324 Buffer.add_char buf '\n')
325 ident.using;
326 Buffer.add_string buf (Fmt.str "(name %s)\n\n" ident.project_name);
327 Buffer.add_string buf "(generate_opam_files true)\n\n";
328 Buffer.add_string buf "(package\n";
329 Buffer.add_string buf (Fmt.str " (name %s)\n" ident.project_name);
330 Buffer.add_string buf
331 " (synopsis \"Monorepo root package with external dependencies\")\n";
332 Buffer.add_string buf (format_string_list "maintainers" ident.maintainers);
333 Buffer.add_string buf (format_string_list "authors" ident.authors);
334 Buffer.add_string buf " (allow_empty)\n";
335 Buffer.add_string buf " (depends\n";
336 List.iter (fun d -> Buffer.add_string buf (Fmt.str " %s\n" d)) deps;
337 Buffer.add_string buf " ))\n";
338 Buffer.contents buf
339
340(** {1 Packages: rich or reconstructed from fs} *)
341
342let subtree_dirs ~fs monorepo =
343 let eio = Eio.Path.(fs / Fpath.to_string monorepo) in
344 let entries = try Eio.Path.read_dir eio with Eio.Io _ -> [] in
345 List.filter
346 (fun name ->
347 (not (String.starts_with ~prefix:"." name))
348 && (not (String.starts_with ~prefix:"_" name))
349 && name <> "src"
350 &&
351 try Eio.Path.kind ~follow:true Eio.Path.(eio / name) = `Directory
352 with Eio.Io _ -> false)
353 entries
354 |> List.sort String.compare
355
356let opam_files_in ~fs subtree_path =
357 let eio = Eio.Path.(fs / Fpath.to_string subtree_path) in
358 try
359 Eio.Path.read_dir eio
360 |> List.filter (fun n -> Filename.check_suffix n ".opam")
361 with Eio.Io _ -> []
362
363(** Reconstruct a [Package.t] from an on-disk [.opam] file. Missing fields fall
364 back to empty strings so README/llms.txt still render something for
365 freshly-imported subtrees that haven't published metadata yet. *)
366let package_of_opam_file ~fs ~subtree ~monorepo opam_file =
367 let opam_path = Fpath.(monorepo / subtree / opam_file) in
368 let file = Fpath.to_string opam_path in
369 let eio = Eio.Path.(fs / file) in
370 try
371 Eio.Path.with_open_in eio (fun flow ->
372 let r = Bytesrw_eio.bytes_reader_of_flow flow in
373 let opamfile = Opam_bytesrw.of_reader ~file r in
374 let items = opamfile.contents in
375 let name = Filename.chop_suffix opam_file ".opam" in
376 let dev_repo =
377 match Opam_repo.dev_repo items with
378 | Some url -> Opam_repo.normalize_git_url url
379 | None -> Uri.of_string ""
380 in
381 let synopsis = Opam_repo.synopsis items in
382 let depends = Opam_repo.depends items in
383 Some (Package.v ~name ~version:"dev" ~dev_repo ~depends ?synopsis ()))
384 with Eio.Io _ | Opam.Error _ -> None
385
386let packages_from_fs ~fs ~monorepo =
387 subtree_dirs ~fs monorepo
388 |> List.concat_map (fun subtree ->
389 opam_files_in ~fs Fpath.(monorepo / subtree)
390 |> List.filter_map (package_of_opam_file ~fs ~subtree ~monorepo))
391
392(** {1 Dependency collection} *)
393
394let collect_external_deps ~fs ~monorepo =
395 (* Iterate the actual subtree directories on disk rather than deriving them
396 from each package's dev-repo URL via [Package.repo_name]. For forks, the
397 dune-project [(source ...)] points at upstream (matching the upstream
398 entry in [sources.toml]) so [Package.repo_name] returns the upstream
399 basename, not the in-monorepo subtree. Walking [subtree_dirs] keeps the
400 dep collection and the internal-package exclusion set aligned with the
401 real layout. *)
402 let scan_dirs = subtree_dirs ~fs monorepo in
403 let all_deps =
404 List.concat_map
405 (fun dir -> Opam_repo.scan_opam_files_for_deps ~fs Fpath.(monorepo / dir))
406 scan_dirs
407 |> List.sort_uniq String.compare
408 in
409 let pkg_names =
410 List.concat_map
411 (fun dir -> opam_files_in ~fs Fpath.(monorepo / dir))
412 scan_dirs
413 |> List.map (fun n -> Filename.chop_suffix n ".opam")
414 |> List.sort_uniq String.compare
415 in
416 List.filter (fun dep -> not (List.mem dep pkg_names)) all_deps
417
418(** {1 Top-level API} *)
419
420let load_existing ~fs path =
421 let eio = Eio.Path.(fs / Fpath.to_string path) in
422 try Eio.Path.load eio with Eio.Io _ -> ""
423
424let compute ~fs ~monorepo ?packages () =
425 let pkgs =
426 match packages with Some p -> p | None -> packages_from_fs ~fs ~monorepo
427 in
428 let external_deps = collect_external_deps ~fs ~monorepo in
429 let existing = load_existing ~fs Fpath.(monorepo / "dune-project") in
430 let ident = identity ~fs existing in
431 {
432 dune_project = generate_dune_project ident external_deps;
433 readme = generate_readme pkgs;
434 llms_txt = generate_llms_txt pkgs;
435 claude_md;
436 }
437
438let load_actual ~fs ~monorepo file = load_existing ~fs Fpath.(monorepo / file)
439
440let files_of t =
441 [
442 ("dune-project", t.dune_project);
443 ("README.md", t.readme);
444 ("llms.txt", t.llms_txt);
445 ("CLAUDE.md", t.claude_md);
446 ]
447
448let check ~fs ~monorepo ?packages () =
449 let t = compute ~fs ~monorepo ?packages () in
450 List.filter_map
451 (fun (file, expected) ->
452 let actual = load_actual ~fs ~monorepo file in
453 if actual = expected then None else Some { file; expected; actual })
454 (files_of t)
455
456let write_if_changed ~monorepo_eio file content =
457 let path = Eio.Path.(monorepo_eio / file) in
458 let changed =
459 match Eio.Path.load path with
460 | existing -> existing <> content
461 | exception Eio.Io _ -> true
462 in
463 if changed then Eio.Path.save ~create:(`Or_truncate 0o644) path content;
464 changed
465
466let git_user ~fs () =
467 match Git_cli.global_git_user ~fs () with
468 | Some u -> u
469 | None ->
470 Git.User.v ~name:"monopam" ~email:"monopam@localhost"
471 ~date:(Int64.of_float (Unix.time ()))
472 ()
473
474let regenerate ~sw ~fs ~monorepo ?packages ?(skip = []) () =
475 let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
476 let t = compute ~fs ~monorepo ?packages () in
477 let changed =
478 List.filter_map
479 (fun (file, content) ->
480 if List.mem file skip then None
481 else if write_if_changed ~monorepo_eio file content then Some file
482 else None)
483 (files_of t)
484 in
485 (match changed with
486 | [] -> Log.debug (fun m -> m "Root files already up to date")
487 | files when not (Git.Repository.is_repo ~fs monorepo) ->
488 Log.app (fun m ->
489 m "Regenerated root files: %a" Fmt.(list ~sep:(any ", ") string) files)
490 | files -> (
491 let repo = Git.Repository.open_repo ~sw ~fs monorepo in
492 match Git.Repository.add_to_index repo files with
493 | Error (`Msg e) ->
494 Log.warn (fun m -> m "Failed to stage root files: %s" e)
495 | Ok () -> (
496 let user = git_user ~fs () in
497 match
498 Git.Repository.commit_index repo ~author:user ~committer:user
499 ~message:"Regenerate root files" ()
500 with
501 | Error (`Msg e) ->
502 Log.warn (fun m -> m "Failed to commit root files: %s" e)
503 | Ok _ ->
504 Log.app (fun m ->
505 m "Regenerated root files: %a"
506 Fmt.(list ~sep:(any ", ") string)
507 files))));
508 changed