anil.recoil.org
My aggregated monorepo of OCaml code, automaintained
Update sources.toml when forking packages
- Add upstream_url and subtree_name to fork_result type
- Extract subtree name from fork URL (last path component)
- Automatically update sources.toml with fork entry containing:
- url: the user's fork URL
- upstream: original dev-repo URL from source package
- reason: "Forked from <handle>"
This ensures sync uses the correct URLs for forked packages.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+20
monopam/bin/main.ml
+20
monopam/bin/main.ml
···
769
769
(List.length result.packages_forked) result.source_handle;
770
770
List.iter (fun p -> Fmt.pr " %s@." p) result.packages_forked
771
771
end else begin
772
+
(* Update sources.toml with fork information *)
773
+
let mono_path = Monopam.Verse_config.mono_path config in
774
+
let sources_path = Fpath.(mono_path / "sources.toml") in
775
+
let sources =
776
+
match Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with
777
+
| Ok s -> s
778
+
| Error _ -> Monopam.Sources_registry.empty
779
+
in
780
+
let entry = Monopam.Sources_registry.{
781
+
url = result.fork_url;
782
+
upstream = Some result.upstream_url;
783
+
branch = None;
784
+
reason = Some (Fmt.str "Forked from %s" result.source_handle);
785
+
} in
786
+
let sources = Monopam.Sources_registry.add sources ~subtree:result.subtree_name entry in
787
+
(match Monopam.Sources_registry.save ~fs:(fs :> _ Eio.Path.t) sources_path sources with
788
+
| Ok () ->
789
+
Fmt.pr "Updated sources.toml with fork entry for %s@." result.subtree_name
790
+
| Error msg ->
791
+
Fmt.epr "Warning: Failed to update sources.toml: %s@." msg);
772
792
Fmt.pr "Forked %d package(s): %a@."
773
793
(List.length result.packages_forked)
774
794
Fmt.(list ~sep:(any ", ") string) result.packages_forked;
+26
-3
monopam/lib/verse.ml
+26
-3
monopam/lib/verse.ml
···
419
419
packages_forked : string list; (** Package names that were forked *)
420
420
source_handle : string; (** Handle of the verse member we forked from *)
421
421
fork_url : string; (** URL of the fork *)
422
+
upstream_url : string; (** Original dev-repo URL (upstream) *)
423
+
subtree_name : string; (** Name for the subtree directory (derived from fork URL) *)
422
424
}
423
425
426
+
(** Extract subtree name from a URL (last path component without .git suffix) *)
427
+
let subtree_name_from_url url =
428
+
let uri = Uri.of_string url in
429
+
let path = Uri.path uri in
430
+
(* Remove leading slash and .git suffix *)
431
+
let path = if String.length path > 0 && path.[0] = '/' then
432
+
String.sub path 1 (String.length path - 1)
433
+
else path in
434
+
let path = if String.ends_with ~suffix:".git" path then
435
+
String.sub path 0 (String.length path - 4)
436
+
else path in
437
+
(* Get last component *)
438
+
match String.rindex_opt path '/' with
439
+
| Some i -> String.sub path (i + 1) (String.length path - i - 1)
440
+
| None -> path
441
+
424
442
let pp_fork_result ppf r =
425
-
Fmt.pf ppf "@[<v>Forked %d package(s) from %s:@, @[<v>%a@]@,Fork URL: %s@]"
443
+
Fmt.pf ppf "@[<v>Forked %d package(s) from %s:@, @[<v>%a@]@,Fork URL: %s@,Upstream: %s@,Subtree: %s@]"
426
444
(List.length r.packages_forked)
427
445
r.source_handle
428
446
Fmt.(list ~sep:cut string) r.packages_forked
429
447
r.fork_url
448
+
r.upstream_url
449
+
r.subtree_name
430
450
431
451
(** Fork a package from a verse member's opam repo into your workspace.
432
452
···
466
486
List.filter (fun p -> Package.same_repo p pkg) pkgs
467
487
in
468
488
let pkg_names = List.map Package.name related_pkgs in
489
+
(* Get upstream URL and subtree name *)
490
+
let upstream_url = Uri.to_string (Package.dev_repo pkg) in
491
+
let subtree_name = subtree_name_from_url fork_url in
469
492
(* Check for conflicts in user's opam-repo *)
470
493
let user_opam_repo = Verse_config.opam_repo_path config in
471
494
let conflicts =
···
477
500
Error (Package_already_exists conflicts)
478
501
else if dry_run then
479
502
(* Dry run - just report what would be done *)
480
-
Ok { packages_forked = pkg_names; source_handle = handle; fork_url }
503
+
Ok { packages_forked = pkg_names; source_handle = handle; fork_url; upstream_url; subtree_name }
481
504
else begin
482
505
(* Fork each package *)
483
506
let results =
···
504
527
| Some (Error e) -> Error e
505
528
| _ ->
506
529
let forked_names = List.filter_map (function Ok n -> Some n | Error _ -> None) results in
507
-
Ok { packages_forked = forked_names; source_handle = handle; fork_url }
530
+
Ok { packages_forked = forked_names; source_handle = handle; fork_url; upstream_url; subtree_name }
508
531
end
+2
monopam/lib/verse.mli
+2
monopam/lib/verse.mli
···
154
154
packages_forked : string list; (** Package names that were forked *)
155
155
source_handle : string; (** Handle of the verse member we forked from *)
156
156
fork_url : string; (** URL of the fork *)
157
+
upstream_url : string; (** Original dev-repo URL (upstream) *)
158
+
subtree_name : string; (** Name for the subtree directory (derived from fork URL) *)
157
159
}
158
160
159
161
val pp_fork_result : fork_result Fmt.t