anil.recoil.org
My aggregated monorepo of OCaml code, automaintained
Fork: configure src/ repo to accept pushes to checked-out branch
Add Git_config action and set receive.denyCurrentBranch=updateInstead
on newly created src/ repos. This allows monopam sync to push changes
from mono/ to the src/ checkout without git refusing.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+9
monopam/lib/fork_join.ml
+9
monopam/lib/fork_join.ml
···
18
18
| Check_remote_exists of string (** URL - informational check *)
19
19
| Create_directory of Fpath.t
20
20
| Git_init of Fpath.t
21
+
| Git_config of { repo: Fpath.t; key: string; value: string } (** Set git config *)
21
22
| Git_clone of { url: string; dest: Fpath.t; branch: string }
22
23
| Git_subtree_split of { repo: Fpath.t; prefix: string }
23
24
| Git_subtree_add of { repo: Fpath.t; prefix: string; url: Uri.t; branch: string }
···
88
89
Fmt.pf ppf "Create directory: %a" Fpath.pp path
89
90
| Git_init path ->
90
91
Fmt.pf ppf "Initialize git repository: %a" Fpath.pp path
92
+
| Git_config { repo = _; key; value } ->
93
+
Fmt.pf ppf "Set git config %s = %s" key value
91
94
| Git_clone { url; dest; branch } ->
92
95
Fmt.pf ppf "Clone %s (branch: %s) to %a" url branch Fpath.pp dest
93
96
| Git_subtree_split { repo = _; prefix } ->
···
468
471
Create_directory checkouts;
469
472
Git_subtree_split { repo = monorepo; prefix };
470
473
Git_init src_path;
474
+
(* Allow pushing to checked-out branch (for monopam sync) *)
475
+
Git_config { repo = src_path; key = "receive.denyCurrentBranch"; value = "updateInstead" };
471
476
Git_add_remote { repo = src_path; name = "mono"; url = Fpath.to_string monorepo };
472
477
Git_push_ref { repo = monorepo; target = Fpath.to_string src_path; ref_spec = "SPLIT_COMMIT:refs/heads/main" };
473
478
Git_checkout { repo = src_path; branch };
···
478
483
Create_directory checkouts;
479
484
Create_directory src_path;
480
485
Git_init src_path;
486
+
(* Allow pushing to checked-out branch (for monopam sync) *)
487
+
Git_config { repo = src_path; key = "receive.denyCurrentBranch"; value = "updateInstead" };
481
488
Git_branch_rename { repo = src_path; new_name = branch };
482
489
Copy_directory { src = subtree_path; dest = src_path };
483
490
Git_add_all src_path;
···
702
709
Ok ()
703
710
| Git_init path ->
704
711
Git.init ~proc ~fs path |> Result.map_error (fun e -> Git_error e)
712
+
| Git_config { repo; key; value } ->
713
+
Git.config ~proc ~fs ~key ~value repo |> Result.map_error (fun e -> Git_error e)
705
714
| Git_clone { url; dest; branch } ->
706
715
Git.clone ~proc ~fs ~url:(Uri.of_string url) ~branch dest
707
716
|> Result.map_error (fun e -> Git_error e)
+1
monopam/lib/fork_join.mli
+1
monopam/lib/fork_join.mli
···
42
42
| Check_remote_exists of string (** URL - informational check *)
43
43
| Create_directory of Fpath.t
44
44
| Git_init of Fpath.t
45
+
| Git_config of { repo: Fpath.t; key: string; value: string } (** Set git config *)
45
46
| Git_clone of { url: string; dest: Fpath.t; branch: string }
46
47
| Git_subtree_split of { repo: Fpath.t; prefix: string }
47
48
| Git_subtree_add of { repo: Fpath.t; prefix: string; url: Uri.t; branch: string }
+4
monopam/lib/git.ml
+4
monopam/lib/git.ml
···
649
649
let args = if recursive then [ "rm"; "-r"; target ] else [ "rm"; target ] in
650
650
run_git_ok ~proc ~cwd args |> Result.map ignore
651
651
652
+
let config ~proc ~fs ~key ~value path =
653
+
let cwd = path_to_eio ~fs path in
654
+
run_git_ok ~proc ~cwd [ "config"; key; value ] |> Result.map ignore
655
+
652
656
let has_subtree_history ~proc ~fs ~repo ~prefix () =
653
657
(* Check if there's subtree commit history for this prefix.
654
658
Returns true if we can find a subtree-related commit message. *)
+10
monopam/lib/git.mli
+10
monopam/lib/git.mli
···
624
624
in the repository at [path]. If [recursive] is true, removes directories
625
625
recursively (git rm -r). *)
626
626
627
+
val config :
628
+
proc:_ Eio.Process.mgr ->
629
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
630
+
key:string ->
631
+
value:string ->
632
+
Fpath.t ->
633
+
(unit, error) result
634
+
(** [config ~proc ~fs ~key ~value path] sets a git config value in the
635
+
repository at [path]. *)
636
+
627
637
val has_subtree_history :
628
638
proc:_ Eio.Process.mgr ->
629
639
fs:Eio.Fs.dir_ty Eio.Path.t ->