My aggregated monorepo of OCaml code, automaintained
Merge branch 'main' into http2
+1909
-469
+7
-1
dune-project
+7
-1
dune-project
···
18
18
ca-certs
19
19
cmarkit
20
20
cmdliner
21
+
conf-pam
21
22
crowbar
22
23
cstruct
23
24
decompress
···
31
32
fmt
32
33
fpath
33
34
geojson
35
+
ipaddr
36
+
js_of_ocaml
37
+
js_of_ocaml-compiler
38
+
js_of_ocaml-ppx
34
39
jsonm
35
40
jsont
36
41
kdf
···
57
62
uunf
58
63
uutf
59
64
uuuu
65
+
wasm_of_ocaml-compiler
60
66
x509
61
67
xdg
62
-
yojson
68
+
xmlm
63
69
zarith
64
70
))
+1
-1
monopam/bin/dune
+1
-1
monopam/bin/dune
+599
-267
monopam/bin/main.ml
+599
-267
monopam/bin/main.ml
···
1
1
open Cmdliner
2
2
3
-
let setup_logging style_renderer level =
3
+
let setup_logging style_renderer level verbose_http =
4
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 *)
5
7
Logs.set_level level;
6
-
Logs.set_reporter (Logs_fmt.reporter ())
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
7
12
8
13
let logging_term =
9
-
Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ())
10
-
11
-
let config_file_arg =
12
-
let doc =
13
-
"Path to config file. If not specified, searches current directory then \
14
-
XDG locations."
14
+
let verbose_http_term =
15
+
Term.(const (fun ws -> ws.Requests.Cmd.value) $ Requests.Cmd.verbose_http_term "monopam")
15
16
in
16
-
Arg.(
17
-
value & opt (some string) None & info [ "c"; "config" ] ~docv:"FILE" ~doc)
17
+
Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level () $ verbose_http_term)
18
18
19
19
let package_arg =
20
20
let doc = "Package name. If not specified, operates on all packages." in
21
21
Arg.(value & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
22
22
23
-
let load_config env config_file =
23
+
(* Load config from opamverse.toml and convert to Monopam.Config *)
24
+
let load_config env =
24
25
let fs = Eio.Stdenv.fs env in
25
-
let cwd = Eio.Stdenv.cwd env in
26
-
match config_file with
27
-
| Some path -> (
28
-
(* If absolute, use fs; if relative, use cwd *)
29
-
let load_path = Fpath.v path in
30
-
if Fpath.is_abs load_path then
31
-
Monopam.Config.load ~fs ~root_fs:fs load_path
32
-
else
33
-
match
34
-
Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs load_path
35
-
with
36
-
| Ok c -> Ok c
37
-
| Error msg -> Error msg)
38
-
| None -> (
39
-
(* Try current directory first *)
40
-
let cwd_config = Fpath.v "monopam.toml" in
41
-
match
42
-
Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs cwd_config
43
-
with
44
-
| Ok c -> Ok c
45
-
| Error _ -> (
46
-
(* Try XDG *)
47
-
let xdg = Xdge.create fs "monopam" in
48
-
match Monopam.Config.load_xdg ~xdg () with
49
-
| Ok c -> Ok c
50
-
| Error msg -> Error msg))
26
+
match Monopam.Verse_config.load ~fs () with
27
+
| Error msg -> Error msg
28
+
| Ok verse_config ->
29
+
(* Convert Verse_config to Monopam.Config *)
30
+
let opam_repo = Monopam.Verse_config.opam_repo_path verse_config in
31
+
let checkouts = Monopam.Verse_config.src_path verse_config in
32
+
let monorepo = Monopam.Verse_config.mono_path verse_config in
33
+
let default_branch = Monopam.Verse_config.default_branch in
34
+
Ok (Monopam.Config.create ~opam_repo ~checkouts ~monorepo ~default_branch ())
51
35
52
-
let with_config env config_file f =
53
-
match load_config env config_file with
36
+
let with_config env f =
37
+
match load_config env with
54
38
| Ok config -> f config
55
39
| Error msg ->
56
40
Fmt.epr "Error loading config: %s@." msg;
41
+
Fmt.epr "Run 'monopam verse init' first to create a workspace.@.";
57
42
`Error (false, "configuration error")
58
43
59
44
(* Status command *)
···
77
62
]
78
63
in
79
64
let info = Cmd.info "status" ~doc ~man in
80
-
let run config_file () =
65
+
let run () =
81
66
Eio_main.run @@ fun env ->
82
-
with_config env config_file @@ fun config ->
67
+
with_config env @@ fun config ->
83
68
let fs = Eio.Stdenv.fs env in
84
69
let proc = Eio.Stdenv.process_mgr env in
85
70
match Monopam.status ~proc ~fs ~config () with
86
71
| Ok statuses ->
87
72
Fmt.pr "%a@." Monopam.Status.pp_summary statuses;
73
+
(* Check for unregistered opam files *)
74
+
(match Monopam.discover_packages ~fs ~config () with
75
+
| Ok pkgs ->
76
+
let unregistered = Monopam.find_unregistered_opam_files ~fs ~config pkgs in
77
+
if unregistered <> [] then begin
78
+
Fmt.pr "@.";
79
+
Fmt.pr "@[<v>Warning: Found opam files not in overlay:@,";
80
+
List.iter (fun (repo, pkg) ->
81
+
Fmt.pr " %s/%s.opam@," repo pkg) unregistered;
82
+
Fmt.pr "Consider adding these packages to the opam overlay.@]@."
83
+
end
84
+
| Error _ -> ());
88
85
`Ok ()
89
86
| Error e ->
90
87
Fmt.epr "Error: %a@." Monopam.pp_error e;
91
88
`Error (false, "status failed")
92
89
in
93
-
Cmd.v info Term.(ret (const run $ config_file_arg $ logging_term))
90
+
Cmd.v info Term.(ret (const run $ logging_term))
94
91
95
92
(* Pull command *)
96
93
···
109
106
merges" );
110
107
`I ("2.", "Adds or pulls the git subtree into the monorepo");
111
108
`P
109
+
"If the opam-repo doesn't exist locally, it will be cloned from the \
110
+
URL registered for your account in the opamverse registry.";
111
+
`P
112
112
"If a specific package is given, only that package's repository is \
113
113
processed.";
114
114
`P "The operation will fail if any checkout has uncommitted changes.";
115
115
]
116
116
in
117
117
let info = Cmd.info "pull" ~doc ~man in
118
-
let run config_file package () =
118
+
let run package () =
119
119
Eio_main.run @@ fun env ->
120
-
with_config env config_file @@ fun config ->
120
+
with_config env @@ fun config ->
121
121
let fs = Eio.Stdenv.fs env in
122
122
let proc = Eio.Stdenv.process_mgr env in
123
-
match Monopam.pull ~proc ~fs ~config ?package () with
123
+
(* Look up opam-repo URL from registry using verse config *)
124
+
let opam_repo_url =
125
+
match Monopam.Verse_config.load ~fs () with
126
+
| Error _ -> None
127
+
| Ok verse_config ->
128
+
let handle = Monopam.Verse_config.handle verse_config in
129
+
match Monopam.Verse_registry.clone_or_pull ~proc ~fs ~config:verse_config () with
130
+
| Error _ -> None
131
+
| Ok registry ->
132
+
match Monopam.Verse_registry.find_member registry ~handle with
133
+
| None -> None
134
+
| Some member -> Some member.opamrepo
135
+
in
136
+
match Monopam.pull ~proc ~fs ~config ?package ?opam_repo_url () with
124
137
| Ok () ->
125
138
Fmt.pr "Pull completed.@.";
126
139
`Ok ()
···
129
142
`Error (false, "pull failed")
130
143
in
131
144
Cmd.v info
132
-
Term.(ret (const run $ config_file_arg $ package_arg $ logging_term))
145
+
Term.(ret (const run $ package_arg $ logging_term))
133
146
134
147
(* Push command *)
135
148
···
162
175
in
163
176
Arg.(value & flag & info [ "upstream" ] ~doc)
164
177
in
165
-
let run config_file package upstream () =
178
+
let run package upstream () =
166
179
Eio_main.run @@ fun env ->
167
-
with_config env config_file @@ fun config ->
180
+
with_config env @@ fun config ->
168
181
let fs = Eio.Stdenv.fs env in
169
182
let proc = Eio.Stdenv.process_mgr env in
170
183
match Monopam.push ~proc ~fs ~config ?package ~upstream () with
···
177
190
in
178
191
Cmd.v info
179
192
Term.(
180
-
ret (const run $ config_file_arg $ package_arg $ upstream_arg $ logging_term))
181
-
182
-
(* Extract command *)
183
-
184
-
let extract_cmd =
185
-
let doc = "Extract a subdirectory as a standalone repository" in
186
-
let man = [
187
-
`S Manpage.s_description;
188
-
`P "Extracts a subdirectory from the monorepo as a standalone git \
189
-
repository with full history. Enables 'develop first, extract later'.";
190
-
`P "The extraction process:";
191
-
`I ("1.", "Runs git subtree split to extract commits");
192
-
`I ("2.", "Creates a new git repository in checkouts");
193
-
`I ("3.", "Configures the remote URL");
194
-
`S "EXAMPLES";
195
-
`Pre " monopam extract my-lib --repo git@github.com:user/my-lib.git";
196
-
`Pre " monopam extract my-lib --repo git@github.com:user/my-lib.git --push";
197
-
] in
198
-
let info = Cmd.info "extract" ~doc ~man in
199
-
let subdir_arg =
200
-
let doc = "Subdirectory in monorepo to extract" in
201
-
Arg.(required & pos 0 (some string) None & info [] ~docv:"SUBDIR" ~doc)
202
-
in
203
-
let repo_arg =
204
-
let doc = "Git URL for the new repository" in
205
-
Arg.(required & opt (some string) None & info [ "repo"; "r" ] ~docv:"URL" ~doc)
206
-
in
207
-
let branch_arg =
208
-
let doc = "Branch name (default: from config)" in
209
-
Arg.(value & opt (some string) None & info [ "branch"; "b" ] ~docv:"BRANCH" ~doc)
210
-
in
211
-
let push_arg =
212
-
let doc = "Push to remote after extraction" in
213
-
Arg.(value & flag & info [ "push" ] ~doc)
214
-
in
215
-
let create_opam_arg =
216
-
let doc = "Create opam package metadata in overlay" in
217
-
Arg.(value & flag & info [ "create-opam" ] ~doc)
218
-
in
219
-
let run config_file subdir repo branch push create_opam () =
220
-
Eio_main.run @@ fun env ->
221
-
with_config env config_file @@ fun config ->
222
-
let fs = Eio.Stdenv.fs env in
223
-
let proc = Eio.Stdenv.process_mgr env in
224
-
match Monopam.extract ~proc ~fs ~config ~subdir ~repo_url:repo
225
-
?branch ~push ~create_opam () with
226
-
| Ok () -> `Ok ()
227
-
| Error e ->
228
-
Fmt.epr "Error: %a@." Monopam.pp_error e;
229
-
`Error (false, "extract failed")
230
-
in
231
-
Cmd.v info
232
-
Term.(ret (const run $ config_file_arg $ subdir_arg $ repo_arg
233
-
$ branch_arg $ push_arg $ create_opam_arg $ logging_term))
193
+
ret (const run $ package_arg $ upstream_arg $ logging_term))
234
194
235
195
(* Add command *)
236
196
···
250
210
let doc = "Package name to add" in
251
211
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
252
212
in
253
-
let run config_file package () =
213
+
let run package () =
254
214
Eio_main.run @@ fun env ->
255
-
with_config env config_file @@ fun config ->
215
+
with_config env @@ fun config ->
256
216
let fs = Eio.Stdenv.fs env in
257
217
let proc = Eio.Stdenv.process_mgr env in
258
218
match Monopam.add ~proc ~fs ~config ~package () with
···
264
224
`Error (false, "add failed")
265
225
in
266
226
Cmd.v info
267
-
Term.(ret (const run $ config_file_arg $ package_arg $ logging_term))
227
+
Term.(ret (const run $ package_arg $ logging_term))
268
228
269
229
(* Remove command *)
270
230
···
284
244
let doc = "Package name to remove" in
285
245
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
286
246
in
287
-
let run config_file package () =
247
+
let run package () =
288
248
Eio_main.run @@ fun env ->
289
-
with_config env config_file @@ fun config ->
249
+
with_config env @@ fun config ->
290
250
let fs = Eio.Stdenv.fs env in
291
251
let proc = Eio.Stdenv.process_mgr env in
292
252
match Monopam.remove ~proc ~fs ~config ~package () with
···
298
258
`Error (false, "remove failed")
299
259
in
300
260
Cmd.v info
301
-
Term.(ret (const run $ config_file_arg $ package_arg $ logging_term))
302
-
303
-
(* Init command *)
304
-
305
-
let prompt_path ~stdin ~stdout ~cwd prompt ~default =
306
-
let default_str =
307
-
match default with Some d -> Fmt.str " [%a]" Fpath.pp d | None -> ""
308
-
in
309
-
Eio.Flow.copy_string (Fmt.str "%s%s: " prompt default_str) stdout;
310
-
let input = String.trim (Eio.Buf_read.line stdin) in
311
-
let input =
312
-
if input = "" then Option.map Fpath.to_string default else Some input
313
-
in
314
-
match input with
315
-
| None -> Error "Path is required"
316
-
| Some s -> (
317
-
(* Expand tilde *)
318
-
let s =
319
-
if String.length s > 0 && s.[0] = '~' then
320
-
match Sys.getenv_opt "HOME" with
321
-
| Some home ->
322
-
if String.length s = 1 then home
323
-
else if s.[1] = '/' then
324
-
home ^ String.sub s 1 (String.length s - 1)
325
-
else s
326
-
| None -> s
327
-
else s
328
-
in
329
-
match Fpath.of_string s with
330
-
| Error (`Msg m) -> Error m
331
-
| Ok path ->
332
-
(* Convert relative to absolute using cwd *)
333
-
let path =
334
-
if Fpath.is_abs path then path else Fpath.(cwd // path |> normalize)
335
-
in
336
-
Ok path)
337
-
338
-
let init_cmd =
339
-
let doc = "Initialize a new monopam configuration" in
340
-
let man =
341
-
[
342
-
`S Manpage.s_description;
343
-
`P
344
-
"Interactively creates a monopam.toml configuration file in the \
345
-
current directory. Prompts for the paths to the opam overlay, \
346
-
checkouts directory, and monorepo directory.";
347
-
`P
348
-
"All paths must be absolute. You can use ~/ for your home directory, \
349
-
and relative paths will be converted to absolute based on the current \
350
-
working directory.";
351
-
]
352
-
in
353
-
let info = Cmd.info "init" ~doc ~man in
354
-
let output_arg =
355
-
let doc = "Output path for config file (default: monopam.toml)" in
356
-
Arg.(
357
-
value & opt string "monopam.toml"
358
-
& info [ "o"; "output" ] ~docv:"FILE" ~doc)
359
-
in
360
-
let run output () =
361
-
Eio_main.run @@ fun env ->
362
-
let _fs = Eio.Stdenv.fs env in
363
-
let cwd_path = Eio.Stdenv.cwd env in
364
-
let stdin =
365
-
Eio.Buf_read.of_flow ~max_size:(1024 * 1024) (Eio.Stdenv.stdin env)
366
-
in
367
-
let stdout = Eio.Stdenv.stdout env in
368
-
(* Get current working directory as Fpath *)
369
-
let cwd =
370
-
let _, cwd_str = (cwd_path :> _ Eio.Path.t) in
371
-
match Fpath.of_string cwd_str with Ok p -> p | Error _ -> Fpath.v "/"
372
-
in
373
-
Eio.Flow.copy_string "Monopam Configuration Setup\n" stdout;
374
-
Eio.Flow.copy_string "===========================\n\n" stdout;
375
-
Eio.Flow.copy_string
376
-
"All paths must be absolute. Use ~/ for home directory.\n" stdout;
377
-
Eio.Flow.copy_string "Relative paths will be converted to absolute.\n\n"
378
-
stdout;
379
-
(* Prompt for opam_repo *)
380
-
let opam_repo = ref None in
381
-
while !opam_repo = None do
382
-
match
383
-
prompt_path ~stdin ~stdout ~cwd "Path to opam overlay repository"
384
-
~default:None
385
-
with
386
-
| Ok p -> opam_repo := Some p
387
-
| Error msg ->
388
-
Eio.Flow.copy_string
389
-
(Fmt.str "Error: %s. Please try again.\n" msg)
390
-
stdout
391
-
done;
392
-
let opam_repo = Option.get !opam_repo in
393
-
(* Prompt for checkouts *)
394
-
let default_checkouts = Fpath.(parent opam_repo / "src") in
395
-
let checkouts = ref None in
396
-
while !checkouts = None do
397
-
match
398
-
prompt_path ~stdin ~stdout ~cwd "Path for git checkouts"
399
-
~default:(Some default_checkouts)
400
-
with
401
-
| Ok p -> checkouts := Some p
402
-
| Error msg ->
403
-
Eio.Flow.copy_string
404
-
(Fmt.str "Error: %s. Please try again.\n" msg)
405
-
stdout
406
-
done;
407
-
let checkouts = Option.get !checkouts in
408
-
(* Prompt for monorepo *)
409
-
let default_monorepo = Fpath.(parent opam_repo / "mono") in
410
-
let monorepo = ref None in
411
-
while !monorepo = None do
412
-
match
413
-
prompt_path ~stdin ~stdout ~cwd "Path for monorepo"
414
-
~default:(Some default_monorepo)
415
-
with
416
-
| Ok p -> monorepo := Some p
417
-
| Error msg ->
418
-
Eio.Flow.copy_string
419
-
(Fmt.str "Error: %s. Please try again.\n" msg)
420
-
stdout
421
-
done;
422
-
let monorepo = Option.get !monorepo in
423
-
(* Prompt for default branch *)
424
-
Eio.Flow.copy_string "Default git branch [main]: " stdout;
425
-
let branch_input = String.trim (Eio.Buf_read.line stdin) in
426
-
let default_branch = if branch_input = "" then "main" else branch_input in
427
-
(* Create config *)
428
-
let config =
429
-
Monopam.Config.create ~opam_repo ~checkouts ~monorepo ~default_branch ()
430
-
in
431
-
(* Save config *)
432
-
let output_path = Fpath.v output in
433
-
match
434
-
Monopam.Config.save ~fs:(cwd_path :> _ Eio.Path.t) config output_path
435
-
with
436
-
| Ok () ->
437
-
Eio.Flow.copy_string
438
-
(Fmt.str "\nConfiguration saved to %s\n" output)
439
-
stdout;
440
-
Eio.Flow.copy_string
441
-
"\nYou can now run 'monopam pull' to initialize the monorepo.\n"
442
-
stdout;
443
-
`Ok ()
444
-
| Error msg ->
445
-
Fmt.epr "Error saving config: %s@." msg;
446
-
`Error (false, "init failed")
447
-
in
448
-
Cmd.v info Term.(ret (const run $ output_arg $ logging_term))
261
+
Term.(ret (const run $ package_arg $ logging_term))
449
262
450
263
(* Changes command *)
451
264
···
511
324
let doc = "Skip generating .changes/YYYYMMDD.json aggregated file (--daily generates it by default)" in
512
325
Arg.(value & flag & info [ "no-aggregate" ] ~doc)
513
326
in
514
-
let run config_file package daily weeks days history dry_run no_aggregate () =
327
+
let run package daily weeks days history dry_run no_aggregate () =
515
328
Eio_main.run @@ fun env ->
516
-
with_config env config_file @@ fun config ->
329
+
with_config env @@ fun config ->
517
330
let fs = Eio.Stdenv.fs env in
518
331
let proc = Eio.Stdenv.process_mgr env in
519
332
let clock = Eio.Stdenv.clock env in
···
541
354
Cmd.v info
542
355
Term.(
543
356
ret
544
-
(const run $ config_file_arg $ package_arg $ daily $ weeks $ days $ history $ dry_run
357
+
(const run $ package_arg $ daily $ weeks $ days $ history $ dry_run
545
358
$ no_aggregate $ logging_term))
546
359
360
+
(* Verse commands *)
361
+
362
+
(* Helper to load verse config from XDG *)
363
+
let with_verse_config env f =
364
+
let fs = Eio.Stdenv.fs env in
365
+
match Monopam.Verse_config.load ~fs () with
366
+
| Ok config -> f config
367
+
| Error msg ->
368
+
Fmt.epr "Error loading opamverse config: %s@." msg;
369
+
Fmt.epr "Run 'monopam verse init' to create a workspace.@.";
370
+
`Error (false, "configuration error")
371
+
372
+
let verse_root_arg =
373
+
let doc = "Path to workspace root directory. Defaults to current directory." in
374
+
Arg.(
375
+
value
376
+
& opt (some (conv (Fpath.of_string, Fpath.pp))) None
377
+
& info [ "root" ] ~docv:"PATH" ~doc)
378
+
379
+
let verse_handle_arg =
380
+
let doc = "Tangled handle (e.g., alice.bsky.social)" in
381
+
Arg.(required & opt (some string) None & info [ "handle" ] ~docv:"HANDLE" ~doc)
382
+
383
+
let verse_handle_pos_arg =
384
+
let doc = "Tangled handle (e.g., alice.bsky.social)" in
385
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"HANDLE" ~doc)
386
+
387
+
let verse_handle_opt_pos_arg =
388
+
let doc = "Tangled handle. If not specified, operates on all tracked members." in
389
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"HANDLE" ~doc)
390
+
391
+
let verse_init_cmd =
392
+
let doc = "Initialize a new opamverse workspace" in
393
+
let man =
394
+
[
395
+
`S Manpage.s_description;
396
+
`P
397
+
"Creates a new opamverse workspace for federated monorepo collaboration. \
398
+
An opamverse workspace lets you browse and track other developers' \
399
+
monorepos alongside your own.";
400
+
`S "WORKSPACE STRUCTURE";
401
+
`P "The init command creates the following directory structure at the workspace root:";
402
+
`I ("mono/", "Your monorepo - use with standard monopam commands");
403
+
`I ("src/", "Your source checkouts - individual git repos");
404
+
`I ("verse/", "Other users' monorepos, organized by handle");
405
+
`P "Configuration and data are stored in XDG directories:";
406
+
`I ("~/.config/monopam/opamverse.toml", "Workspace configuration");
407
+
`I ("~/.local/share/monopam/opamverse-registry/", "Git clone of the community registry");
408
+
`S "CONFIGURATION FILE";
409
+
`P "The opamverse.toml file has the following structure:";
410
+
`Pre "[workspace]\n\
411
+
root = \"/path/to/workspace\"\n\
412
+
default_branch = \"main\"\n\n\
413
+
[paths]\n\
414
+
mono = \"mono\"\n\
415
+
src = \"src\"\n\
416
+
verse = \"verse\"\n\n\
417
+
[identity]\n\
418
+
handle = \"yourname.bsky.social\"";
419
+
`S "AUTHENTICATION";
420
+
`P
421
+
"Before running init, you must authenticate with the tangled network:";
422
+
`Pre "tangled auth login";
423
+
`P
424
+
"The handle you provide is validated against the AT Protocol identity \
425
+
system to ensure it exists and you are authenticated.";
426
+
`S "REGISTRY";
427
+
`P
428
+
"The opamverse registry is a git repository containing an opamverse.toml \
429
+
file that lists community members and their monorepo URLs. The default \
430
+
registry is at: https://tangled.org/eeg.cl.cam.ac.uk/opamverse";
431
+
`S Manpage.s_examples;
432
+
`P "Initialize a workspace in ~/tangled:";
433
+
`Pre "cd ~/tangled\n\
434
+
monopam verse init --handle alice.bsky.social";
435
+
`P "Initialize with explicit root path:";
436
+
`Pre "monopam verse init --root ~/my-workspace --handle alice.bsky.social";
437
+
]
438
+
in
439
+
let info = Cmd.info "init" ~doc ~man in
440
+
let run root handle () =
441
+
Eio_main.run @@ fun env ->
442
+
Eio.Switch.run @@ fun sw ->
443
+
let fs = Eio.Stdenv.fs env in
444
+
let proc = Eio.Stdenv.process_mgr env in
445
+
let root =
446
+
match root with
447
+
| Some r -> r
448
+
| None ->
449
+
let cwd_path = Eio.Stdenv.cwd env in
450
+
let _, cwd_str = (cwd_path :> _ Eio.Path.t) in
451
+
match Fpath.of_string cwd_str with
452
+
| Ok p -> p
453
+
| Error (`Msg _) -> Fpath.v "."
454
+
in
455
+
match Monopam.Verse.init ~proc ~fs ~sw ~env ~root ~handle () with
456
+
| Ok () ->
457
+
Fmt.pr "Monoverse workspace initialized at %a@." Fpath.pp root;
458
+
`Ok ()
459
+
| Error e ->
460
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
461
+
`Error (false, "init failed")
462
+
in
463
+
Cmd.v info Term.(ret (const run $ verse_root_arg $ verse_handle_arg $ logging_term))
464
+
465
+
let verse_status_cmd =
466
+
let doc = "Show workspace status" in
467
+
let man =
468
+
[
469
+
`S Manpage.s_description;
470
+
`P
471
+
"Displays the status of your opamverse workspace, including which \
472
+
members you're tracking and the git state of their local clones.";
473
+
`S "OUTPUT";
474
+
`P "For each tracked member, shows:";
475
+
`I ("handle", "The member's tangled handle (e.g., alice.bsky.social)");
476
+
`I ("monorepo URL", "Git URL of their monorepo");
477
+
`I ("status", "One of: not cloned, clean, dirty, ahead N/behind M");
478
+
`S "STATUS INDICATORS";
479
+
`I ("not cloned", "Member added but monorepo not yet cloned locally");
480
+
`I ("clean", "Local clone matches remote, no uncommitted changes");
481
+
`I ("dirty", "Local clone has uncommitted changes");
482
+
`I ("ahead N, behind M", "Local is N commits ahead and M commits behind remote");
483
+
`S Manpage.s_examples;
484
+
`Pre "$ monopam verse status\n\
485
+
Workspace: /home/user/tangled\n\
486
+
Registry: tangled-community\n\
487
+
Members:\n\
488
+
\ alice.bsky.social -> https://github.com/alice/mono [clean]\n\
489
+
\ bob.example.com -> https://github.com/bob/mono [ahead 2, behind 0]";
490
+
]
491
+
in
492
+
let info = Cmd.info "status" ~doc ~man in
493
+
let run () =
494
+
Eio_main.run @@ fun env ->
495
+
with_verse_config env @@ fun config ->
496
+
let fs = Eio.Stdenv.fs env in
497
+
let proc = Eio.Stdenv.process_mgr env in
498
+
match Monopam.Verse.status ~proc ~fs ~config () with
499
+
| Ok status ->
500
+
Fmt.pr "%a@." Monopam.Verse.pp_status status;
501
+
`Ok ()
502
+
| Error e ->
503
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
504
+
`Error (false, "status failed")
505
+
in
506
+
Cmd.v info Term.(ret (const run $ logging_term))
507
+
508
+
let verse_members_cmd =
509
+
let doc = "List registry members" in
510
+
let man =
511
+
[
512
+
`S Manpage.s_description;
513
+
`P
514
+
"Lists all members registered in the opamverse community registry. \
515
+
This shows everyone who has published their monorepo for collaboration.";
516
+
`P
517
+
"The registry is automatically pulled (git pull) when running this \
518
+
command to ensure you see the latest members.";
519
+
`S "REGISTRY FORMAT";
520
+
`P
521
+
"The registry is a git repository containing an opamverse.toml file \
522
+
with the following structure:";
523
+
`Pre "[registry]\n\
524
+
name = \"tangled-community\"\n\n\
525
+
[[members]]\n\
526
+
handle = \"alice.bsky.social\"\n\
527
+
monorepo = \"https://github.com/alice/mono\"\n\n\
528
+
[[members]]\n\
529
+
handle = \"bob.example.com\"\n\
530
+
monorepo = \"https://github.com/bob/mono\"";
531
+
`S "OUTPUT";
532
+
`P "Each line shows a member's handle and their monorepo git URL:";
533
+
`Pre "alice.bsky.social -> https://github.com/alice/mono\n\
534
+
bob.example.com -> https://github.com/bob/mono";
535
+
`S "ADDING YOURSELF";
536
+
`P
537
+
"To add yourself to the registry, submit a pull request to the \
538
+
registry repository adding your entry to opamverse.toml.";
539
+
]
540
+
in
541
+
let info = Cmd.info "members" ~doc ~man in
542
+
let run () =
543
+
Eio_main.run @@ fun env ->
544
+
with_verse_config env @@ fun config ->
545
+
let fs = Eio.Stdenv.fs env in
546
+
let proc = Eio.Stdenv.process_mgr env in
547
+
match Monopam.Verse.members ~proc ~fs ~config () with
548
+
| Ok members ->
549
+
Fmt.pr "@[<v>%a@]@."
550
+
Fmt.(list ~sep:cut Monopam.Verse_registry.pp_member)
551
+
members;
552
+
`Ok ()
553
+
| Error e ->
554
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
555
+
`Error (false, "members failed")
556
+
in
557
+
Cmd.v info Term.(ret (const run $ logging_term))
558
+
559
+
let verse_add_all_arg =
560
+
let doc = "Add all members from the registry." in
561
+
Arg.(value & flag & info [ "all" ] ~doc)
562
+
let verse_add_cmd =
563
+
let doc = "Add a member to the workspace" in
564
+
let man =
565
+
[
566
+
`S Manpage.s_description;
567
+
`P
568
+
"Adds a community member's monorepo to your workspace by cloning it \
569
+
to the verse/<handle>/ directory.";
570
+
`P
571
+
"With --all, adds all members from the registry that are not already \
572
+
tracked in your workspace.";
573
+
`S "PROCESS";
574
+
`P "The add command performs the following steps:";
575
+
`I ("1.", "Validates the handle against the tangled network (AT Protocol)");
576
+
`I ("2.", "Looks up the handle in the opamverse registry");
577
+
`I ("3.", "Clones their monorepo to verse/<handle>/");
578
+
`S "HANDLE VALIDATION";
579
+
`P
580
+
"Handles are validated against the AT Protocol identity system to \
581
+
ensure they exist. This requires prior authentication:";
582
+
`Pre "tangled auth login";
583
+
`S "AFTER ADDING";
584
+
`P
585
+
"Once added, you can browse the member's code in verse/<handle>/. \
586
+
Their monorepo follows the same structure as yours (managed by monopam), \
587
+
so you can explore their packages and dependencies.";
588
+
`P "Use 'monopam verse pull <handle>' to fetch updates later.";
589
+
`S Manpage.s_examples;
590
+
`Pre "# Add a member\n\
591
+
monopam verse add alice.bsky.social\n\n\
592
+
# Add all members from the registry\n\
593
+
monopam verse add --all\n\n\
594
+
# Browse their code\n\
595
+
ls verse/alice.bsky.social/\n\
596
+
cd verse/alice.bsky.social && dune build";
597
+
`S "ERRORS";
598
+
`I ("Member not found", "The handle is not in the registry - they need to register first");
599
+
`I ("Handle not found", "The handle doesn't exist on the tangled network");
600
+
`I ("Not authenticated", "Run 'tangled auth login' first");
601
+
]
602
+
in
603
+
let info = Cmd.info "add" ~doc ~man in
604
+
let run handle all () =
605
+
Eio_main.run @@ fun env ->
606
+
Eio.Switch.run @@ fun sw ->
607
+
with_verse_config env @@ fun config ->
608
+
let fs = Eio.Stdenv.fs env in
609
+
let proc = Eio.Stdenv.process_mgr env in
610
+
match (handle, all) with
611
+
| None, false ->
612
+
Fmt.epr "Error: Either provide a HANDLE or use --all@.";
613
+
`Error (true, "missing argument")
614
+
| Some _, true ->
615
+
Fmt.epr "Error: Cannot use --all with a specific handle@.";
616
+
`Error (true, "conflicting arguments")
617
+
| Some handle, false ->
618
+
(match Monopam.Verse.add ~proc ~fs ~sw ~env ~config ~handle () with
619
+
| Ok () ->
620
+
Fmt.pr "Added %s to workspace.@." handle;
621
+
`Ok ()
622
+
| Error e ->
623
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
624
+
`Error (false, "add failed"))
625
+
| None, true ->
626
+
(match Monopam.Verse.add_all ~proc ~fs ~sw ~env ~config () with
627
+
| Ok members ->
628
+
Fmt.pr "Added %d members to workspace.@." (List.length members);
629
+
`Ok ()
630
+
| Error e ->
631
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
632
+
`Error (false, "add --all failed"))
633
+
in
634
+
Cmd.v info Term.(ret (const run $ verse_handle_opt_pos_arg $ verse_add_all_arg $ logging_term))
635
+
636
+
let verse_remove_cmd =
637
+
let doc = "Remove a member from the workspace" in
638
+
let man =
639
+
[
640
+
`S Manpage.s_description;
641
+
`P
642
+
"Removes a member's monorepo from your workspace by deleting the \
643
+
verse/<handle>/ directory.";
644
+
`P
645
+
"This is a local operation - it only affects your workspace. The \
646
+
member remains in the registry and can be re-added later.";
647
+
`S "WARNING";
648
+
`P
649
+
"This permanently deletes the local clone. Any local changes you \
650
+
made in verse/<handle>/ will be lost. If you have uncommitted work, \
651
+
commit and push it first (if you have write access) or back it up.";
652
+
`S Manpage.s_examples;
653
+
`Pre "# Remove a member\n\
654
+
monopam verse remove alice.bsky.social\n\n\
655
+
# Re-add them later if needed\n\
656
+
monopam verse add alice.bsky.social";
657
+
]
658
+
in
659
+
let info = Cmd.info "remove" ~doc ~man in
660
+
let run handle () =
661
+
Eio_main.run @@ fun env ->
662
+
with_verse_config env @@ fun config ->
663
+
let fs = Eio.Stdenv.fs env in
664
+
match Monopam.Verse.remove ~fs ~config ~handle () with
665
+
| Ok () ->
666
+
Fmt.pr "Removed %s from workspace.@." handle;
667
+
`Ok ()
668
+
| Error e ->
669
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
670
+
`Error (false, "remove failed")
671
+
in
672
+
Cmd.v info Term.(ret (const run $ verse_handle_pos_arg $ logging_term))
673
+
674
+
let verse_pull_cmd =
675
+
let doc = "Pull updates for tracked members" in
676
+
let man =
677
+
[
678
+
`S Manpage.s_description;
679
+
`P
680
+
"Fetches and merges git updates for tracked members' monorepos. \
681
+
This runs 'git pull' in each member's directory under verse/.";
682
+
`S "SCOPE";
683
+
`P "With a handle argument: pulls only that specific member.";
684
+
`P "Without arguments: pulls all tracked members in verse/.";
685
+
`S "TRACKED MEMBERS";
686
+
`P
687
+
"A member is 'tracked' if their directory exists under verse/. \
688
+
This happens after running 'monopam verse add <handle>'.";
689
+
`S "ERROR HANDLING";
690
+
`P
691
+
"If a pull fails for one member (e.g., merge conflict), the error \
692
+
is reported but other members are still pulled.";
693
+
`P
694
+
"Resolve conflicts manually in verse/<handle>/ and commit, or use \
695
+
'git reset --hard origin/main' to discard local changes.";
696
+
`S Manpage.s_examples;
697
+
`Pre "# Pull all tracked members\n\
698
+
monopam verse pull\n\n\
699
+
# Pull a specific member\n\
700
+
monopam verse pull alice.bsky.social";
701
+
]
702
+
in
703
+
let info = Cmd.info "pull" ~doc ~man in
704
+
let run handle () =
705
+
Eio_main.run @@ fun env ->
706
+
with_verse_config env @@ fun config ->
707
+
let fs = Eio.Stdenv.fs env in
708
+
let proc = Eio.Stdenv.process_mgr env in
709
+
match Monopam.Verse.pull ~proc ~fs ~config ?handle () with
710
+
| Ok () ->
711
+
Fmt.pr "Pull completed.@.";
712
+
`Ok ()
713
+
| Error e ->
714
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
715
+
`Error (false, "pull failed")
716
+
in
717
+
Cmd.v info Term.(ret (const run $ verse_handle_opt_pos_arg $ logging_term))
718
+
719
+
let verse_sync_cmd =
720
+
let doc = "Sync the workspace" in
721
+
let man =
722
+
[
723
+
`S Manpage.s_description;
724
+
`P
725
+
"Synchronizes your entire opamverse workspace with the latest upstream \
726
+
changes. This is the command to run regularly to stay up to date.";
727
+
`S "WHAT IT DOES";
728
+
`P "The sync command performs two operations:";
729
+
`I ("1.", "Updates the registry: git pull in ~/.local/share/monopam/opamverse-registry/");
730
+
`I ("2.", "Pulls all tracked members: git pull in each verse/<handle>/");
731
+
`S "USE CASES";
732
+
`P "Run sync when you want to:";
733
+
`I ("-", "See if any new members have joined the community");
734
+
`I ("-", "Get the latest code from all tracked members");
735
+
`I ("-", "Catch up after being away for a while");
736
+
`S "COMPARISON WITH PULL";
737
+
`P
738
+
"'verse sync' updates the registry AND pulls members. \
739
+
'verse pull' only pulls members (skips registry update).";
740
+
`S Manpage.s_examples;
741
+
`Pre "# Daily sync routine\n\
742
+
cd ~/tangled\n\
743
+
monopam verse sync\n\
744
+
monopam verse status";
745
+
]
746
+
in
747
+
let info = Cmd.info "sync" ~doc ~man in
748
+
let run () =
749
+
Eio_main.run @@ fun env ->
750
+
with_verse_config env @@ fun config ->
751
+
let fs = Eio.Stdenv.fs env in
752
+
let proc = Eio.Stdenv.process_mgr env in
753
+
match Monopam.Verse.sync ~proc ~fs ~config () with
754
+
| Ok () ->
755
+
Fmt.pr "Sync completed.@.";
756
+
`Ok ()
757
+
| Error e ->
758
+
Fmt.epr "Error: %a@." Monopam.Verse.pp_error e;
759
+
`Error (false, "sync failed")
760
+
in
761
+
Cmd.v info Term.(ret (const run $ logging_term))
762
+
763
+
let verse_cmd =
764
+
let doc = "Federated monorepo collaboration" in
765
+
let man =
766
+
[
767
+
`S Manpage.s_description;
768
+
`P
769
+
"The opamverse system enables federated collaboration across multiple \
770
+
developers' monorepos. Each developer maintains their own monorepo \
771
+
(managed by standard monopam commands), and can track other developers' \
772
+
monorepos for code browsing, learning, and collaboration.";
773
+
`P
774
+
"Members are identified by tangled handles - decentralized identities \
775
+
from the AT Protocol network (the same system used by Bluesky).";
776
+
`S "QUICK START FOR NEW USERS";
777
+
`P "Run these commands in order to get started:";
778
+
`Pre "# Step 1: Authenticate with tangled (one-time setup)\n\
779
+
tangled auth login\n\n\
780
+
# Step 2: Create and initialize your workspace\n\
781
+
mkdir ~/tangled && cd ~/tangled\n\
782
+
monopam verse init --handle yourname.bsky.social\n\n\
783
+
# Step 3: Browse available community members\n\
784
+
monopam verse members\n\n\
785
+
# Step 4: Add a member to track their monorepo\n\
786
+
monopam verse add alice.bsky.social\n\n\
787
+
# Step 5: Browse their code\n\
788
+
ls verse/alice.bsky.social/\n\
789
+
cd verse/alice.bsky.social && dune build\n\n\
790
+
# Step 6: Keep everything updated (run daily/weekly)\n\
791
+
monopam verse sync";
792
+
`S "KEY CONCEPTS";
793
+
`I ("Workspace", "A directory containing your monorepo plus tracked members' monorepos");
794
+
`I ("Registry", "A git repository listing community members and their monorepo URLs");
795
+
`I ("Handle", "A tangled identity like 'alice.bsky.social' validated via AT Protocol");
796
+
`I ("Tracking", "Cloning another member's monorepo to your verse/ directory");
797
+
`S "WORKSPACE STRUCTURE";
798
+
`P "An opamverse workspace has this layout:";
799
+
`Pre "~/tangled/ # workspace root\n\
800
+
├── mono/ # YOUR monorepo (use monopam pull/push here)\n\
801
+
├── src/ # YOUR fork checkouts\n\
802
+
└── verse/\n\
803
+
\ ├── alice.bsky.social/ # Alice's monorepo (read-only tracking)\n\
804
+
\ └── bob.example.com/ # Bob's monorepo (read-only tracking)";
805
+
`P "Configuration and data are stored in XDG directories:";
806
+
`Pre "~/.config/monopam/\n\
807
+
└── opamverse.toml # workspace configuration\n\n\
808
+
~/.local/share/monopam/\n\
809
+
└── opamverse-registry/ # cloned registry git repo";
810
+
`S "COMMAND FLOW";
811
+
`P "The expected sequence of commands for typical workflows:";
812
+
`P "$(b,First-time setup) (once per machine):";
813
+
`Pre "tangled auth login # authenticate\n\
814
+
monopam verse init --handle you.bsky.social # create workspace";
815
+
`P "$(b,Adding members to track):";
816
+
`Pre "monopam verse members # list available members\n\
817
+
monopam verse add alice.bsky.social # clone their monorepo\n\
818
+
monopam verse status # verify it was added";
819
+
`P "$(b,Daily maintenance):";
820
+
`Pre "monopam verse sync # update everything\n\
821
+
monopam verse status # check for changes";
822
+
`P "$(b,Working in your own monorepo):";
823
+
`Pre "cd ~/tangled/mono\n\
824
+
monopam pull # fetch upstream changes\n\
825
+
# ... make edits ...\n\
826
+
monopam push # export to checkouts";
827
+
`S "INTEGRATION WITH MONOPAM";
828
+
`P
829
+
"The verse system complements standard monopam commands. Your mono/ \
830
+
directory works exactly like a normal monopam-managed monorepo:";
831
+
`Pre "# Work in your monorepo\n\
832
+
cd ~/tangled/mono\n\
833
+
monopam status\n\
834
+
monopam pull\n\
835
+
# ... make changes ...\n\
836
+
monopam push";
837
+
`P
838
+
"The verse/ directories are for reading and learning from others' code. \
839
+
You generally don't push to them (unless you're a collaborator).";
840
+
`S "REGISTRY FORMAT";
841
+
`P
842
+
"The registry is a git repository containing opamverse.toml:";
843
+
`Pre "[registry]\n\
844
+
name = \"tangled-community\"\n\n\
845
+
[[members]]\n\
846
+
handle = \"alice.bsky.social\"\n\
847
+
monorepo = \"https://github.com/alice/mono\"";
848
+
`P
849
+
"Default registry: https://tangled.org/eeg.cl.cam.ac.uk/opamverse";
850
+
`S "COMMANDS REFERENCE";
851
+
`I ("init", "Create a new workspace with config and directories");
852
+
`I ("status", "Show tracked members and their git status");
853
+
`I ("members", "List all members in the registry");
854
+
`I ("add <handle>", "Clone a member's monorepo to verse/");
855
+
`I ("remove <handle>", "Delete a member's local clone");
856
+
`I ("pull [<handle>]", "Git pull tracked member(s)");
857
+
`I ("sync", "Update registry and pull all members");
858
+
`S "AUTHENTICATION";
859
+
`P
860
+
"Handle validation uses the AT Protocol identity system. The tangled \
861
+
CLI stores session credentials that monopam verse commands reuse.";
862
+
`P "If you see 'Not authenticated', run:";
863
+
`Pre "tangled auth login";
864
+
]
865
+
in
866
+
let info = Cmd.info "verse" ~doc ~man in
867
+
Cmd.group info
868
+
[
869
+
verse_init_cmd;
870
+
verse_status_cmd;
871
+
verse_members_cmd;
872
+
verse_add_cmd;
873
+
verse_remove_cmd;
874
+
verse_pull_cmd;
875
+
verse_sync_cmd;
876
+
]
877
+
547
878
(* Main command group *)
548
879
549
880
let main_cmd =
···
586
917
"Review changes in src/*/, then git push each one" );
587
918
`S "CONFIGURATION";
588
919
`P
589
-
"Run $(b,monopam init) to interactively create a configuration file. \
590
-
Configuration is read from monopam.toml in the current directory or \
591
-
XDG config locations.";
592
-
`P "All paths in the configuration must be absolute. Example:";
920
+
"Run $(b,monopam verse init --handle <handle>) to create a workspace. \
921
+
Configuration is stored in ~/.config/monopam/opamverse.toml and \
922
+
all paths are derived from the workspace root.";
923
+
`P "Workspace structure:";
593
924
`Pre
594
-
"opam_repo = \"/home/user/opam-overlay\"\n\
595
-
checkouts = \"/home/user/src\"\n\
596
-
monorepo = \"/home/user/mono\"\n\
597
-
default_branch = \"main\"";
925
+
"root/\n\
926
+
├── mono/ # Your monorepo\n\
927
+
├── src/ # Git checkouts\n\
928
+
├── opam-repo/ # Opam overlay\n\
929
+
└── verse/ # Other members' monorepos";
598
930
`S Manpage.s_commands;
599
931
`P "Use $(b,monopam COMMAND --help) for help on a specific command.";
600
932
]
601
933
in
602
934
let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in
603
935
Cmd.group info
604
-
[ init_cmd; status_cmd; pull_cmd; push_cmd; extract_cmd; add_cmd; remove_cmd; changes_cmd ]
936
+
[ status_cmd; pull_cmd; push_cmd; add_cmd; remove_cmd; changes_cmd; verse_cmd ]
605
937
606
938
let () = exit (Cmd.eval main_cmd)
+1
-1
monopam/lib/dune
+1
-1
monopam/lib/dune
···
1
1
(library
2
2
(name monopam)
3
3
(public_name monopam)
4
-
(libraries eio tomlt tomlt.eio xdge opam-file-format fmt logs uri fpath claude jsont jsont.bytesrw ptime ptime.clock.os))
4
+
(libraries eio tomlt tomlt.eio xdge opam-file-format fmt logs uri fpath claude jsont jsont.bytesrw ptime ptime.clock.os tangled xrpc-auth))
+4
-2
monopam/lib/git.ml
+4
-2
monopam/lib/git.ml
···
57
57
58
58
let is_repo ~proc ~fs path =
59
59
let cwd = path_to_eio ~fs path in
60
-
let result = run_git ~proc ~cwd [ "rev-parse"; "--git-dir" ] in
61
-
result.exit_code = 0
60
+
try
61
+
let result = run_git ~proc ~cwd [ "rev-parse"; "--git-dir" ] in
62
+
result.exit_code = 0
63
+
with Eio.Io _ -> false (* Directory doesn't exist or not accessible *)
62
64
63
65
let is_dirty ~proc ~fs path =
64
66
let cwd = path_to_eio ~fs path in
+108
-123
monopam/lib/monopam.ml
+108
-123
monopam/lib/monopam.ml
···
4
4
module Git = Git
5
5
module Status = Status
6
6
module Changes = Changes
7
+
module Verse = Verse
8
+
module Verse_config = Verse_config
9
+
module Verse_registry = Verse_registry
7
10
8
11
let src = Logs.Src.create "monopam" ~doc:"Monopam operations"
9
12
···
16
19
| Dirty_state of Package.t list
17
20
| Package_not_found of string
18
21
| Claude_error of string
19
-
| Subdir_not_found of string
20
-
| Checkout_exists of Fpath.t
21
22
22
23
let pp_error ppf = function
23
24
| Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg
···
29
30
pkgs
30
31
| Package_not_found name -> Fmt.pf ppf "Package not found: %s" name
31
32
| Claude_error msg -> Fmt.pf ppf "Claude error: %s" msg
32
-
| Subdir_not_found name -> Fmt.pf ppf "Subdirectory not found: %s" name
33
-
| Checkout_exists path -> Fmt.pf ppf "Checkout already exists: %a" Fpath.pp path
34
33
35
34
let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t =
36
35
let dir, _ = fs in
···
77
76
ensure_checkouts_dir ~fs ~config;
78
77
discover_packages ~fs:(fs :> _ Eio.Path.t) ~config ()
79
78
|> Result.map (Status.compute_all ~proc ~fs ~config)
79
+
80
+
(** Find opam files in monorepo subtrees that aren't registered in the overlay.
81
+
Returns a list of (subtree_name, unregistered_package_name) pairs. *)
82
+
let find_unregistered_opam_files ~fs ~config pkgs =
83
+
let fs = fs_typed fs in
84
+
let monorepo = Config.Paths.monorepo config in
85
+
(* Group registered packages by repo name *)
86
+
let registered_by_repo = Hashtbl.create 16 in
87
+
List.iter
88
+
(fun pkg ->
89
+
let repo = Package.repo_name pkg in
90
+
let name = Package.name pkg in
91
+
let existing = try Hashtbl.find registered_by_repo repo with Not_found -> [] in
92
+
Hashtbl.replace registered_by_repo repo (name :: existing))
93
+
pkgs;
94
+
(* Get unique subtree directories *)
95
+
let seen_repos = Hashtbl.create 16 in
96
+
let repos =
97
+
List.filter
98
+
(fun pkg ->
99
+
let repo = Package.repo_name pkg in
100
+
if Hashtbl.mem seen_repos repo then false
101
+
else begin
102
+
Hashtbl.add seen_repos repo ();
103
+
true
104
+
end)
105
+
pkgs
106
+
in
107
+
(* For each subtree, find opam files not in the registry *)
108
+
List.concat_map
109
+
(fun pkg ->
110
+
let repo = Package.repo_name pkg in
111
+
let subtree_dir = Fpath.(monorepo / Package.subtree_prefix pkg) in
112
+
let eio_path = Eio.Path.(fs / Fpath.to_string subtree_dir) in
113
+
let registered = try Hashtbl.find registered_by_repo repo with Not_found -> [] in
114
+
try
115
+
Eio.Path.read_dir eio_path
116
+
|> List.filter_map (fun name ->
117
+
if Filename.check_suffix name ".opam" then
118
+
let pkg_name = Filename.chop_suffix name ".opam" in
119
+
if List.mem pkg_name registered then None
120
+
else Some (repo, pkg_name)
121
+
else None)
122
+
with Eio.Io _ -> [])
123
+
repos
80
124
81
125
let get_branch ~config pkg =
82
126
let default = Config.default_branch config in
···
231
275
root.opam
232
276
|}
233
277
234
-
(** Collect all external dependencies from packages.
278
+
(** Collect all external dependencies by scanning monorepo subtree directories.
279
+
This scans all .opam files in each subtree directory to find dependencies,
280
+
ensuring we get dependencies from all packages in a directory, not just
281
+
those registered in the opam overlay.
235
282
Returns a sorted, deduplicated list of package names that are dependencies
236
283
but not packages in the repo itself. *)
237
-
let collect_external_deps pkgs =
238
-
let pkg_names = List.map Package.name pkgs in
284
+
let collect_external_deps ~fs ~config pkgs =
285
+
let monorepo = Config.Paths.monorepo config in
286
+
(* Get unique repos to avoid scanning the same directory multiple times *)
287
+
let seen = Hashtbl.create 16 in
288
+
let repos =
289
+
List.filter
290
+
(fun pkg ->
291
+
let repo = Package.repo_name pkg in
292
+
if Hashtbl.mem seen repo then false
293
+
else begin
294
+
Hashtbl.add seen repo ();
295
+
true
296
+
end)
297
+
pkgs
298
+
in
299
+
(* Scan each subtree directory for .opam files and collect dependencies *)
239
300
let all_deps =
240
-
List.concat_map Package.depends pkgs
301
+
List.concat_map
302
+
(fun pkg ->
303
+
let subtree_dir = Fpath.(monorepo / Package.subtree_prefix pkg) in
304
+
Opam_repo.scan_opam_files_for_deps ~fs subtree_dir)
305
+
repos
306
+
|> List.sort_uniq String.compare
307
+
in
308
+
(* Get all package names from all .opam files in monorepo *)
309
+
let pkg_names =
310
+
List.concat_map
311
+
(fun pkg ->
312
+
let subtree_dir = Fpath.(monorepo / Package.subtree_prefix pkg) in
313
+
let eio_path = Eio.Path.(fs / Fpath.to_string subtree_dir) in
314
+
try
315
+
Eio.Path.read_dir eio_path
316
+
|> List.filter_map (fun name ->
317
+
if Filename.check_suffix name ".opam" then
318
+
Some (Filename.chop_suffix name ".opam")
319
+
else None)
320
+
with Eio.Io _ -> [])
321
+
repos
241
322
|> List.sort_uniq String.compare
242
323
in
243
324
(* Filter out packages that are in the repo *)
···
245
326
246
327
(** Generate dune-project content for the monorepo root.
247
328
Lists all external dependencies as a virtual package. *)
248
-
let generate_dune_project pkgs =
249
-
let external_deps = collect_external_deps pkgs in
329
+
let generate_dune_project ~fs ~config pkgs =
330
+
let external_deps = collect_external_deps ~fs ~config pkgs in
250
331
let buf = Buffer.create 1024 in
251
332
Buffer.add_string buf "(lang dune 3.20)\n";
252
333
Buffer.add_string buf "(name root)\n";
···
270
351
let monorepo = Config.Paths.monorepo config in
271
352
let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
272
353
let dune_project_path = Eio.Path.(monorepo_eio / "dune-project") in
273
-
let content = generate_dune_project pkgs in
354
+
let content = generate_dune_project ~fs ~config pkgs in
274
355
(* Check if dune-project already exists with same content *)
275
356
let needs_update =
276
357
match Eio.Path.load dune_project_path with
···
295
376
ignore (Eio.Process.await child));
296
377
Log.app (fun m ->
297
378
m "Updated dune-project with %d external dependencies"
298
-
(List.length (collect_external_deps pkgs)))
379
+
(List.length (collect_external_deps ~fs ~config pkgs)))
299
380
end
300
381
301
382
let ensure_monorepo_initialized ~proc ~fs ~config =
···
525
606
| Ok ab -> ab.behind
526
607
| Error _ -> 0
527
608
528
-
let pull ~proc ~fs ~config ?package () =
609
+
let pull ~proc ~fs ~config ?package ?opam_repo_url () =
529
610
let fs_t = fs_typed fs in
530
-
(* Update the opam repo first *)
611
+
(* Update the opam repo first - clone if needed *)
531
612
let opam_repo = Config.Paths.opam_repo config in
532
613
if Git.is_repo ~proc ~fs:fs_t opam_repo then begin
533
614
Log.info (fun m -> m "Updating opam repo at %a" Fpath.pp opam_repo);
···
540
621
| Ok () -> ()
541
622
| Error e ->
542
623
Log.warn (fun m -> m "Failed to update opam repo: %a" Git.pp_error e)
624
+
end
625
+
else begin
626
+
(* Opam repo doesn't exist - clone it if we have a URL *)
627
+
match opam_repo_url with
628
+
| Some url ->
629
+
Log.info (fun m -> m "Cloning opam repo from %s to %a" url Fpath.pp opam_repo);
630
+
let url = Uri.of_string url in
631
+
let branch = Config.default_branch config in
632
+
(match Git.clone ~proc ~fs:fs_t ~url ~branch opam_repo with
633
+
| Ok () -> Log.info (fun m -> m "Opam repo cloned successfully")
634
+
| Error e -> Log.warn (fun m -> m "Failed to clone opam repo: %a" Git.pp_error e))
635
+
| None ->
636
+
Log.info (fun m -> m "Opam repo at %a does not exist and no URL provided" Fpath.pp opam_repo)
543
637
end;
544
638
(* Ensure directories exist before computing status *)
545
639
ensure_checkouts_dir ~fs:fs_t ~config;
···
835
929
end
836
930
else Ok ()
837
931
end
838
-
end
839
-
840
-
let create_opam_package ~fs ~config ~name ~repo_url =
841
-
let opam_repo = Config.Paths.opam_repo config in
842
-
let pkg_dir = Fpath.(opam_repo / "packages" / name / (name ^ ".dev")) in
843
-
let opam_file = Fpath.(pkg_dir / "opam") in
844
-
let content = Printf.sprintf {|opam-version: "2.0"
845
-
name: "%s"
846
-
version: "dev"
847
-
synopsis: "TODO: Add synopsis"
848
-
dev-repo: "git+%s"
849
-
depends: [
850
-
"dune" {>= "3.0"}
851
-
"ocaml" {>= "4.14"}
852
-
]
853
-
build: [
854
-
["dune" "build" "-p" name "-j" jobs]
855
-
]
856
-
|} name repo_url in
857
-
let pkg_dir_eio = Eio.Path.(fs / Fpath.to_string pkg_dir) in
858
-
mkdirs pkg_dir_eio;
859
-
let opam_eio = Eio.Path.(fs / Fpath.to_string opam_file) in
860
-
Eio.Path.save ~create:(`Or_truncate 0o644) opam_eio content;
861
-
Log.app (fun m -> m "Created opam package at %a" Fpath.pp opam_file);
862
-
Ok ()
863
-
864
-
let extract ~proc ~fs ~config ~subdir ~repo_url ?branch ?(push = false)
865
-
?(create_opam = false) () =
866
-
let ( let* ) r f = Result.bind (Result.map_error (fun e -> Git_error e) r) f in
867
-
let fs = fs_typed fs in
868
-
let monorepo = Config.Paths.monorepo config in
869
-
let checkouts_root = Config.Paths.checkouts config in
870
-
let checkout_dir = Fpath.(checkouts_root / subdir) in
871
-
let branch = Option.value branch ~default:(Config.default_branch config) in
872
-
873
-
(* Validate: subdir exists in monorepo *)
874
-
if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix:subdir) then
875
-
Error (Subdir_not_found subdir)
876
-
else
877
-
(* Validate: checkout doesn't already exist *)
878
-
let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in
879
-
let checkout_exists =
880
-
match Eio.Path.kind ~follow:true checkout_eio with
881
-
| `Directory -> true | _ -> false | exception _ -> false
882
-
in
883
-
if checkout_exists then Error (Checkout_exists checkout_dir)
884
-
else
885
-
(* Validate: monorepo is clean *)
886
-
if Git.is_dirty ~proc ~fs monorepo then
887
-
Error (Git_error (Git.Dirty_worktree monorepo))
888
-
else begin
889
-
ensure_checkouts_dir ~fs ~config;
890
-
891
-
(* Step 1: Split the subtree history *)
892
-
Log.info (fun m -> m "Splitting subtree history for %s" subdir);
893
-
let* split_commit = Git.Subtree.split ~proc ~fs ~repo:monorepo ~prefix:subdir () in
894
-
Log.info (fun m -> m "Split commit: %s" split_commit);
895
-
896
-
(* Step 2: Create new repo from split *)
897
-
Log.info (fun m -> m "Creating checkout at %a" Fpath.pp checkout_dir);
898
-
let* () = Git.init ~proc ~fs checkout_dir in
899
-
let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in
900
-
let monorepo_path = Fpath.to_string monorepo in
901
-
902
-
(* Fetch split commit from monorepo *)
903
-
let* _ = run_git_in ~proc ~cwd:checkout_eio
904
-
[ "fetch"; monorepo_path; split_commit ] in
905
-
let* _ = run_git_in ~proc ~cwd:checkout_eio
906
-
[ "checkout"; "-b"; branch; "FETCH_HEAD" ] in
907
-
908
-
(* Step 3: Add origin remote *)
909
-
Log.info (fun m -> m "Adding remote origin: %s" repo_url);
910
-
let* _ = run_git_in ~proc ~cwd:checkout_eio
911
-
[ "remote"; "add"; "origin"; repo_url ] in
912
-
913
-
(* Step 4: Optionally push *)
914
-
let push_result =
915
-
if push then begin
916
-
Log.info (fun m -> m "Pushing to %s" repo_url);
917
-
Git.push_remote ~proc ~fs ~branch checkout_dir
918
-
|> Result.map_error (fun e -> Git_error e)
919
-
end else Ok ()
920
-
in
921
-
match push_result with
922
-
| Error e -> Error e
923
-
| Ok () ->
924
-
925
-
(* Step 5: Optionally create opam metadata *)
926
-
let create_opam_result =
927
-
if create_opam then
928
-
create_opam_package ~fs ~config ~name:subdir ~repo_url
929
-
else Ok ()
930
-
in
931
-
match create_opam_result with
932
-
| Error e -> Error e
933
-
| Ok () ->
934
-
935
-
(* Print summary *)
936
-
Log.app (fun m -> m "Extracted %s to %a" subdir Fpath.pp checkout_dir);
937
-
Log.app (fun m -> m "");
938
-
Log.app (fun m -> m "Next steps:");
939
-
if not push then begin
940
-
Log.app (fun m -> m " 1. Create the remote repository");
941
-
Log.app (fun m -> m " 2. Push: cd %a && git push -u origin %s"
942
-
Fpath.pp checkout_dir branch)
943
-
end;
944
-
if not create_opam then
945
-
Log.app (fun m -> m " 3. Add opam package metadata to enable push/pull");
946
-
Ok ()
947
932
end
948
933
949
934
let add ~proc ~fs ~config ~package () =
+26
-36
monopam/lib/monopam.mli
+26
-36
monopam/lib/monopam.mli
···
28
28
module Git = Git
29
29
module Status = Status
30
30
module Changes = Changes
31
+
module Verse = Verse
32
+
module Verse_config = Verse_config
33
+
module Verse_registry = Verse_registry
31
34
32
35
(** {1 High-Level Operations} *)
33
36
···
40
43
(** Operation blocked due to dirty packages *)
41
44
| Package_not_found of string (** Named package not found in opam repo *)
42
45
| Claude_error of string (** Claude API or response parsing error *)
43
-
| Subdir_not_found of string (** Subdirectory not found in monorepo *)
44
-
| Checkout_exists of Fpath.t (** Checkout already exists at path *)
45
46
46
47
val pp_error : error Fmt.t
47
48
(** [pp_error] formats errors. *)
···
68
69
fs:Eio.Fs.dir_ty Eio.Path.t ->
69
70
config:Config.t ->
70
71
?package:string ->
72
+
?opam_repo_url:string ->
71
73
unit ->
72
74
(unit, error) result
73
-
(** [pull ~proc ~fs ~config ?package ()] pulls updates from remotes.
75
+
(** [pull ~proc ~fs ~config ?package ?opam_repo_url ()] pulls updates from remotes.
74
76
75
77
For each package (or the specified package): 1. Clones or fetches the
76
78
individual checkout 2. Adds or pulls the subtree in the monorepo
77
79
80
+
If the opam-repo doesn't exist locally and [opam_repo_url] is provided,
81
+
clones it from that URL first.
82
+
78
83
Aborts if any checkout or the monorepo has uncommitted changes.
79
84
80
85
@param proc Eio process manager
81
86
@param fs Eio filesystem
82
87
@param config Monopam configuration
83
-
@param package Optional specific package to pull *)
88
+
@param package Optional specific package to pull
89
+
@param opam_repo_url Optional URL to clone opam-repo from if it doesn't exist *)
84
90
85
91
(** {2 Push} *)
86
92
···
110
116
@param package Optional specific package to push
111
117
@param upstream If true, also push checkouts to their git remotes *)
112
118
113
-
(** {2 Extract} *)
114
-
115
-
val extract :
116
-
proc:_ Eio.Process.mgr ->
117
-
fs:Eio.Fs.dir_ty Eio.Path.t ->
118
-
config:Config.t ->
119
-
subdir:string ->
120
-
repo_url:string ->
121
-
?branch:string ->
122
-
?push:bool ->
123
-
?create_opam:bool ->
124
-
unit ->
125
-
(unit, error) result
126
-
(** [extract ~proc ~fs ~config ~subdir ~repo_url ()] extracts a subdirectory
127
-
from the monorepo as a standalone git repository with full history.
128
-
129
-
Enables the "develop in monorepo first, extract later" workflow.
130
-
131
-
The extraction process:
132
-
1. Runs git subtree split to extract commits affecting the subdirectory
133
-
2. Creates a new git repository in the checkouts directory
134
-
3. Configures the remote URL
135
-
136
-
@param proc Eio process manager
137
-
@param fs Eio filesystem
138
-
@param config Monopam configuration
139
-
@param subdir Subdirectory in monorepo to extract
140
-
@param repo_url Git URL for the new repository
141
-
@param branch Branch name (default: from config)
142
-
@param push If true, push to remote after extraction
143
-
@param create_opam If true, create opam package metadata in overlay *)
144
-
145
119
(** {2 Package Management} *)
146
120
147
121
val add :
···
199
173
@param fs Eio filesystem
200
174
@param config Monopam configuration
201
175
@param name Package name to find *)
176
+
177
+
val find_unregistered_opam_files :
178
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
179
+
config:Config.t ->
180
+
Package.t list ->
181
+
(string * string) list
182
+
(** [find_unregistered_opam_files ~fs ~config pkgs] finds opam files in monorepo
183
+
subtree directories that aren't registered in the opam overlay.
184
+
185
+
Returns a list of [(repo_name, package_name)] pairs for each unregistered
186
+
.opam file found. This helps identify packages that exist in the source
187
+
repositories but aren't being tracked by the overlay.
188
+
189
+
@param fs Eio filesystem
190
+
@param config Monopam configuration
191
+
@param pkgs List of packages discovered from the opam overlay *)
202
192
203
193
(** {1 Changelog Generation} *)
204
194
+23
monopam/lib/opam_repo.ml
+23
monopam/lib/opam_repo.ml
···
162
162
let validate_repo ~fs repo_path =
163
163
let _, errors = scan_all ~fs repo_path in
164
164
errors
165
+
166
+
(** Scan a directory for .opam files and extract all dependencies.
167
+
This is used to find dependencies from monorepo subtree directories,
168
+
where multiple .opam files may exist that aren't in the opam overlay. *)
169
+
let scan_opam_files_for_deps ~fs dir_path =
170
+
let eio_path = Eio.Path.(fs / Fpath.to_string dir_path) in
171
+
try
172
+
let files = Eio.Path.read_dir eio_path in
173
+
let opam_files =
174
+
List.filter (fun name -> Filename.check_suffix name ".opam") files
175
+
in
176
+
List.concat_map
177
+
(fun opam_file ->
178
+
let opam_path = Eio.Path.(eio_path / opam_file) in
179
+
try
180
+
let content = Eio.Path.load opam_path in
181
+
let opamfile =
182
+
OpamParser.FullPos.string content (Fpath.to_string dir_path ^ "/" ^ opam_file)
183
+
in
184
+
find_depends opamfile.file_contents
185
+
with _ -> [])
186
+
opam_files
187
+
with Eio.Io _ -> []
+11
monopam/lib/opam_repo.mli
+11
monopam/lib/opam_repo.mli
···
75
75
76
76
For example, "git+https://example.com/repo.git" becomes
77
77
"https://example.com/repo.git". *)
78
+
79
+
val scan_opam_files_for_deps : fs:_ Eio.Path.t -> Fpath.t -> string list
80
+
(** [scan_opam_files_for_deps ~fs dir_path] scans a directory for .opam files
81
+
and extracts all dependencies from them.
82
+
83
+
This is used to find dependencies from monorepo subtree directories,
84
+
where multiple .opam files may exist that aren't in the opam overlay.
85
+
86
+
@param fs Eio filesystem capability
87
+
@param dir_path Path to the directory to scan
88
+
@return List of dependency package names *)
+393
monopam/lib/verse.ml
+393
monopam/lib/verse.ml
···
1
+
type error =
2
+
| Config_error of string
3
+
| Git_error of Git.error
4
+
| Registry_error of string
5
+
| Handle_not_found of string
6
+
| Not_authenticated
7
+
| Member_not_found of string
8
+
| Workspace_exists of Fpath.t
9
+
| Not_a_workspace of Fpath.t
10
+
11
+
let pp_error ppf = function
12
+
| Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg
13
+
| Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e
14
+
| Registry_error msg -> Fmt.pf ppf "Registry error: %s" msg
15
+
| Handle_not_found h -> Fmt.pf ppf "Handle not found: %s" h
16
+
| Not_authenticated ->
17
+
Fmt.pf ppf "Not authenticated. Run 'tangled auth login' first."
18
+
| Member_not_found h -> Fmt.pf ppf "Member not in registry: %s" h
19
+
| Workspace_exists p -> Fmt.pf ppf "Workspace already exists: %a" Fpath.pp p
20
+
| Not_a_workspace p -> Fmt.pf ppf "Not a opamverse workspace: %a" Fpath.pp p
21
+
22
+
type member_status = {
23
+
handle : string;
24
+
monorepo_url : string;
25
+
local_path : Fpath.t;
26
+
cloned : bool;
27
+
clean : bool option;
28
+
ahead_behind : Git.ahead_behind option;
29
+
}
30
+
31
+
type status = {
32
+
config : Verse_config.t;
33
+
registry : Verse_registry.t;
34
+
tracked_members : member_status list;
35
+
}
36
+
37
+
let pp_member_status ppf m =
38
+
let status =
39
+
if not m.cloned then "not cloned"
40
+
else
41
+
match (m.clean, m.ahead_behind) with
42
+
| Some false, _ -> "dirty"
43
+
| Some true, Some ab when ab.ahead > 0 || ab.behind > 0 ->
44
+
Fmt.str "ahead %d, behind %d" ab.ahead ab.behind
45
+
| Some true, _ -> "clean"
46
+
| None, _ -> "unknown"
47
+
in
48
+
Fmt.pf ppf "@[<hov 2>%s@ (%s)@ [%s]@]" m.handle m.monorepo_url status
49
+
50
+
let pp_status ppf s =
51
+
Fmt.pf ppf "@[<v>Workspace: %a@,Registry: %s@,Members:@, @[<v>%a@]@]"
52
+
Fpath.pp (Verse_config.root s.config)
53
+
s.registry.name
54
+
Fmt.(list ~sep:cut pp_member_status)
55
+
s.tracked_members
56
+
57
+
(* Helper to validate handle via tangled API.
58
+
We reuse the tangled CLI's session credentials - user must run 'tangled auth login' first. *)
59
+
let validate_handle ~sw ~env handle =
60
+
try
61
+
(* Use app_name:"tangled" to reuse tangled CLI's session without polluting monopam's directory *)
62
+
let api =
63
+
Tangled.Api.create ~sw ~env ~app_name:"tangled" ~pds:"https://bsky.social" ()
64
+
in
65
+
(* Try to load existing session from tangled CLI *)
66
+
let session = Xrpc_auth.Session.load env#fs ~app_name:"tangled" () in
67
+
match session with
68
+
| None -> Error Not_authenticated
69
+
| Some session -> (
70
+
Tangled.Api.resume api ~session;
71
+
try
72
+
let _did = Tangled.Api.resolve_handle api handle in
73
+
Ok ()
74
+
with Eio.Io (Xrpc.Error.E _, _) -> Error (Handle_not_found handle))
75
+
with Eio.Io (Xrpc.Error.E _, _) -> Error Not_authenticated
76
+
77
+
(* Helper to check if a path is a directory *)
78
+
let is_directory ~fs path =
79
+
let eio_path = Eio.Path.(fs / Fpath.to_string path) in
80
+
match Eio.Path.kind ~follow:true eio_path with
81
+
| `Directory -> true
82
+
| _ -> false
83
+
| exception _ -> false
84
+
85
+
(* Helper to check if a path is a regular file *)
86
+
let is_file ~fs path =
87
+
let eio_path = Eio.Path.(fs / Fpath.to_string path) in
88
+
match Eio.Path.kind ~follow:true eio_path with
89
+
| `Regular_file -> true
90
+
| _ -> false
91
+
| exception _ -> false
92
+
93
+
(* Helper to create a directory if it doesn't exist *)
94
+
let ensure_dir ~fs path =
95
+
let eio_path = Eio.Path.(fs / Fpath.to_string path) in
96
+
try Eio.Path.mkdirs ~perm:0o755 eio_path with Eio.Io _ -> ()
97
+
98
+
(* Helper to recursively delete a directory *)
99
+
let rec rm_rf ~fs path =
100
+
let eio_path = Eio.Path.(fs / Fpath.to_string path) in
101
+
match Eio.Path.kind ~follow:false eio_path with
102
+
| `Directory ->
103
+
(* List and delete contents first *)
104
+
let entries = Eio.Path.read_dir eio_path in
105
+
List.iter (fun name -> rm_rf ~fs Fpath.(path / name)) entries;
106
+
Eio.Path.rmdir eio_path
107
+
| `Regular_file | `Symbolic_link | `Block_device | `Character_special
108
+
| `Fifo | `Socket | `Unknown ->
109
+
Eio.Path.unlink eio_path
110
+
| `Not_found -> ()
111
+
| exception _ -> ()
112
+
113
+
(* Get list of tracked members by looking at verse/ directory *)
114
+
let get_tracked_handles ~fs config =
115
+
let verse_path = Verse_config.verse_path config in
116
+
if not (is_directory ~fs verse_path) then []
117
+
else
118
+
let eio_path = Eio.Path.(fs / Fpath.to_string verse_path) in
119
+
try
120
+
Eio.Path.read_dir eio_path
121
+
|> List.filter (fun name ->
122
+
is_directory ~fs Fpath.(verse_path / name))
123
+
with Eio.Io _ -> []
124
+
125
+
let init ~proc ~fs ~sw ~env ~root ~handle () =
126
+
(* Check if config already exists in XDG *)
127
+
let config_file = Verse_config.config_file () in
128
+
Logs.info (fun m -> m "Config file: %a" Fpath.pp config_file);
129
+
if is_file ~fs config_file then begin
130
+
Logs.err (fun m -> m "Config already exists at %a" Fpath.pp config_file);
131
+
Error (Workspace_exists root)
132
+
end
133
+
else
134
+
(* Resolve root to absolute path *)
135
+
let root =
136
+
if Fpath.is_abs root then root
137
+
else
138
+
(* Get absolute path via realpath *)
139
+
let root_str = Fpath.to_string root in
140
+
let eio_path = Eio.Path.(fs / root_str) in
141
+
(* Ensure the directory exists first so realpath works *)
142
+
(try Eio.Path.mkdirs ~perm:0o755 eio_path with Eio.Io _ -> ());
143
+
match Unix.realpath root_str with
144
+
| abs_str -> (match Fpath.of_string abs_str with Ok p -> p | Error _ -> root)
145
+
| exception _ -> root
146
+
in
147
+
Logs.info (fun m -> m "Workspace root: %a" Fpath.pp root);
148
+
(* Validate handle *)
149
+
Logs.info (fun m -> m "Validating handle: %s" handle);
150
+
match validate_handle ~sw ~env handle with
151
+
| Error e ->
152
+
Logs.err (fun m -> m "Handle validation failed");
153
+
Error e
154
+
| Ok () ->
155
+
Logs.info (fun m -> m "Handle validated successfully");
156
+
(* Create config - need this temporarily to get paths *)
157
+
let config = Verse_config.create ~root ~handle () in
158
+
(* Clone registry first to look up user's repos *)
159
+
Logs.info (fun m -> m "Cloning registry...");
160
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
161
+
| Error msg ->
162
+
Logs.err (fun m -> m "Registry clone failed: %s" msg);
163
+
Error (Registry_error msg)
164
+
| Ok registry ->
165
+
Logs.info (fun m -> m "Registry loaded");
166
+
(* Look up user in registry *)
167
+
match Verse_registry.find_member registry ~handle with
168
+
| None ->
169
+
Logs.err (fun m -> m "Handle %s not found in registry" handle);
170
+
Error (Member_not_found handle)
171
+
| Some member ->
172
+
Logs.info (fun m -> m "Found member: mono=%s opam=%s" member.monorepo member.opamrepo);
173
+
(* Create workspace directories *)
174
+
Logs.info (fun m -> m "Creating workspace directories...");
175
+
ensure_dir ~fs root;
176
+
ensure_dir ~fs (Verse_config.src_path config);
177
+
ensure_dir ~fs (Verse_config.verse_path config);
178
+
(* Clone user's monorepo *)
179
+
let mono_path = Verse_config.mono_path config in
180
+
Logs.info (fun m -> m "Cloning monorepo to %a" Fpath.pp mono_path);
181
+
let mono_url = Uri.of_string member.monorepo in
182
+
(match Git.clone ~proc ~fs ~url:mono_url ~branch:Verse_config.default_branch mono_path with
183
+
| Error e ->
184
+
Logs.err (fun m -> m "Monorepo clone failed: %a" Git.pp_error e);
185
+
Error (Git_error e)
186
+
| Ok () ->
187
+
Logs.info (fun m -> m "Monorepo cloned");
188
+
(* Clone user's opam repo *)
189
+
let opam_path = Verse_config.opam_repo_path config in
190
+
Logs.info (fun m -> m "Cloning opam repo to %a" Fpath.pp opam_path);
191
+
let opam_url = Uri.of_string member.opamrepo in
192
+
(match Git.clone ~proc ~fs ~url:opam_url ~branch:Verse_config.default_branch opam_path with
193
+
| Error e ->
194
+
Logs.err (fun m -> m "Opam repo clone failed: %a" Git.pp_error e);
195
+
Error (Git_error e)
196
+
| Ok () ->
197
+
Logs.info (fun m -> m "Opam repo cloned");
198
+
(* Save config to XDG *)
199
+
Logs.info (fun m -> m "Saving config to %a" Fpath.pp config_file);
200
+
(match Verse_config.save ~fs config with
201
+
| Error msg ->
202
+
Logs.err (fun m -> m "Failed to save config: %s" msg);
203
+
Error (Config_error msg)
204
+
| Ok () ->
205
+
Logs.info (fun m -> m "Workspace initialized successfully");
206
+
Ok ())))
207
+
208
+
let status ~proc ~fs ~config () =
209
+
(* Load registry *)
210
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
211
+
| Error msg -> Error (Registry_error msg)
212
+
| Ok registry ->
213
+
(* Get tracked handles *)
214
+
let tracked_handles = get_tracked_handles ~fs config in
215
+
(* Build status for each tracked member *)
216
+
let tracked_members =
217
+
List.filter_map
218
+
(fun handle ->
219
+
(* Find member in registry *)
220
+
match Verse_registry.find_member registry ~handle with
221
+
| None ->
222
+
(* Member not in registry but locally tracked - show anyway *)
223
+
let local_path = Fpath.(Verse_config.verse_path config / handle) in
224
+
let cloned = is_directory ~fs local_path in
225
+
Some
226
+
{
227
+
handle;
228
+
monorepo_url = "(not in registry)";
229
+
local_path;
230
+
cloned;
231
+
clean = None;
232
+
ahead_behind = None;
233
+
}
234
+
| Some member ->
235
+
let local_path =
236
+
Fpath.(Verse_config.verse_path config / handle)
237
+
in
238
+
let cloned = Git.is_repo ~proc ~fs local_path in
239
+
let clean =
240
+
if cloned then Some (not (Git.is_dirty ~proc ~fs local_path))
241
+
else None
242
+
in
243
+
let ahead_behind =
244
+
if cloned then
245
+
match Git.ahead_behind ~proc ~fs local_path with
246
+
| Ok ab -> Some ab
247
+
| Error _ -> None
248
+
else None
249
+
in
250
+
Some
251
+
{
252
+
handle;
253
+
monorepo_url = member.monorepo;
254
+
local_path;
255
+
cloned;
256
+
clean;
257
+
ahead_behind;
258
+
})
259
+
tracked_handles
260
+
in
261
+
Ok { config; registry; tracked_members }
262
+
263
+
let members ~proc ~fs ~config () =
264
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
265
+
| Error msg -> Error (Registry_error msg)
266
+
| Ok registry -> Ok registry.members
267
+
268
+
let add ~proc ~fs ~sw ~env ~config ~handle () =
269
+
Logs.info (fun m -> m "Adding member: %s" handle);
270
+
(* Validate handle *)
271
+
match validate_handle ~sw ~env handle with
272
+
| Error e -> Error e
273
+
| Ok () -> (
274
+
(* Load registry *)
275
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
276
+
| Error msg -> Error (Registry_error msg)
277
+
| Ok registry -> (
278
+
(* Find member *)
279
+
match Verse_registry.find_member registry ~handle with
280
+
| None -> Error (Member_not_found handle)
281
+
| Some member ->
282
+
(* Ensure verse directory exists *)
283
+
let verse_dir = Verse_config.verse_path config in
284
+
Logs.info (fun m -> m "Verse directory: %a" Fpath.pp verse_dir);
285
+
ensure_dir ~fs verse_dir;
286
+
let local_path = Fpath.(verse_dir / handle) in
287
+
Logs.info (fun m -> m "Clone target: %a" Fpath.pp local_path);
288
+
(* Check if already cloned *)
289
+
if Git.is_repo ~proc ~fs local_path then begin
290
+
Logs.info (fun m -> m "Already cloned");
291
+
Ok ()
292
+
end
293
+
else begin
294
+
(* Clone the monorepo *)
295
+
let url = Uri.of_string member.monorepo in
296
+
Logs.info (fun m -> m "Cloning from %s" member.monorepo);
297
+
match Git.clone ~proc ~fs ~url ~branch:Verse_config.default_branch local_path with
298
+
| Error e -> Error (Git_error e)
299
+
| Ok () ->
300
+
Logs.info (fun m -> m "Clone succeeded");
301
+
Ok ()
302
+
end))
303
+
304
+
let remove ~fs ~config ~handle () =
305
+
let local_path = Fpath.(Verse_config.verse_path config / handle) in
306
+
if not (is_directory ~fs local_path) then
307
+
Error (Member_not_found handle)
308
+
else begin
309
+
rm_rf ~fs local_path;
310
+
Ok ()
311
+
end
312
+
313
+
let add_all ~proc ~fs ~sw ~env ~config () =
314
+
Logs.info (fun m -> m "Adding all registry members");
315
+
(* Load registry *)
316
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
317
+
| Error msg -> Error (Registry_error msg)
318
+
| Ok registry ->
319
+
(* Get already tracked handles to skip them *)
320
+
let tracked = get_tracked_handles ~fs config in
321
+
let tracked_set = Hashtbl.create (List.length tracked) in
322
+
List.iter (fun h -> Hashtbl.add tracked_set h ()) tracked;
323
+
(* Ensure verse directory exists *)
324
+
let verse_dir = Verse_config.verse_path config in
325
+
ensure_dir ~fs verse_dir;
326
+
(* Add each member that isn't already tracked *)
327
+
let added = ref [] in
328
+
let errors =
329
+
List.filter_map
330
+
(fun (member : Verse_registry.member) ->
331
+
let handle = member.handle in
332
+
if Hashtbl.mem tracked_set handle then begin
333
+
Logs.info (fun m -> m "Skipping %s (already tracked)" handle);
334
+
None
335
+
end
336
+
else begin
337
+
(* Validate handle *)
338
+
match validate_handle ~sw ~env handle with
339
+
| Error e ->
340
+
Logs.warn (fun m -> m "Skipping %s: %a" handle pp_error e);
341
+
Some (Fmt.str "%s: %a" handle pp_error e)
342
+
| Ok () ->
343
+
let local_path = Fpath.(verse_dir / handle) in
344
+
let url = Uri.of_string member.monorepo in
345
+
Logs.info (fun m -> m "Cloning %s from %s" handle member.monorepo);
346
+
match Git.clone ~proc ~fs ~url ~branch:Verse_config.default_branch local_path with
347
+
| Error e ->
348
+
Logs.warn (fun m -> m "Failed to clone %s: %a" handle Git.pp_error e);
349
+
Some (Fmt.str "%s: %a" handle Git.pp_error e)
350
+
| Ok () ->
351
+
Logs.info (fun m -> m "Cloned %s" handle);
352
+
added := member :: !added;
353
+
None
354
+
end)
355
+
registry.members
356
+
in
357
+
if errors = [] then Ok (List.rev !added)
358
+
else Error (Git_error (Git.Io_error (String.concat "; " errors)))
359
+
360
+
let pull ~proc ~fs ~config ?handle () =
361
+
match handle with
362
+
| Some h ->
363
+
let local_path = Fpath.(Verse_config.verse_path config / h) in
364
+
if not (Git.is_repo ~proc ~fs local_path) then
365
+
Error (Member_not_found h)
366
+
else
367
+
(match Git.pull ~proc ~fs local_path with
368
+
| Error e -> Error (Git_error e)
369
+
| Ok () -> Ok ())
370
+
| None ->
371
+
(* Pull all tracked members *)
372
+
let tracked_handles = get_tracked_handles ~fs config in
373
+
let errors =
374
+
List.filter_map
375
+
(fun h ->
376
+
let local_path = Fpath.(Verse_config.verse_path config / h) in
377
+
if Git.is_repo ~proc ~fs local_path then
378
+
match Git.pull ~proc ~fs local_path with
379
+
| Error e -> Some (Fmt.str "%s: %a" h Git.pp_error e)
380
+
| Ok () -> None
381
+
else None)
382
+
tracked_handles
383
+
in
384
+
if errors = [] then Ok ()
385
+
else Error (Git_error (Git.Io_error (String.concat "; " errors)))
386
+
387
+
let sync ~proc ~fs ~config () =
388
+
(* Update registry *)
389
+
match Verse_registry.clone_or_pull ~proc ~fs ~config () with
390
+
| Error msg -> Error (Registry_error msg)
391
+
| Ok _registry ->
392
+
(* Pull all tracked members *)
393
+
pull ~proc ~fs ~config ()
+160
monopam/lib/verse.mli
+160
monopam/lib/verse.mli
···
1
+
(** Monoverse operations.
2
+
3
+
Federated monorepo collaboration. Members are identified by tangled handles
4
+
with strict validation via the AT Protocol identity system. *)
5
+
6
+
(** {1 Error Types} *)
7
+
8
+
type error =
9
+
| Config_error of string (** Configuration loading/saving error *)
10
+
| Git_error of Git.error (** Git operation failed *)
11
+
| Registry_error of string (** Registry clone/pull/parse error *)
12
+
| Handle_not_found of string (** Handle could not be resolved *)
13
+
| Not_authenticated (** Tangled login required *)
14
+
| Member_not_found of string (** Handle not in registry *)
15
+
| Workspace_exists of Fpath.t (** Workspace already initialized *)
16
+
| Not_a_workspace of Fpath.t (** Not a opamverse workspace *)
17
+
18
+
val pp_error : error Fmt.t
19
+
(** [pp_error] formats errors. *)
20
+
21
+
(** {1 Status Types} *)
22
+
23
+
type member_status = {
24
+
handle : string; (** Member's tangled handle *)
25
+
monorepo_url : string; (** Git URL of member's monorepo *)
26
+
local_path : Fpath.t; (** Local path under verse/ *)
27
+
cloned : bool; (** Whether the monorepo is cloned locally *)
28
+
clean : bool option; (** Whether the clone is clean (None if not cloned) *)
29
+
ahead_behind : Git.ahead_behind option; (** Ahead/behind status (None if not cloned) *)
30
+
}
31
+
(** Status of a member's monorepo in the workspace. *)
32
+
33
+
type status = {
34
+
config : Verse_config.t; (** Workspace configuration *)
35
+
registry : Verse_registry.t; (** Registry contents *)
36
+
tracked_members : member_status list; (** Status of tracked members *)
37
+
}
38
+
(** Workspace status. *)
39
+
40
+
val pp_member_status : member_status Fmt.t
41
+
(** [pp_member_status] formats a member's status. *)
42
+
43
+
val pp_status : status Fmt.t
44
+
(** [pp_status] formats workspace status. *)
45
+
46
+
(** {1 Operations} *)
47
+
48
+
val init :
49
+
proc:_ Eio.Process.mgr ->
50
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
51
+
sw:Eio.Switch.t ->
52
+
env:< clock : _ Eio.Time.clock ; net : _ Eio.Net.t ; fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
53
+
root:Fpath.t ->
54
+
handle:string ->
55
+
unit ->
56
+
(unit, error) result
57
+
(** [init ~proc ~fs ~sw ~env ~root ~handle ()] initializes a new opamverse workspace.
58
+
59
+
Creates the workspace structure:
60
+
- [root/.opamverse/config.toml]
61
+
- [root/.opamverse/registry/] (cloned registry)
62
+
- [root/mono/] (user's monorepo)
63
+
- [root/src/] (source checkouts)
64
+
- [root/verse/] (other users' monorepos)
65
+
66
+
The handle is validated against the tangled network (requires prior login).
67
+
68
+
@param proc Eio process manager
69
+
@param fs Eio filesystem
70
+
@param sw Eio switch
71
+
@param env Eio environment for tangled API
72
+
@param root Workspace root (must be absolute)
73
+
@param handle User's tangled handle *)
74
+
75
+
val status :
76
+
proc:_ Eio.Process.mgr ->
77
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
78
+
config:Verse_config.t ->
79
+
unit ->
80
+
(status, error) result
81
+
(** [status ~proc ~fs ~config ()] returns the workspace status.
82
+
83
+
Shows which members are tracked and the state of their local clones. *)
84
+
85
+
val members :
86
+
proc:_ Eio.Process.mgr ->
87
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
88
+
config:Verse_config.t ->
89
+
unit ->
90
+
(Verse_registry.member list, error) result
91
+
(** [members ~proc ~fs ~config ()] returns all registry members.
92
+
93
+
Pulls the latest registry before returning the member list. *)
94
+
95
+
val add :
96
+
proc:_ Eio.Process.mgr ->
97
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
98
+
sw:Eio.Switch.t ->
99
+
env:< clock : _ Eio.Time.clock ; net : _ Eio.Net.t ; fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
100
+
config:Verse_config.t ->
101
+
handle:string ->
102
+
unit ->
103
+
(unit, error) result
104
+
(** [add ~proc ~fs ~sw ~env ~config ~handle ()] adds a member to the workspace.
105
+
106
+
Validates the handle against tangled, looks up the monorepo URL from the
107
+
registry, and clones it to [verse/<handle>/].
108
+
109
+
@param handle Tangled handle of the member to add *)
110
+
111
+
val add_all :
112
+
proc:_ Eio.Process.mgr ->
113
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
114
+
sw:Eio.Switch.t ->
115
+
env:< clock : _ Eio.Time.clock ; net : _ Eio.Net.t ; fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
116
+
config:Verse_config.t ->
117
+
unit ->
118
+
(Verse_registry.member list, error) result
119
+
(** [add_all ~proc ~fs ~sw ~env ~config ()] adds all registry members to the workspace.
120
+
121
+
Iterates over all members in the registry and clones their monorepos to
122
+
[verse/<handle>/]. Members already tracked are skipped.
123
+
124
+
Returns the list of members that were added. *)
125
+
126
+
val remove :
127
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
128
+
config:Verse_config.t ->
129
+
handle:string ->
130
+
unit ->
131
+
(unit, error) result
132
+
(** [remove ~fs ~config ~handle ()] removes a member from the workspace.
133
+
134
+
Deletes the member's monorepo clone from [verse/<handle>/].
135
+
136
+
@param handle Tangled handle of the member to remove *)
137
+
138
+
val pull :
139
+
proc:_ Eio.Process.mgr ->
140
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
141
+
config:Verse_config.t ->
142
+
?handle:string ->
143
+
unit ->
144
+
(unit, error) result
145
+
(** [pull ~proc ~fs ~config ?handle ()] pulls updates for members.
146
+
147
+
If [handle] is specified, only pulls that member. Otherwise pulls all
148
+
tracked members.
149
+
150
+
@param handle Optional specific member to pull *)
151
+
152
+
val sync :
153
+
proc:_ Eio.Process.mgr ->
154
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
155
+
config:Verse_config.t ->
156
+
unit ->
157
+
(unit, error) result
158
+
(** [sync ~proc ~fs ~config ()] syncs the workspace.
159
+
160
+
Updates the registry and pulls updates for all tracked members. *)
+119
monopam/lib/verse_config.ml
+119
monopam/lib/verse_config.ml
···
1
+
let app_name = "monopam"
2
+
3
+
(* Simplified config: just root and handle. Paths are hardcoded. *)
4
+
type t = {
5
+
root : Fpath.t;
6
+
handle : string;
7
+
}
8
+
9
+
let root t = t.root
10
+
let handle t = t.handle
11
+
12
+
(* Hardcoded paths derived from root *)
13
+
let default_branch = "main"
14
+
let mono_path t = Fpath.(t.root / "mono")
15
+
let src_path t = Fpath.(t.root / "src")
16
+
let opam_repo_path t = Fpath.(t.root / "opam-repo")
17
+
let verse_path t = Fpath.(t.root / "verse")
18
+
19
+
(* Compute XDG directories following XDG Base Directory Specification *)
20
+
let xdg_config_home () =
21
+
match Sys.getenv_opt "XDG_CONFIG_HOME" with
22
+
| Some dir when dir <> "" -> Fpath.v dir
23
+
| _ ->
24
+
match Sys.getenv_opt "HOME" with
25
+
| Some home -> Fpath.(v home / ".config")
26
+
| None -> Fpath.v "/tmp"
27
+
28
+
let xdg_data_home () =
29
+
match Sys.getenv_opt "XDG_DATA_HOME" with
30
+
| Some dir when dir <> "" -> Fpath.v dir
31
+
| _ ->
32
+
match Sys.getenv_opt "HOME" with
33
+
| Some home -> Fpath.(v home / ".local" / "share")
34
+
| None -> Fpath.v "/tmp"
35
+
36
+
let config_dir () = Fpath.(xdg_config_home () / app_name)
37
+
let data_dir () = Fpath.(xdg_data_home () / app_name)
38
+
let config_file () = Fpath.(config_dir () / "opamverse.toml")
39
+
let registry_path () = Fpath.(data_dir () / "opamverse-registry")
40
+
41
+
let create ~root ~handle () = { root; handle }
42
+
43
+
let expand_tilde s =
44
+
if String.length s > 0 && s.[0] = '~' then
45
+
match Sys.getenv_opt "HOME" with
46
+
| Some home ->
47
+
if String.length s = 1 then home
48
+
else if s.[1] = '/' then home ^ String.sub s 1 (String.length s - 1)
49
+
else s
50
+
| None -> s
51
+
else s
52
+
53
+
let fpath_codec : Fpath.t Tomlt.t =
54
+
Tomlt.map
55
+
~dec:(fun s ->
56
+
let s = expand_tilde s in
57
+
match Fpath.of_string s with Ok p -> p | Error (`Msg m) -> failwith m)
58
+
~enc:Fpath.to_string Tomlt.string
59
+
60
+
(* Simplified TOML structure:
61
+
[workspace]
62
+
root = "~/tangled"
63
+
64
+
[identity]
65
+
handle = "anil.recoil.org"
66
+
*)
67
+
68
+
type workspace_section = { w_root : Fpath.t }
69
+
type identity_section = { i_handle : string }
70
+
71
+
let workspace_codec : workspace_section Tomlt.t =
72
+
Tomlt.(
73
+
Table.(
74
+
obj (fun w_root -> { w_root })
75
+
|> mem "root" fpath_codec ~enc:(fun w -> w.w_root)
76
+
|> finish))
77
+
78
+
let identity_codec : identity_section Tomlt.t =
79
+
Tomlt.(
80
+
Table.(
81
+
obj (fun i_handle -> { i_handle })
82
+
|> mem "handle" string ~enc:(fun i -> i.i_handle)
83
+
|> finish))
84
+
85
+
let codec : t Tomlt.t =
86
+
Tomlt.(
87
+
Table.(
88
+
obj (fun workspace identity ->
89
+
{ root = workspace.w_root; handle = identity.i_handle })
90
+
|> mem "workspace" workspace_codec ~enc:(fun t -> { w_root = t.root })
91
+
|> mem "identity" identity_codec ~enc:(fun t -> { i_handle = t.handle })
92
+
|> finish))
93
+
94
+
let load ~fs () =
95
+
let path = config_file () in
96
+
let path_str = Fpath.to_string path in
97
+
try Ok (Tomlt_eio.decode_path_exn codec ~fs path_str)
98
+
with
99
+
| Eio.Io _ as e -> Error (Printexc.to_string e)
100
+
| Failure msg -> Error (Fmt.str "Invalid config: %s" msg)
101
+
102
+
let save ~fs t =
103
+
let dir = config_dir () in
104
+
let path = config_file () in
105
+
try
106
+
(* Ensure XDG config directory exists *)
107
+
let dir_path = Eio.Path.(fs / Fpath.to_string dir) in
108
+
(try Eio.Path.mkdirs ~perm:0o755 dir_path with Eio.Io _ -> ());
109
+
Tomlt_eio.encode_path codec t ~fs (Fpath.to_string path);
110
+
Ok ()
111
+
with Eio.Io _ as e -> Error (Printexc.to_string e)
112
+
113
+
let pp ppf t =
114
+
Fmt.pf ppf
115
+
"@[<v>workspace:@,\
116
+
\ root: %a@,\
117
+
identity:@,\
118
+
\ handle: %s@]"
119
+
Fpath.pp t.root t.handle
+83
monopam/lib/verse_config.mli
+83
monopam/lib/verse_config.mli
···
1
+
(** Opamverse workspace configuration.
2
+
3
+
Configuration is stored in the XDG config directory at
4
+
[~/.config/monopam/opamverse.toml].
5
+
6
+
The config stores just the workspace root and user's handle.
7
+
All paths are derived from the root:
8
+
- [mono/] - user's monorepo
9
+
- [src/] - git checkouts for subtrees
10
+
- [opam-repo/] - opam overlay repository
11
+
- [verse/] - other members' monorepos *)
12
+
13
+
(** {1 Types} *)
14
+
15
+
type t
16
+
(** Opamverse workspace configuration. *)
17
+
18
+
(** {1 Accessors} *)
19
+
20
+
val root : t -> Fpath.t
21
+
(** [root t] returns the workspace root directory. *)
22
+
23
+
val handle : t -> string
24
+
(** [handle t] returns the user's tangled handle. *)
25
+
26
+
(** {1 Derived Paths} *)
27
+
28
+
val default_branch : string
29
+
(** Default git branch, always ["main"]. *)
30
+
31
+
val mono_path : t -> Fpath.t
32
+
(** [mono_path t] returns the path to the user's monorepo ([root/mono/]). *)
33
+
34
+
val src_path : t -> Fpath.t
35
+
(** [src_path t] returns the path to git checkouts ([root/src/]). *)
36
+
37
+
val opam_repo_path : t -> Fpath.t
38
+
(** [opam_repo_path t] returns the path to the opam overlay ([root/opam-repo/]). *)
39
+
40
+
val verse_path : t -> Fpath.t
41
+
(** [verse_path t] returns the path to tracked members' monorepos ([root/verse/]). *)
42
+
43
+
(** {1 XDG Paths} *)
44
+
45
+
val config_dir : unit -> Fpath.t
46
+
(** [config_dir ()] returns the XDG config directory for monopam
47
+
(~/.config/monopam). *)
48
+
49
+
val data_dir : unit -> Fpath.t
50
+
(** [data_dir ()] returns the XDG data directory for monopam
51
+
(~/.local/share/monopam). *)
52
+
53
+
val config_file : unit -> Fpath.t
54
+
(** [config_file ()] returns the path to the opamverse config file
55
+
(~/.config/monopam/opamverse.toml). *)
56
+
57
+
val registry_path : unit -> Fpath.t
58
+
(** [registry_path ()] returns the path to the cloned registry git repo
59
+
(~/.local/share/monopam/opamverse-registry). *)
60
+
61
+
(** {1 Loading and Saving} *)
62
+
63
+
val load : fs:Eio.Fs.dir_ty Eio.Path.t -> unit -> (t, string) result
64
+
(** [load ~fs ()] loads the workspace configuration from the XDG config file.
65
+
66
+
@param fs Eio filesystem *)
67
+
68
+
val save : fs:Eio.Fs.dir_ty Eio.Path.t -> t -> (unit, string) result
69
+
(** [save ~fs config] saves the configuration to the XDG config file.
70
+
71
+
@param fs Eio filesystem
72
+
@param config Configuration to save *)
73
+
74
+
val create : root:Fpath.t -> handle:string -> unit -> t
75
+
(** [create ~root ~handle ()] creates a new configuration.
76
+
77
+
@param root Workspace root directory (absolute path)
78
+
@param handle User's tangled handle *)
79
+
80
+
(** {1 Pretty Printing} *)
81
+
82
+
val pp : t Fmt.t
83
+
(** [pp] formats a workspace configuration. *)
+133
monopam/lib/verse_registry.ml
+133
monopam/lib/verse_registry.ml
···
1
+
type member = { handle : string; monorepo : string; opamrepo : string }
2
+
type t = { name : string; members : member list }
3
+
4
+
let default_url = "https://tangled.org/eeg.cl.cam.ac.uk/opamverse"
5
+
6
+
let pp_member ppf m =
7
+
Fmt.pf ppf "@[<hov 2>%s ->@ mono:%s@ opam:%s@]" m.handle m.monorepo m.opamrepo
8
+
9
+
let pp ppf t =
10
+
Fmt.pf ppf "@[<v>registry: %s@,members:@, @[<v>%a@]@]"
11
+
t.name Fmt.(list ~sep:cut pp_member) t.members
12
+
13
+
(* TOML structure:
14
+
[registry]
15
+
name = "tangled-community"
16
+
17
+
[[members]]
18
+
handle = "alice.bsky.social"
19
+
monorepo = "https://github.com/alice/mono"
20
+
opamrepo = "https://github.com/alice/opam-repo"
21
+
*)
22
+
23
+
let member_codec : member Tomlt.t =
24
+
Tomlt.(
25
+
Table.(
26
+
obj (fun handle monorepo opamrepo -> { handle; monorepo; opamrepo })
27
+
|> mem "handle" string ~enc:(fun m -> m.handle)
28
+
|> mem "monorepo" string ~enc:(fun m -> m.monorepo)
29
+
|> mem "opamrepo" string ~enc:(fun m -> m.opamrepo)
30
+
|> finish))
31
+
32
+
type registry_info = { r_name : string }
33
+
34
+
let registry_info_codec : registry_info Tomlt.t =
35
+
Tomlt.(
36
+
Table.(
37
+
obj (fun r_name -> { r_name })
38
+
|> mem "name" string ~enc:(fun r -> r.r_name)
39
+
|> finish))
40
+
41
+
let codec : t Tomlt.t =
42
+
Tomlt.(
43
+
Table.(
44
+
obj (fun registry members ->
45
+
{ name = registry.r_name; members = Option.value ~default:[] members })
46
+
|> mem "registry" registry_info_codec ~enc:(fun t -> { r_name = t.name })
47
+
|> opt_mem "members" (list member_codec) ~enc:(fun t ->
48
+
match t.members with [] -> None | ms -> Some ms)
49
+
|> finish))
50
+
51
+
let empty_registry = { name = "opamverse"; members = [] }
52
+
53
+
let load ~fs path =
54
+
let path_str = Fpath.to_string path in
55
+
Logs.info (fun m -> m "Loading registry from path: %s" path_str);
56
+
try
57
+
let registry = Tomlt_eio.decode_path_exn codec ~fs path_str in
58
+
Logs.info (fun m -> m "Registry loaded: %d members" (List.length registry.members));
59
+
Ok registry
60
+
with
61
+
| Eio.Io _ as e ->
62
+
Logs.err (fun m -> m "Eio.Io error: %s" (Printexc.to_string e));
63
+
Error (Fmt.str "Registry IO error: %s" (Printexc.to_string e))
64
+
| Failure msg ->
65
+
Logs.err (fun m -> m "Registry parse error: %s" msg);
66
+
Error (Fmt.str "Invalid registry: %s" msg)
67
+
| exn ->
68
+
Logs.err (fun m -> m "Unexpected registry error: %s" (Printexc.to_string exn));
69
+
Error (Fmt.str "Registry error: %s" (Printexc.to_string exn))
70
+
71
+
let save ~fs path registry =
72
+
let path_str = Fpath.to_string path in
73
+
try
74
+
Tomlt_eio.encode_path codec registry ~fs path_str;
75
+
Ok ()
76
+
with Eio.Io _ as e -> Error (Printexc.to_string e)
77
+
78
+
let clone_or_pull ~proc ~fs ~config:_ () =
79
+
let registry_path = Verse_config.registry_path () in
80
+
let registry_toml = Fpath.(registry_path / "opamverse.toml") in
81
+
Logs.info (fun m -> m "Registry path: %a" Fpath.pp registry_path);
82
+
(* Check if registry directory exists as a git repo *)
83
+
let exists =
84
+
let path = Eio.Path.(fs / Fpath.to_string registry_path) in
85
+
match Eio.Path.kind ~follow:true path with
86
+
| `Directory -> Git.is_repo ~proc ~fs registry_path
87
+
| _ -> false
88
+
| exception _ -> false
89
+
in
90
+
if exists then begin
91
+
Logs.info (fun m -> m "Registry exists, pulling updates...");
92
+
(* Pull updates, but don't fail if pull fails *)
93
+
(match Git.pull ~proc ~fs registry_path with
94
+
| Ok () -> Logs.info (fun m -> m "Registry pull succeeded")
95
+
| Error e -> Logs.warn (fun m -> m "Registry pull failed: %a (using cached)" Git.pp_error e));
96
+
Logs.info (fun m -> m "Loading registry from %a" Fpath.pp registry_toml);
97
+
load ~fs registry_toml
98
+
end
99
+
else begin
100
+
Logs.info (fun m -> m "Registry not found, cloning from %s..." default_url);
101
+
(* Ensure parent directory exists *)
102
+
let parent = Fpath.parent registry_path in
103
+
let parent_path = Eio.Path.(fs / Fpath.to_string parent) in
104
+
(try Eio.Path.mkdirs ~perm:0o755 parent_path with Eio.Io _ -> ());
105
+
(* Try to clone the registry *)
106
+
let url = Uri.of_string default_url in
107
+
let branch = "main" in
108
+
match Git.clone ~proc ~fs ~url ~branch registry_path with
109
+
| Ok () ->
110
+
Logs.info (fun m -> m "Registry cloned successfully");
111
+
load ~fs registry_toml
112
+
| Error e ->
113
+
Logs.warn (fun m -> m "Registry clone failed: %a" Git.pp_error e);
114
+
Logs.info (fun m -> m "Creating empty local registry...");
115
+
(* Clone failed - create local registry directory with empty registry *)
116
+
let registry_eio = Eio.Path.(fs / Fpath.to_string registry_path) in
117
+
(try Eio.Path.mkdirs ~perm:0o755 registry_eio with Eio.Io _ -> ());
118
+
(* Initialize as git repo *)
119
+
(match Git.init ~proc ~fs registry_path with
120
+
| Ok () -> ()
121
+
| Error _ -> ());
122
+
(* Create empty registry file *)
123
+
(match save ~fs registry_toml empty_registry with
124
+
| Ok () -> ()
125
+
| Error _ -> ());
126
+
Ok empty_registry
127
+
end
128
+
129
+
let find_member t ~handle =
130
+
List.find_opt (fun m -> m.handle = handle) t.members
131
+
132
+
let find_members t ~handles =
133
+
List.filter (fun m -> List.mem m.handle handles) t.members
+62
monopam/lib/verse_registry.mli
+62
monopam/lib/verse_registry.mli
···
1
+
(** Opamverse registry management.
2
+
3
+
The registry is a git repository containing a [opamverse.toml] file that
4
+
lists community members and their monorepo URLs. *)
5
+
6
+
(** {1 Types} *)
7
+
8
+
type member = {
9
+
handle : string; (** Tangled handle (e.g., "alice.bsky.social") *)
10
+
monorepo : string; (** Git URL of the member's monorepo *)
11
+
opamrepo : string; (** Git URL of the member's opam overlay repository *)
12
+
}
13
+
(** A registry member entry. *)
14
+
15
+
type t = {
16
+
name : string; (** Registry name *)
17
+
members : member list; (** List of registered members *)
18
+
}
19
+
(** The parsed registry contents. *)
20
+
21
+
(** {1 Registry Operations} *)
22
+
23
+
val default_url : string
24
+
(** Default registry URL: [https://tangled.org/eeg.cl.cam.ac.uk/opamverse] *)
25
+
26
+
val clone_or_pull :
27
+
proc:_ Eio.Process.mgr ->
28
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
29
+
config:Verse_config.t ->
30
+
unit ->
31
+
(t, string) result
32
+
(** [clone_or_pull ~proc ~fs ~config ()] clones the registry if not present,
33
+
or pulls updates if it exists. Returns the parsed registry contents.
34
+
35
+
The registry is cloned to [config.registry_path].
36
+
37
+
@param proc Eio process manager
38
+
@param fs Eio filesystem
39
+
@param config Workspace configuration *)
40
+
41
+
val load : fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> (t, string) result
42
+
(** [load ~fs path] loads the registry from a [opamverse.toml] file.
43
+
44
+
@param fs Eio filesystem
45
+
@param path Path to the opamverse.toml file *)
46
+
47
+
(** {1 Member Lookup} *)
48
+
49
+
val find_member : t -> handle:string -> member option
50
+
(** [find_member registry ~handle] finds a member by their handle. *)
51
+
52
+
val find_members : t -> handles:string list -> member list
53
+
(** [find_members registry ~handles] finds multiple members by their handles.
54
+
Returns only the members that were found. *)
55
+
56
+
(** {1 Pretty Printing} *)
57
+
58
+
val pp_member : member Fmt.t
59
+
(** [pp_member] formats a registry member. *)
60
+
61
+
val pp : t Fmt.t
62
+
(** [pp] formats the registry. *)
+6
ocaml-claudeio/lib/model.ml
+6
ocaml-claudeio/lib/model.ml
···
7
7
[ `Sonnet_4_5
8
8
| `Sonnet_4
9
9
| `Sonnet_3_5
10
+
| `Opus_4_5
11
+
| `Opus_4_1
10
12
| `Opus_4
11
13
| `Haiku_4
12
14
| `Custom of string ]
···
15
17
| `Sonnet_4_5 -> "claude-sonnet-4-5"
16
18
| `Sonnet_4 -> "claude-sonnet-4"
17
19
| `Sonnet_3_5 -> "claude-sonnet-3-5"
20
+
| `Opus_4_5 -> "claude-opus-4-5"
21
+
| `Opus_4_1 -> "claude-opus-4-1"
18
22
| `Opus_4 -> "claude-opus-4"
19
23
| `Haiku_4 -> "claude-haiku-4"
20
24
| `Custom s -> s
···
23
27
| "claude-sonnet-4-5" -> `Sonnet_4_5
24
28
| "claude-sonnet-4" -> `Sonnet_4
25
29
| "claude-sonnet-3-5" -> `Sonnet_3_5
30
+
| "claude-opus-4-5" -> `Opus_4_5
31
+
| "claude-opus-4-1" -> `Opus_4_1
26
32
| "claude-opus-4" -> `Opus_4
27
33
| "claude-haiku-4" -> `Haiku_4
28
34
| s -> `Custom s
+3
ocaml-claudeio/lib/model.mli
+3
ocaml-claudeio/lib/model.mli
···
13
13
[ `Sonnet_4_5 (** claude-sonnet-4-5 - Most recent Sonnet model *)
14
14
| `Sonnet_4 (** claude-sonnet-4 - Sonnet 4 model *)
15
15
| `Sonnet_3_5 (** claude-sonnet-3-5 - Sonnet 3.5 model *)
16
+
| `Opus_4_5 (** claude-opus-4-5 - Most recent Opus model *)
17
+
| `Opus_4_1 (** claude-opus-4-1 - Opus 4.1 model *)
16
18
| `Opus_4 (** claude-opus-4 - Opus 4 model for complex tasks *)
17
19
| `Haiku_4 (** claude-haiku-4 - Fast, cost-effective Haiku model *)
18
20
| `Custom of string (** Custom model string for future/unknown models *) ]
···
23
25
24
26
Examples:
25
27
- [`Sonnet_4_5] becomes "claude-sonnet-4-5"
28
+
- [`Opus_4_5] becomes "claude-opus-4-5"
26
29
- [`Opus_4] becomes "claude-opus-4"
27
30
- [`Custom "my-model"] becomes "my-model" *)
28
31
+6
ocaml-claudeio/proto/model.ml
+6
ocaml-claudeio/proto/model.ml
···
7
7
[ `Sonnet_4_5
8
8
| `Sonnet_4
9
9
| `Sonnet_3_5
10
+
| `Opus_4_5
11
+
| `Opus_4_1
10
12
| `Opus_4
11
13
| `Haiku_4
12
14
| `Custom of string ]
···
15
17
| `Sonnet_4_5 -> "claude-sonnet-4-5"
16
18
| `Sonnet_4 -> "claude-sonnet-4"
17
19
| `Sonnet_3_5 -> "claude-sonnet-3-5"
20
+
| `Opus_4_5 -> "claude-opus-4-5"
21
+
| `Opus_4_1 -> "claude-opus-4-1"
18
22
| `Opus_4 -> "claude-opus-4"
19
23
| `Haiku_4 -> "claude-haiku-4"
20
24
| `Custom s -> s
···
23
27
| "claude-sonnet-4-5" -> `Sonnet_4_5
24
28
| "claude-sonnet-4" -> `Sonnet_4
25
29
| "claude-sonnet-3-5" -> `Sonnet_3_5
30
+
| "claude-opus-4-5" -> `Opus_4_5
31
+
| "claude-opus-4-1" -> `Opus_4_1
26
32
| "claude-opus-4" -> `Opus_4
27
33
| "claude-haiku-4" -> `Haiku_4
28
34
| s -> `Custom s
+3
ocaml-claudeio/proto/model.mli
+3
ocaml-claudeio/proto/model.mli
···
13
13
[ `Sonnet_4_5 (** claude-sonnet-4-5 - Most recent Sonnet model *)
14
14
| `Sonnet_4 (** claude-sonnet-4 - Sonnet 4 model *)
15
15
| `Sonnet_3_5 (** claude-sonnet-3-5 - Sonnet 3.5 model *)
16
+
| `Opus_4_5 (** claude-opus-4-5 - Most recent Opus model *)
17
+
| `Opus_4_1 (** claude-opus-4-1 - Opus 4.1 model *)
16
18
| `Opus_4 (** claude-opus-4 - Opus 4 model for complex tasks *)
17
19
| `Haiku_4 (** claude-haiku-4 - Fast, cost-effective Haiku model *)
18
20
| `Custom of string (** Custom model string for future/unknown models *) ]
···
23
25
24
26
Examples:
25
27
- [`Sonnet_4_5] becomes "claude-sonnet-4-5"
28
+
- [`Opus_4_5] becomes "claude-opus-4-5"
26
29
- [`Opus_4] becomes "claude-opus-4"
27
30
- [`Custom "my-model"] becomes "my-model" *)
28
31
+18
ocaml-conpool/lib/conpool.ml
+18
ocaml-conpool/lib/conpool.ml
···
15
15
module Stats = Stats
16
16
module Cmd = Cmd
17
17
18
+
(* Track whether TLS tracing has been suppressed *)
19
+
let tls_tracing_suppressed = ref false
20
+
21
+
(* Suppress TLS tracing debug output (hexdumps) unless explicitly enabled *)
22
+
let suppress_tls_tracing () =
23
+
if not !tls_tracing_suppressed then begin
24
+
tls_tracing_suppressed := true;
25
+
match List.find_opt (fun s -> Logs.Src.name s = "tls.tracing") (Logs.Src.list ()) with
26
+
| Some tls_src ->
27
+
(* Only suppress if currently at Debug level *)
28
+
(match Logs.Src.level tls_src with
29
+
| Some Logs.Debug -> Logs.Src.set_level tls_src (Some Logs.Warning)
30
+
| _ -> ())
31
+
| None -> ()
32
+
end
33
+
18
34
(** {1 Error Types} *)
19
35
20
36
type error =
···
178
194
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
179
195
in
180
196
let tls = Tls_eio.client_of_flow ~host tls_config socket in
197
+
(* Suppress TLS tracing after first connection creates the source *)
198
+
suppress_tls_tracing ();
181
199
Log.info (fun m ->
182
200
m "TLS connection established to %a" Endpoint.pp endpoint);
183
201
((tls :> connection), Some tls)
+9
ocaml-html5rw/.claude/settings.local.json
+9
ocaml-html5rw/.claude/settings.local.json
+1
-1
ocaml-imap/dune-project
+1
-1
ocaml-imap/dune-project
+1
-1
ocaml-imap/imapd.opam
+1
-1
ocaml-imap/imapd.opam
+18
ocaml-requests/lib/one.ml
+18
ocaml-requests/lib/one.ml
···
31
31
| Http1 (** HTTP/1.x (including plain HTTP) *)
32
32
| Http2 (** HTTP/2 negotiated via ALPN *)
33
33
34
+
(* Track whether TLS tracing has been suppressed *)
35
+
let tls_tracing_suppressed = ref false
36
+
37
+
(* Suppress TLS tracing debug output (hexdumps) unless explicitly enabled *)
38
+
let suppress_tls_tracing () =
39
+
if not !tls_tracing_suppressed then begin
40
+
tls_tracing_suppressed := true;
41
+
match List.find_opt (fun s -> Logs.Src.name s = "tls.tracing") (Logs.Src.list ()) with
42
+
| Some tls_src ->
43
+
(* Only suppress if currently at Debug level *)
44
+
(match Logs.Src.level tls_src with
45
+
| Some Logs.Debug -> Logs.Src.set_level tls_src (Some Logs.Warning)
46
+
| _ -> ())
47
+
| None -> ()
48
+
end
49
+
34
50
(* Helper to wrap connection with TLS if needed.
35
51
Returns the TLS flow and the negotiated protocol. *)
36
52
let wrap_tls flow ~host ~verify_tls ~tls_config ~min_tls_version =
···
61
77
in
62
78
63
79
let tls_flow = Tls_eio.client_of_flow ~host:domain tls_cfg flow in
80
+
(* Suppress TLS tracing after first connection creates the tls.tracing source *)
81
+
suppress_tls_tracing ();
64
82
65
83
(* Check negotiated ALPN protocol *)
66
84
let protocol = match Tls_eio.epoch tls_flow with
+28
-8
ocaml-zulip/lib/zulip/channels.ml
+28
-8
ocaml-zulip/lib/zulip/channels.ml
···
43
43
in
44
44
Error.decode_or_raise streams_codec json "parsing channels list"
45
45
46
+
(* Search for a channel by name in the list of all channels *)
47
+
let find_channel_by_name channels ~name =
48
+
match List.find_opt (fun ch -> Channel.name ch = name) channels with
49
+
| Some ch -> Channel.stream_id ch
50
+
| None -> None
51
+
46
52
let get_id client ~name =
47
-
let encoded_name = Uri.pct_encode name in
48
53
let response_codec =
49
54
Jsont.Object.(
50
55
map ~kind:"StreamIdResponse" Fun.id
51
56
|> mem "stream_id" Jsont.int ~enc:Fun.id
52
57
|> finish)
53
58
in
54
-
let json =
55
-
Client.request client ~method_:`GET
56
-
~path:("/api/v1/get_stream_id?stream=" ^ encoded_name)
57
-
()
58
-
in
59
-
Error.decode_or_raise response_codec json
60
-
(Printf.sprintf "getting stream id for %s" name)
59
+
try
60
+
let json =
61
+
Client.request client ~method_:`GET
62
+
~path:"/api/v1/get_stream_id"
63
+
~params:[("stream", name)]
64
+
()
65
+
in
66
+
Error.decode_or_raise response_codec json
67
+
(Printf.sprintf "getting stream id for %s" name)
68
+
with Eio.Io (Error.E { code = Bad_request; _ }, _) ->
69
+
(* Fallback: search through channel list for exact name match *)
70
+
let channels = list client in
71
+
match find_channel_by_name channels ~name with
72
+
| Some id -> id
73
+
| None ->
74
+
(* Re-raise with helpful context about available channels *)
75
+
let available = List.map Channel.name channels |> String.concat ", " in
76
+
Error.raise_with_context
77
+
(Error.make ~code:Bad_request
78
+
~message:(Printf.sprintf "Channel '%s' not found. Available: %s" name available)
79
+
())
80
+
"getting stream id for %s" name
61
81
62
82
let get_by_id client ~stream_id =
63
83
let response_codec =
+5
-4
ocaml-zulip/lib/zulip/client.ml
+5
-4
ocaml-zulip/lib/zulip/client.ml
···
37
37
| `PATCH -> "PATCH"
38
38
39
39
let request t ~method_ ~path ?params ?body ?content_type () =
40
-
let url = Auth.server_url t.auth ^ path in
41
-
Log.debug (fun m -> m "Request: %s %s" (method_to_string method_) path);
40
+
let base_url = Auth.server_url t.auth ^ path in
42
41
43
42
(* Convert params to URL query string if provided *)
44
43
let url =
45
44
params
46
45
|> Option.map (fun p ->
47
-
Uri.of_string url
46
+
Uri.of_string base_url
48
47
|> Fun.flip
49
48
(List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v)))
50
49
p
51
50
|> Uri.to_string)
52
-
|> Option.value ~default:url
51
+
|> Option.value ~default:base_url
53
52
in
53
+
54
+
Log.debug (fun m -> m "Request: %s %s" (method_to_string method_) url);
54
55
55
56
(* Prepare request body if provided *)
56
57
let body_opt =
+66
-14
poe/lib/changelog.ml
+66
-14
poe/lib/changelog.ml
···
13
13
author: string;
14
14
email: string;
15
15
subject: string;
16
+
files: string list;
16
17
}
17
18
18
19
type channel_member = {
···
20
21
email: string;
21
22
}
22
23
24
+
let get_commit_files ~proc ~cwd ~hash =
25
+
Eio.Switch.run @@ fun sw ->
26
+
let buf = Buffer.create 256 in
27
+
let child = Eio.Process.spawn proc ~sw ~cwd
28
+
~stdout:(Eio.Flow.buffer_sink buf)
29
+
["git"; "diff-tree"; "--no-commit-id"; "--name-only"; "-r"; hash]
30
+
in
31
+
match Eio.Process.await child with
32
+
| `Exited 0 ->
33
+
Buffer.contents buf
34
+
|> String.split_on_char '\n'
35
+
|> List.filter (fun s -> String.trim s <> "")
36
+
| _ -> []
37
+
23
38
let get_git_log ~proc ~cwd ~since_head =
24
39
Log.info (fun m -> m "Getting commits since %s" since_head);
25
40
Eio.Switch.run @@ fun sw ->
···
37
52
|> List.filter_map (fun line ->
38
53
match String.split_on_char '|' line with
39
54
| [hash; author; email; subject] ->
40
-
Some { hash; author; email; subject }
55
+
let files = get_commit_files ~proc ~cwd ~hash in
56
+
Some { hash; author; email; subject; files }
41
57
| _ -> None)
42
58
| _ -> []
43
59
···
58
74
|> List.filter_map (fun line ->
59
75
match String.split_on_char '|' line with
60
76
| [hash; author; email; subject] ->
61
-
Some { hash; author; email; subject }
77
+
let files = get_commit_files ~proc ~cwd ~hash in
78
+
Some { hash; author; email; subject; files }
62
79
| _ -> None)
63
80
| _ -> []
64
81
···
84
101
let create_claude_client ~sw ~proc ~clock =
85
102
let options =
86
103
Claude.Options.default
87
-
|> Claude.Options.with_model `Opus_4
104
+
|> Claude.Options.with_model `Opus_4_5
88
105
|> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions
89
106
|> Claude.Options.with_allowed_tools []
90
107
in
···
103
120
in
104
121
String.concat "" text
105
122
123
+
(* Extract sub-project name from a file path (first directory component) *)
124
+
let subproject_of_file path =
125
+
match String.split_on_char '/' path with
126
+
| dir :: _ when dir <> "" && dir <> "." -> Some dir
127
+
| _ -> None
128
+
129
+
(* Get unique sub-projects affected by a list of commits *)
130
+
let affected_subprojects commits =
131
+
commits
132
+
|> List.concat_map (fun c -> c.files)
133
+
|> List.filter_map subproject_of_file
134
+
|> List.sort_uniq String.compare
135
+
106
136
let generate ~sw ~proc ~clock ~commits ~members =
107
137
if commits = [] then None
108
138
else begin
109
139
Log.info (fun m -> m "Generating narrative changelog with Claude for %d commits" (List.length commits));
110
140
111
-
(* Format commits for the prompt *)
141
+
(* Get affected sub-projects *)
142
+
let subprojects = affected_subprojects commits in
143
+
let subprojects_text = String.concat ", " subprojects in
144
+
145
+
(* Format commits for the prompt, including files *)
112
146
let commits_text = commits
113
147
|> List.map (fun c ->
114
-
Printf.sprintf "- %s by %s <%s>: %s" c.hash c.author c.email c.subject)
148
+
let files_text = match c.files with
149
+
| [] -> ""
150
+
| files -> Printf.sprintf "\n Files: %s" (String.concat ", " files)
151
+
in
152
+
Printf.sprintf "- %s by %s <%s>: %s%s" c.hash c.author c.email c.subject files_text)
115
153
|> String.concat "\n"
116
154
in
117
155
···
123
161
in
124
162
125
163
let prompt = Printf.sprintf
126
-
{|You are writing a brief changelog update for a Zulip channel. Given these git commits:
164
+
{|You are writing a changelog update for a Zulip channel about a monorepo.
165
+
166
+
Git commits:
127
167
128
168
%s
129
169
130
-
And these channel members who can be @mentioned (use the exact @**Name** format):
170
+
Affected sub-projects: %s
171
+
172
+
Channel members who can be @mentioned (use exact @**Name** format):
131
173
132
174
%s
133
175
134
-
Write a brief, narrative changelog (2-4 sentences) that:
135
-
1. Focuses on user-visible features and API changes
136
-
2. Uses @**Name** mentions when a commit author matches a channel member (by name or email)
137
-
3. Is conversational and not bullet-pointed
138
-
4. Skips internal refactoring or minor fixes unless they're the only changes
176
+
Write a bullet-point changelog. Each bullet should have the project name first in bold, then a brief description of the change, and the change type in italics at the end.
139
177
140
-
If commits are purely internal/maintenance with no user-visible changes, just write a single sentence noting routine maintenance.
178
+
Format:
179
+
- **project-name**: Description of the change. *change type*
141
180
142
-
Write ONLY the changelog text, no preamble or explanation.|} commits_text members_text
181
+
Example:
182
+
- **ocaml-claudeio**: Added model types for Opus 4.5 and 4.1. *new feature*
183
+
- **ocaml-zulip**: Fixed encoding bug in channel name lookups that affected names with spaces. *bug fix*
184
+
- **poe**: Updated to use the latest Opus model for changelog generation. *enhancement*
185
+
186
+
Guidelines:
187
+
1. One bullet per logical change (group related commits)
188
+
2. Project name in bold at the start
189
+
3. One or two sentences describing the change
190
+
4. Change type in italics at the end: *new feature*, *bug fix*, *enhancement*, *refactoring*, etc.
191
+
5. Use @**Name** mentions when authors match channel members
192
+
6. No emojis
193
+
194
+
Write ONLY the bullet points, no preamble or header.|} commits_text subprojects_text members_text
143
195
in
144
196
145
197
let response = ask_claude ~sw ~proc ~clock prompt in
+7
-8
poe/lib/changelog.mli
+7
-8
poe/lib/changelog.mli
···
16
16
author: string;
17
17
email: string;
18
18
subject: string;
19
+
files: string list;
19
20
}
20
-
(** A git commit with metadata. *)
21
+
(** A git commit with metadata and list of changed files. *)
21
22
22
23
type channel_member = {
23
24
full_name: string;
···
60
61
commits:commit list ->
61
62
members:channel_member list ->
62
63
string option
63
-
(** [generate ~sw ~proc ~clock ~commits ~members] generates a narrative
64
+
(** [generate ~sw ~proc ~clock ~commits ~members] generates a bullet-point
64
65
changelog using Claude. Returns [None] if commits is empty, or
65
-
[Some narrative] with the generated text.
66
+
[Some changelog] with the generated text.
66
67
67
-
The narrative:
68
-
- Focuses on user-visible features and API changes
69
-
- Uses @**Name** mentions for authors matching channel members
70
-
- Is conversational prose, not bullet points
71
-
- Summarizes internal changes briefly *)
68
+
Each bullet has the project name in bold, a description of the change,
69
+
and the change type in italics (e.g. "new feature", "bug fix").
70
+
Zulip @-mentions are used for authors matching channel members. *)
+1
-1
poe/lib/handler.ml
+1
-1
poe/lib/handler.ml
···
56
56
let create_claude_client env =
57
57
let options =
58
58
Claude.Options.default
59
-
|> Claude.Options.with_model `Sonnet_4_5
59
+
|> Claude.Options.with_model `Opus_4_5
60
60
|> Claude.Options.with_permission_mode Claude.Permissions.Mode.Bypass_permissions
61
61
|> Claude.Options.with_allowed_tools [ "Read"; "Glob"; "Grep" ]
62
62
|> Claude.Options.with_append_system_prompt
+7
-1
root.opam
+7
-1
root.opam
···
12
12
"ca-certs"
13
13
"cmarkit"
14
14
"cmdliner"
15
+
"conf-pam"
15
16
"crowbar"
16
17
"cstruct"
17
18
"decompress"
···
25
26
"fmt"
26
27
"fpath"
27
28
"geojson"
29
+
"ipaddr"
30
+
"js_of_ocaml"
31
+
"js_of_ocaml-compiler"
32
+
"js_of_ocaml-ppx"
28
33
"jsonm"
29
34
"jsont"
30
35
"kdf"
···
51
56
"uunf"
52
57
"uutf"
53
58
"uuuu"
59
+
"wasm_of_ocaml-compiler"
54
60
"x509"
55
61
"xdg"
56
-
"yojson"
62
+
"xmlm"
57
63
"zarith"
58
64
]
59
65
build: [