+2 -2

lib/changes.ml

reviewed

··· 464 464 week_start week_end); 465 465 Buffer.add_string buf "## Commits this week:\n\n"; 466 466 List.iter 467 467 - (fun (commit : Git.log_entry) -> 467 467 + (fun (commit : Git_cli.log_entry) -> 468 468 Buffer.add_string buf 469 469 (Printf.sprintf "### %s by %s (%s)\n" 470 470 (String.sub commit.hash 0 (min 7 (String.length commit.hash))) ··· 517 517 (Printf.sprintf "Generate a user-facing changelog entry for %s.\n\n" date); 518 518 Buffer.add_string buf "## Commits today:\n\n"; 519 519 List.iter 520 520 - (fun (commit : Git.log_entry) -> 520 520 + (fun (commit : Git_cli.log_entry) -> 521 521 Buffer.add_string buf 522 522 (Printf.sprintf "### %s by %s (%s)\n" 523 523 (String.sub commit.hash 0 (min 7 (String.length commit.hash)))

+5 -5

lib/changes.mli

reviewed

··· 165 165 repository:string -> 166 166 week_start:string -> 167 167 week_end:string -> 168 168 - Git.log_entry list -> 168 168 + Git_cli.log_entry list -> 169 169 string 170 170 (** [generate_prompt ~repository ~week_start ~week_end commits] creates the 171 171 prompt to send to Claude for weekly changelog generation. *) ··· 174 174 repository:string -> 175 175 week_start:string -> 176 176 week_end:string -> 177 177 - Git.log_entry list -> 177 177 + Git_cli.log_entry list -> 178 178 string 179 179 (** [generate_weekly_prompt ~repository ~week_start ~week_end commits] creates 180 180 the prompt to send to Claude for weekly changelog generation. *) 181 181 182 182 val generate_daily_prompt : 183 183 - repository:string -> date:string -> Git.log_entry list -> string 183 183 + repository:string -> date:string -> Git_cli.log_entry list -> string 184 184 (** [generate_daily_prompt ~repository ~date commits] creates the prompt to send 185 185 to Claude for daily changelog generation. *) 186 186 ··· 197 197 repository:string -> 198 198 week_start:string -> 199 199 week_end:string -> 200 200 - Git.log_entry list -> 200 200 + Git_cli.log_entry list -> 201 201 (claude_response option, string) result 202 202 (** [analyze_commits ~sw ~process_mgr ~clock ~repository ~week_start ~week_end 203 203 commits] sends commits to Claude for weekly analysis and returns the parsed ··· 209 209 clock:float Eio.Time.clock_ty Eio.Resource.t -> 210 210 repository:string -> 211 211 date:string -> 212 212 - Git.log_entry list -> 212 212 + Git_cli.log_entry list -> 213 213 (claude_response option, string) result 214 214 (** [analyze_commits_daily ~sw ~process_mgr ~clock ~repository ~date commits] 215 215 sends commits to Claude for daily analysis and returns the parsed response.

+13 -12

lib/cross_status.ml

reviewed

··· 141 141 (** Get subtree info for a given prefix in a monorepo. *) 142 142 let get_subtree_info ~proc ~fs ~monorepo_path ~prefix () : subtree_info = 143 143 let upstream_commit = 144 144 - Git.subtree_last_upstream_commit ~proc ~fs ~repo:monorepo_path ~prefix () 144 144 + Git_cli.subtree_last_upstream_commit ~proc ~fs ~repo:monorepo_path ~prefix 145 145 + () 145 146 in 146 147 { monorepo_path; prefix; upstream_commit } 147 148 ··· 154 155 | Some my, Some their when my = their -> Same 155 156 | Some my, Some their -> 156 157 (* Try to compare using checkout if available *) 157 157 - if not (Git.is_repo ~proc ~fs checkout_path) then Unknown 158 158 + if not (Git_cli.is_repo ~proc ~fs checkout_path) then Unknown 158 159 else begin 159 160 (* Check if either is ancestor of the other *) 160 161 let my_is_ancestor = 161 161 - Git.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:my 162 162 + Git_cli.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:my 162 163 ~commit2:their () 163 164 in 164 165 let their_is_ancestor = 165 165 - Git.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:their 166 166 + Git_cli.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:their 166 167 ~commit2:my () 167 168 in 168 169 match (my_is_ancestor, their_is_ancestor) with 169 170 | true, false -> 170 171 (* My commit is ancestor of theirs -> I'm behind *) 171 172 let behind = 172 172 - Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base:my 173 173 - ~head:their () 173 173 + Git_cli.count_commits_between ~proc ~fs ~repo:checkout_path 174 174 + ~base:my ~head:their () 174 175 in 175 176 I_am_behind behind 176 177 | false, true -> 177 178 (* Their commit is ancestor of mine -> I'm ahead *) 178 179 let ahead = 179 179 - Git.count_commits_between ~proc ~fs ~repo:checkout_path 180 180 + Git_cli.count_commits_between ~proc ~fs ~repo:checkout_path 180 181 ~base:their ~head:my () 181 182 in 182 183 I_am_ahead ahead ··· 186 187 | false, false -> ( 187 188 (* Neither is ancestor -> diverged *) 188 189 match 189 189 - Git.merge_base ~proc ~fs ~repo:checkout_path ~commit1:my 190 190 + Git_cli.merge_base ~proc ~fs ~repo:checkout_path ~commit1:my 190 191 ~commit2:their () 191 192 with 192 193 | Error _ -> Unknown 193 194 | Ok base -> 194 195 let my_ahead = 195 195 - Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base 196 196 - ~head:my () 196 196 + Git_cli.count_commits_between ~proc ~fs ~repo:checkout_path 197 197 + ~base ~head:my () 197 198 in 198 199 let their_ahead = 199 199 - Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base 200 200 - ~head:their () 200 200 + Git_cli.count_commits_between ~proc ~fs ~repo:checkout_path 201 201 + ~base ~head:their () 201 202 in 202 203 Diverged { my_ahead; their_ahead }) 203 204 end

+9 -9

lib/doctor.ml

reviewed

··· 363 363 url : string; 364 364 ahead : int; [@warning "-69"] (** Commits we have that remote doesn't *) 365 365 behind : int; (** Commits remote has that we don't *) 366 366 - incoming_commits : Git.log_entry list; 366 366 + incoming_commits : Git_cli.log_entry list; 367 367 (** Commits from remote we don't have *) 368 368 } 369 369 (** Information about a single remote's status *) ··· 371 371 (** Analyze a single remote for a checkout *) 372 372 let analyze_remote ~proc ~fs ~checkout_dir ~remote_name = 373 373 let url = 374 374 - Git.get_remote_url ~proc ~fs ~remote:remote_name checkout_dir 374 374 + Git_cli.get_remote_url ~proc ~fs ~remote:remote_name checkout_dir 375 375 |> Option.value ~default:"(unknown)" 376 376 in 377 377 (* Try to get ahead/behind for this remote *) 378 378 let ahead, behind = 379 379 - match Git.ahead_behind ~proc ~fs ~remote:remote_name checkout_dir with 379 379 + match Git_cli.ahead_behind ~proc ~fs ~remote:remote_name checkout_dir with 380 380 | Ok ab -> (ab.ahead, ab.behind) 381 381 | Error _ -> (0, 0) 382 382 in ··· 385 385 if behind > 0 then 386 386 let tip = Printf.sprintf "%s/main" remote_name in 387 387 match 388 388 - Git.log_range ~proc ~fs ~base:"HEAD" ~tip ~max_count:20 checkout_dir 388 388 + Git_cli.log_range ~proc ~fs ~base:"HEAD" ~tip ~max_count:20 checkout_dir 389 389 with 390 390 | Ok commits -> commits 391 391 | Error _ -> ( 392 392 (* Try with master branch *) 393 393 match 394 394 - Git.log_range ~proc ~fs ~base:"HEAD" 394 394 + Git_cli.log_range ~proc ~fs ~base:"HEAD" 395 395 ~tip:(Printf.sprintf "%s/master" remote_name) 396 396 ~max_count:20 checkout_dir 397 397 with ··· 403 403 404 404 (** Analyze all remotes for a checkout *) 405 405 let analyze_checkout_remotes ~proc ~fs ~checkout_dir = 406 406 - let remotes = Git.list_remotes ~proc ~fs checkout_dir in 406 406 + let remotes = Git_cli.list_remotes ~proc ~fs checkout_dir in 407 407 List.map 408 408 (fun remote_name -> analyze_remote ~proc ~fs ~checkout_dir ~remote_name) 409 409 remotes ··· 483 483 (Printf.sprintf "**%s** (%s) - %d commits behind:\n" 484 484 r.remote_name r.url r.behind); 485 485 List.iter 486 486 - (fun (c : Git.log_entry) -> 486 486 + (fun (c : Git_cli.log_entry) -> 487 487 let short_hash = 488 488 String.sub c.hash 0 (min 7 (String.length c.hash)) 489 489 in ··· 939 939 940 940 (* Check opam-repo for dirty state *) 941 941 let opam_repo = Config.Paths.opam_repo config in 942 942 - if Git.is_dirty ~proc ~fs opam_repo then 942 942 + if Git_cli.is_dirty ~proc ~fs opam_repo then 943 943 warnings := "opam-repo has uncommitted changes" :: !warnings; 944 944 945 945 (* Check monorepo for dirty state *) 946 946 let monorepo = Config.Paths.monorepo config in 947 947 - if Git.is_dirty ~proc ~fs monorepo then 947 947 + if Git_cli.is_dirty ~proc ~fs monorepo then 948 948 warnings := "monorepo has uncommitted changes" :: !warnings; 949 949 950 950 (* Analyze all remotes for each checkout *)

+2 -1

lib/dune

reviewed

··· 16 16 jsont.bytesrw 17 17 ptime 18 18 sexplib0 19 19 - parsexp)) 19 19 + parsexp 20 20 + git))

+10 -8

lib/feature.ml

reviewed

··· 1 1 type error = 2 2 - | Git_error of Git.error 2 2 + | Git_error of Git_cli.error 3 3 | Feature_exists of string 4 4 | Feature_not_found of string 5 5 | Config_error of string 6 6 7 7 let pp_error ppf = function 8 8 - | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 8 8 + | Git_error e -> Fmt.pf ppf "Git error: %a" Git_cli.pp_error e 9 9 | Feature_exists name -> Fmt.pf ppf "Feature '%s' already exists" name 10 10 | Feature_not_found name -> Fmt.pf ppf "Feature '%s' not found" name 11 11 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg ··· 48 48 let work_dir = work_path config in 49 49 let wt_path = feature_path config name in 50 50 (* Check if feature already exists *) 51 51 - if Git.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path then 51 51 + if Git_cli.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path then 52 52 Error (Feature_exists name) 53 53 else begin 54 54 (* Ensure work directory exists *) ··· 56 56 (try Eio.Path.mkdirs ~perm:0o755 work_eio with Eio.Io _ -> ()); 57 57 (* Create the worktree with a new branch *) 58 58 match 59 59 - Git.Worktree.add ~proc ~fs ~repo:mono ~path:wt_path ~branch:name () 59 59 + Git_cli.Worktree.add ~proc ~fs ~repo:mono ~path:wt_path ~branch:name () 60 60 with 61 61 | Error e -> Error (Git_error e) 62 62 | Ok () -> Ok { name; path = wt_path; branch = name } ··· 66 66 let mono = Verse_config.mono_path config in 67 67 let wt_path = feature_path config name in 68 68 (* Check if feature exists *) 69 69 - if not (Git.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path) then 69 69 + if not (Git_cli.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path) then 70 70 Error (Feature_not_found name) 71 71 else 72 72 - match Git.Worktree.remove ~proc ~fs ~repo:mono ~path:wt_path ~force () with 72 72 + match 73 73 + Git_cli.Worktree.remove ~proc ~fs ~repo:mono ~path:wt_path ~force () 74 74 + with 73 75 | Error e -> Error (Git_error e) 74 76 | Ok () -> Ok () 75 77 76 78 let list ~proc ~fs ~config () = 77 79 let mono = Verse_config.mono_path config in 78 80 let work_dir = work_path config in 79 79 - let all_worktrees = Git.Worktree.list ~proc ~fs mono in 81 81 + let all_worktrees = Git_cli.Worktree.list ~proc ~fs mono in 80 82 (* Filter to only worktrees under work/ directory *) 81 83 List.filter_map 82 82 - (fun (wt : Git.Worktree.entry) -> 84 84 + (fun (wt : Git_cli.Worktree.entry) -> 83 85 (* Check if this worktree is under the work directory *) 84 86 let wt_str = Fpath.to_string wt.path in 85 87 let work_str = Fpath.to_string work_dir in

+1 -1

lib/feature.mli

reviewed

··· 7 7 8 8 (** Errors from feature operations. *) 9 9 type error = 10 10 - | Git_error of Git.error (** Git operation error *) 10 10 + | Git_error of Git_cli.error (** Git operation error *) 11 11 | Feature_exists of string (** Feature worktree already exists *) 12 12 | Feature_not_found of string (** Feature worktree does not exist *) 13 13 | Config_error of string (** Configuration error *)

+35 -32

lib/fork_join.ml

reviewed

··· 2 2 3 3 type error = 4 4 | Config_error of string 5 5 - | Git_error of Git.error 5 5 + | Git_error of Git_cli.error 6 6 | Subtree_not_found of string 7 7 | Src_already_exists of string 8 8 | Src_not_found of string ··· 64 64 65 65 let pp_error ppf = function 66 66 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg 67 67 - | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 67 67 + | Git_error e -> Fmt.pf ppf "Git error: %a" Git_cli.pp_error e 68 68 | Subtree_not_found name -> 69 69 Fmt.pf ppf "Subtree not found in monorepo: %s" name 70 70 | Src_already_exists name -> ··· 79 79 let error_hint = function 80 80 | Config_error _ -> 81 81 Some "Run 'monopam init --handle <your-handle>' to create a workspace." 82 82 - | Git_error (Git.Dirty_worktree _) -> 82 82 + | Git_error (Git_cli.Dirty_worktree _) -> 83 83 Some "Commit or stash your changes first: git status" 84 84 | Git_error _ -> None 85 85 | Subtree_not_found name -> ··· 459 459 let branch = Verse_config.default_branch in 460 460 461 461 (* Gather discovery information *) 462 462 - let mono_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 462 462 + let mono_exists = Git_cli.Subtree.exists ~fs ~repo:monorepo ~prefix in 463 463 let src_exists = is_directory ~fs src_path in 464 464 let has_subtree_hist = 465 465 if mono_exists then 466 466 - Git.has_subtree_history ~proc ~fs ~repo:monorepo ~prefix () 466 466 + Git_cli.has_subtree_history ~proc ~fs ~repo:monorepo ~prefix () 467 467 else false 468 468 in 469 469 let opam_files = ··· 612 612 let src_path = Fpath.(checkouts / name) in 613 613 614 614 (* Gather discovery information *) 615 615 - let subtree_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 615 615 + let subtree_exists = Git_cli.Subtree.exists ~fs ~repo:monorepo ~prefix in 616 616 let src_exists = is_directory ~fs src_path in 617 617 let local_is_repo = 618 618 if is_local then begin 619 619 match Fpath.of_string source with 620 620 - | Ok path -> Some (Git.is_repo ~proc ~fs path) 620 620 + | Ok path -> Some (Git_cli.is_repo ~proc ~fs path) 621 621 | Error _ -> Some false 622 622 end 623 623 else None ··· 754 754 let src_path = Fpath.(checkouts / name) in 755 755 756 756 (* Gather discovery information *) 757 757 - let subtree_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 757 757 + let subtree_exists = Git_cli.Subtree.exists ~fs ~repo:monorepo ~prefix in 758 758 let src_exists = is_directory ~fs src_path in 759 759 let src_is_repo = 760 760 - if src_exists then Git.is_repo ~proc ~fs src_path else false 760 760 + if src_exists then Git_cli.is_repo ~proc ~fs src_path else false 761 761 in 762 762 let opam_files = if src_exists then find_opam_files ~fs src_path else [] in 763 763 ··· 820 820 ensure_dir ~fs path; 821 821 Ok () 822 822 | Git_init path -> 823 823 - Git.init ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 823 823 + Git_cli.init ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 824 824 | Git_config { repo; key; value } -> 825 825 - Git.config ~proc ~fs ~key ~value repo 825 825 + Git_cli.config ~proc ~fs ~key ~value repo 826 826 |> Result.map_error (fun e -> Git_error e) 827 827 | Git_clone { url; dest; branch } -> 828 828 - Git.clone ~proc ~fs ~url:(Uri.of_string url) ~branch dest 828 828 + Git_cli.clone ~proc ~fs ~url:(Uri.of_string url) ~branch dest 829 829 |> Result.map_error (fun e -> Git_error e) 830 830 | Git_subtree_split { repo; prefix } -> 831 831 - Git.Subtree.split ~proc ~fs ~repo ~prefix () 831 831 + Git_cli.Subtree.split ~proc ~fs ~repo ~prefix () 832 832 |> Result.map (fun commit -> state.split_commit <- Some commit) 833 833 |> Result.map_error (fun e -> Git_error e) 834 834 | Git_subtree_add { repo; prefix; url; branch } -> 835 835 - Git.Subtree.add ~proc ~fs ~repo ~prefix ~url ~branch () 835 835 + Git_cli.Subtree.add ~proc ~fs ~repo ~prefix ~url ~branch () 836 836 |> Result.map_error (fun e -> Git_error e) 837 837 | Git_add_remote { repo; name; url } -> 838 838 - Git.add_remote ~proc ~fs ~name ~url repo 838 838 + Git_cli.add_remote ~proc ~fs ~name ~url repo 839 839 |> Result.map_error (fun e -> Git_error e) 840 840 | Git_push_ref { repo; target; ref_spec } -> 841 841 (* Replace SPLIT_COMMIT placeholder with actual commit if available *) ··· 863 863 else ref_spec 864 864 | None -> ref_spec 865 865 in 866 866 - Git.push_ref ~proc ~fs ~repo ~target ~ref_spec () 866 866 + Git_cli.push_ref ~proc ~fs ~repo ~target ~ref_spec () 867 867 |> Result.map_error (fun e -> Git_error e) 868 868 | Git_checkout { repo; branch } -> 869 869 - Git.checkout ~proc ~fs ~branch repo 869 869 + Git_cli.checkout ~proc ~fs ~branch repo 870 870 |> Result.map_error (fun e -> Git_error e) 871 871 | Git_branch_rename { repo; new_name } -> 872 872 - Git.branch_rename ~proc ~fs ~new_name repo 872 872 + Git_cli.branch_rename ~proc ~fs ~new_name repo 873 873 |> Result.map_error (fun e -> Git_error e) 874 874 | Copy_directory { src; dest } -> 875 875 copy_directory ~fs ~src ~dest; 876 876 Ok () 877 877 | Git_add_all path -> 878 878 - Git.add_all ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 878 878 + Git_cli.add_all ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 879 879 | Git_commit { repo; message } -> 880 880 - Git.commit ~proc ~fs ~message repo 880 880 + Git_cli.commit ~proc ~fs ~message repo 881 881 |> Result.map_error (fun e -> Git_error e) 882 882 | Git_rm { repo; path; recursive } -> 883 883 - Git.rm ~proc ~fs ~recursive repo path 883 883 + Git_cli.rm ~proc ~fs ~recursive repo path 884 884 |> Result.map_error (fun e -> Git_error e) 885 885 | Update_sources_toml { path; name; entry } -> ( 886 886 let sources = ··· 945 945 let subtree_path = Fpath.(monorepo / prefix) in 946 946 let src_path = Fpath.(checkouts / name) in 947 947 (* Validate: mono/<name>/ must exist *) 948 948 - if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then 948 948 + if not (Git_cli.Subtree.exists ~fs ~repo:monorepo ~prefix) then 949 949 Error (Subtree_not_found name) (* Validate: src/<name>/ must not exist *) 950 950 else if is_directory ~fs src_path then Error (Src_already_exists name) 951 951 else begin ··· 963 963 } 964 964 else begin 965 965 (* Split the subtree to get history *) 966 966 - match Git.Subtree.split ~proc ~fs ~repo:monorepo ~prefix () with 966 966 + match Git_cli.Subtree.split ~proc ~fs ~repo:monorepo ~prefix () with 967 967 | Error e -> Error (Git_error e) 968 968 | Ok split_commit -> ( 969 969 (* Ensure src/ exists *) 970 970 ensure_dir ~fs checkouts; 971 971 (* Initialize new git repo at src/<name>/ *) 972 972 - match Git.init ~proc ~fs src_path with 972 972 + match Git_cli.init ~proc ~fs src_path with 973 973 | Error e -> Error (Git_error e) 974 974 | Ok () -> ( 975 975 (* Add 'origin' remote pointing to monorepo path temporarily *) 976 976 let mono_str = Fpath.to_string monorepo in 977 977 match 978 978 - Git.add_remote ~proc ~fs ~name:"mono" ~url:mono_str src_path 978 978 + Git_cli.add_remote ~proc ~fs ~name:"mono" ~url:mono_str src_path 979 979 with 980 980 | Error e -> Error (Git_error e) 981 981 | Ok () -> ( 982 982 (* Push split commit to local repo *) 983 983 let ref_spec = split_commit ^ ":refs/heads/main" in 984 984 match 985 985 - Git.push_ref ~proc ~fs ~repo:monorepo 985 985 + Git_cli.push_ref ~proc ~fs ~repo:monorepo 986 986 ~target:(Fpath.to_string src_path) ~ref_spec () 987 987 with 988 988 | Error e -> Error (Git_error e) 989 989 | Ok () -> ( 990 990 (* Checkout main branch *) 991 991 - match Git.checkout ~proc ~fs ~branch:"main" src_path with 991 991 + match 992 992 + Git_cli.checkout ~proc ~fs ~branch:"main" src_path 993 993 + with 992 994 | Error e -> Error (Git_error e) 993 995 | Ok () -> ( 994 996 (* Set push URL if provided *) ··· 996 998 match push_url with 997 999 | Some url -> ( 998 1000 match 999 999 - Git.add_remote ~proc ~fs ~name:"origin" ~url 1000 1000 - src_path 1001 1001 + Git_cli.add_remote ~proc ~fs ~name:"origin" 1002 1002 + ~url src_path 1001 1003 with 1002 1004 | Error e -> Error (Git_error e) 1003 1005 | Ok () -> Ok ()) ··· 1065 1067 let subtree_path = Fpath.(monorepo / prefix) in 1066 1068 let src_path = Fpath.(checkouts / name) in 1067 1069 (* Validate: mono/<name>/ must not exist *) 1068 1068 - if Git.Subtree.exists ~fs ~repo:monorepo ~prefix then 1070 1070 + if Git_cli.Subtree.exists ~fs ~repo:monorepo ~prefix then 1069 1071 Error (Subtree_already_exists name) 1070 1072 else if dry_run then 1071 1073 Ok ··· 1082 1084 (* Clone to src/<name>/ *) 1083 1085 let branch = Verse_config.default_branch in 1084 1086 let uri = Uri.of_string url in 1085 1085 - match Git.clone ~proc ~fs ~url:uri ~branch src_path with 1087 1087 + match Git_cli.clone ~proc ~fs ~url:uri ~branch src_path with 1086 1088 | Error e -> Error (Git_error e) 1087 1089 | Ok () -> ( 1088 1090 (* Add subtree to monorepo *) 1089 1091 match 1090 1090 - Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url:uri ~branch () 1092 1092 + Git_cli.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url:uri ~branch 1093 1093 + () 1091 1094 with 1092 1095 | Error e -> Error (Git_error e) 1093 1096 | Ok () ->

+1 -1

lib/fork_join.mli

reviewed

··· 15 15 16 16 type error = 17 17 | Config_error of string (** Configuration error *) 18 18 - | Git_error of Git.error (** Git operation failed *) 18 18 + | Git_error of Git_cli.error (** Git operation failed *) 19 19 | Subtree_not_found of string (** Subtree not found in monorepo *) 20 20 | Src_already_exists of string (** Source checkout already exists *) 21 21 | Src_not_found of string (** Source checkout not found *)

+1 -1

lib/forks.ml

reviewed

··· 683 683 else begin 684 684 (* Check if we have a local checkout *) 685 685 let checkout_path = Fpath.(checkouts_path / repo_name) in 686 686 - let have_checkout = Git.is_repo ~proc ~fs checkout_path in 686 686 + let have_checkout = Git_cli.is_repo ~proc ~fs checkout_path in 687 687 688 688 (* Process each verse source *) 689 689 let verse_with_rel =

+23 -39

lib/git.ml lib/git_cli.ml

reviewed

··· 224 224 Ok { ahead = int_of_string ahead; behind = int_of_string behind } 225 225 | _ -> Ok { ahead = 0; behind = 0 }) 226 226 227 227 - module Subtree = struct 228 228 - let exists ~fs ~repo ~prefix = 229 229 - let path = Eio.Path.(fs / Fpath.to_string repo / prefix) in 230 230 - match Eio.Path.kind ~follow:true path with 231 231 - | `Directory -> true 232 232 - | _ -> false 233 233 - | exception _ -> false 234 234 - 235 235 - let add ~proc ~fs ~repo ~prefix ~url ~branch () = 236 236 - if exists ~fs ~repo ~prefix then Error (Subtree_prefix_exists prefix) 237 237 - else 238 238 - let cwd = path_to_eio ~fs repo in 239 239 - let url_str = Uri.to_string url in 240 240 - run_git_ok_with_retry ~proc ~cwd 241 241 - [ "subtree"; "add"; "--prefix"; prefix; url_str; branch; "--squash" ] 242 242 - |> Result.map ignore 243 243 - 244 244 - let pull ~proc ~fs ~repo ~prefix ~url ~branch () = 245 245 - if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix) 246 246 - else 247 247 - let cwd = path_to_eio ~fs repo in 248 248 - let url_str = Uri.to_string url in 249 249 - run_git_ok_with_retry ~proc ~cwd 250 250 - [ "subtree"; "pull"; "--prefix"; prefix; url_str; branch; "--squash" ] 251 251 - |> Result.map ignore 227 227 + (* Fetch from URL and return the commit hash for the branch *) 228 228 + let fetch_url ~proc ~fs ~repo ~url ~branch () = 229 229 + let cwd = path_to_eio ~fs repo in 230 230 + let url_str = Uri.to_string url in 231 231 + (* Fetch into FETCH_HEAD *) 232 232 + match run_git_ok_with_retry ~proc ~cwd [ "fetch"; url_str; branch ] with 233 233 + | Error e -> Error e 234 234 + | Ok _ -> ( 235 235 + (* Get the fetched commit hash *) 236 236 + match run_git_ok ~proc ~cwd [ "rev-parse"; "FETCH_HEAD" ] with 237 237 + | Error e -> Error e 238 238 + | Ok hash -> Ok (String.trim hash)) 252 239 253 253 - let push ~proc ~fs ~repo ~prefix ~url ~branch () = 254 254 - if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix) 255 255 - else 256 256 - let cwd = path_to_eio ~fs repo in 257 257 - let url_str = Uri.to_string url in 258 258 - run_git_ok_with_retry ~proc ~cwd 259 259 - [ "subtree"; "push"; "--prefix"; prefix; url_str; branch ] 260 260 - |> Result.map ignore 240 240 + let push_refspec ~proc ~fs ~repo ~url ~refspec () = 241 241 + let cwd = path_to_eio ~fs repo in 242 242 + let url_str = Uri.to_string url in 243 243 + run_git_ok_with_retry ~proc ~cwd [ "push"; url_str; refspec ] 244 244 + |> Result.map ignore 261 245 262 262 - let split ~proc ~fs ~repo ~prefix () = 263 263 - if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix) 264 264 - else 265 265 - let cwd = path_to_eio ~fs repo in 266 266 - run_git_ok ~proc ~cwd [ "subtree"; "split"; "--prefix"; prefix ] 267 267 - end 246 246 + let subtree_prefix_exists ~fs ~repo ~prefix = 247 247 + let path = Eio.Path.(fs / Fpath.to_string repo / prefix) in 248 248 + match Eio.Path.kind ~follow:true path with 249 249 + | `Directory -> true 250 250 + | _ -> false 251 251 + | exception _ -> false 268 252 269 253 let init ~proc ~fs path = 270 254 let cwd = path_to_eio ~fs (Fpath.parent path) in

lib/git.mli lib/git_cli.mli

reviewed

+169 -114

lib/monopam.ml

reviewed

··· 1 1 module Config = Config 2 2 module Package = Package 3 3 module Opam_repo = Opam_repo 4 4 - module Git = Git 4 4 + module Git_cli = Git_cli 5 5 module Status = Status 6 6 module Changes = Changes 7 7 module Verse = Verse ··· 24 24 type error = 25 25 | Config_error of string 26 26 | Repo_error of Opam_repo.error 27 27 - | Git_error of Git.error 27 27 + | Git_error of Git_cli.error 28 28 | Dirty_state of Package.t list 29 29 | Monorepo_dirty 30 30 | Package_not_found of string ··· 33 33 let pp_error ppf = function 34 34 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg 35 35 | Repo_error e -> Fmt.pf ppf "Repository error: %a" Opam_repo.pp_error e 36 36 - | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 36 36 + | Git_error e -> Fmt.pf ppf "Git error: %a" Git_cli.pp_error e 37 37 | Dirty_state pkgs -> 38 38 Fmt.pf ppf "Dirty packages: %a" 39 39 Fmt.(list ~sep:comma (using Package.name string)) ··· 54 54 | Repo_error (Opam_repo.Not_git_remote _) -> 55 55 Some "The dev-repo must be a git URL (git+https:// or git://)." 56 56 | Repo_error _ -> None 57 57 - | Git_error (Git.Dirty_worktree _) -> 57 57 + | Git_error (Git_cli.Dirty_worktree _) -> 58 58 Some "Commit or stash your changes first: cd <repo> && git status" 59 59 - | Git_error (Git.Not_a_repo _) -> 59 59 + | Git_error (Git_cli.Not_a_repo _) -> 60 60 Some "Run 'monopam sync' to clone missing repositories." 61 61 - | Git_error (Git.Subtree_prefix_missing _) -> 61 61 + | Git_error (Git_cli.Subtree_prefix_missing _) -> 62 62 Some "Run 'monopam sync' to set up the subtree." 63 63 - | Git_error (Git.Remote_not_found _) -> 63 63 + | Git_error (Git_cli.Remote_not_found _) -> 64 64 Some "Check that the remote is configured: git remote -v" 65 65 - | Git_error (Git.Branch_not_found _) -> 65 65 + | Git_error (Git_cli.Branch_not_found _) -> 66 66 Some "Check available branches: git branch -a" 67 67 - | Git_error (Git.Command_failed (cmd, _)) 67 67 + | Git_error (Git_cli.Command_failed (cmd, _)) 68 68 when String.starts_with ~prefix:"git push" cmd -> 69 69 Some "Check your network connection and git credentials." 70 70 - | Git_error (Git.Command_failed (cmd, _)) 70 70 + | Git_error (Git_cli.Command_failed (cmd, _)) 71 71 when String.starts_with ~prefix:"git subtree" cmd -> 72 72 Some "Run 'monopam status' to check repository state." 73 73 | Git_error _ -> None ··· 385 385 Log.info (fun m -> 386 386 m "Cloning %s from %a (branch: %s)" (Package.repo_name pkg) Uri.pp 387 387 (Package.dev_repo pkg) branch); 388 388 - Git.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 388 388 + Git_cli.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 389 389 in 390 390 let is_directory = 391 391 match Eio.Path.kind ~follow:true checkout_eio with ··· 394 394 | exception Eio.Io _ -> false 395 395 in 396 396 if not is_directory then do_clone () 397 397 - else if not (Git.is_repo ~proc ~fs checkout_dir) then do_clone () 397 397 + else if not (Git_cli.is_repo ~proc ~fs checkout_dir) then do_clone () 398 398 else begin 399 399 Log.info (fun m -> m "Fetching %s" (Package.repo_name pkg)); 400 400 - match Git.fetch ~proc ~fs checkout_dir with 400 400 + match Git_cli.fetch ~proc ~fs checkout_dir with 401 401 | Error e -> Error e 402 402 | Ok () -> 403 403 Log.info (fun m -> m "Updating %s to %s" (Package.repo_name pkg) branch); 404 404 - Git.merge_ff ~proc ~fs ~branch checkout_dir 404 404 + Git_cli.merge_ff ~proc ~fs ~branch checkout_dir 405 405 end 406 406 407 407 (* Group packages by their repository *) ··· 675 675 let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in 676 676 let init_and_commit () = 677 677 Log.info (fun m -> m "Initializing monorepo at %a" Fpath.pp monorepo); 678 678 - match Git.init ~proc ~fs monorepo with 678 678 + match Git_cli.init ~proc ~fs monorepo with 679 679 | Error e -> Error (Git_error e) 680 680 | Ok () -> ( 681 681 (* Create dune-project file so the monorepo builds *) ··· 702 702 (* Commit *) 703 703 Log.debug (fun m -> m "Creating initial commit in monorepo"); 704 704 match 705 705 - Git.commit_allow_empty ~proc ~fs 705 705 + Git_cli.commit_allow_empty ~proc ~fs 706 706 ~message: 707 707 "Initial commit with dune-project, CLAUDE.md, and .gitignore" 708 708 monorepo ··· 740 740 | _ -> false 741 741 | exception Eio.Io _ -> false 742 742 in 743 743 - if is_directory && Git.is_repo ~proc ~fs monorepo then begin 743 743 + if is_directory && Git_cli.is_repo ~proc ~fs monorepo then begin 744 744 Log.debug (fun m -> 745 745 m "Monorepo already initialized at %a" Fpath.pp monorepo); 746 746 ensure_file ~filename:"CLAUDE.md" ~content:claude_md_content; ··· 917 917 (* Pull from local checkout, not remote URL - ensures push/pull use same source *) 918 918 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 919 919 let url = Uri.of_string (Fpath.to_string checkout_dir) in 920 920 - if Git.Subtree.exists ~fs ~repo:monorepo ~prefix then begin 921 921 - Log.info (fun m -> 922 922 - m "Pulling subtree %s from %a" prefix Fpath.pp checkout_dir); 923 923 - match Git.Subtree.pull ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 924 924 - | Ok () -> Ok false (* not newly added *) 925 925 - | Error e -> Error (Git_error e) 926 926 - end 927 927 - else begin 928 928 - Log.info (fun m -> 929 929 - m "Adding subtree %s from %a" prefix Fpath.pp checkout_dir); 930 930 - match Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 931 931 - | Ok () -> Ok true (* newly added *) 932 932 - | Error e -> Error (Git_error e) 933 933 - end 920 920 + let subtree_exists = 921 921 + Git_cli.subtree_prefix_exists ~fs ~repo:monorepo ~prefix 922 922 + in 923 923 + (* Fetch from checkout and get commit hash *) 924 924 + match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with 925 925 + | Error e -> Error (Git_error e) 926 926 + | Ok hash_hex -> 927 927 + let repo_path = Fpath.to_string monorepo in 928 928 + let git_repo = Git.Repository.open_repo ~fs repo_path in 929 929 + let commit = Git.Hash.of_hex hash_hex in 930 930 + let user = 931 931 + Git.User.make ~name:"monopam" ~email:"monopam@localhost" 932 932 + ~date:(Int64.of_float (Unix.time ())) 933 933 + () 934 934 + in 935 935 + if subtree_exists then begin 936 936 + Log.info (fun m -> 937 937 + m "Pulling subtree %s from %a" prefix Fpath.pp checkout_dir); 938 938 + let message = 939 939 + Fmt.str 940 940 + "Merge '%s/' from %s\n\n\ 941 941 + git-subtree-dir: %s\n\ 942 942 + git-subtree-mainline: %s\n" 943 943 + prefix (Uri.to_string url) prefix hash_hex 944 944 + in 945 945 + match 946 946 + Git.Subtree.merge git_repo ~prefix ~commit ~author:user 947 947 + ~committer:user ~message () 948 948 + with 949 949 + | Ok _ -> Ok false (* not newly added *) 950 950 + | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 951 951 + end 952 952 + else begin 953 953 + Log.info (fun m -> 954 954 + m "Adding subtree %s from %a" prefix Fpath.pp checkout_dir); 955 955 + let message = 956 956 + Fmt.str 957 957 + "Add '%s/' from %s\n\n\ 958 958 + git-subtree-dir: %s\n\ 959 959 + git-subtree-mainline: %s\n" 960 960 + prefix (Uri.to_string url) prefix hash_hex 961 961 + in 962 962 + match 963 963 + Git.Subtree.add git_repo ~prefix ~commit ~author:user ~committer:user 964 964 + ~message () 965 965 + with 966 966 + | Ok _ -> Ok true (* newly added *) 967 967 + | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 968 968 + end 934 969 935 970 (* Check if checkout exists and is a repo *) 936 971 let checkout_exists ~proc ~fs ~config pkg = ··· 938 973 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 939 974 let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in 940 975 match Eio.Path.kind ~follow:true checkout_eio with 941 941 - | `Directory -> Git.is_repo ~proc ~fs checkout_dir 976 976 + | `Directory -> Git_cli.is_repo ~proc ~fs checkout_dir 942 977 | _ -> false 943 978 | exception Eio.Io _ -> false 944 979 ··· 947 982 let checkouts_root = Config.Paths.checkouts config in 948 983 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 949 984 let branch = get_branch ~config pkg in 950 950 - match Git.ahead_behind ~proc ~fs ~branch checkout_dir with 985 985 + match Git_cli.ahead_behind ~proc ~fs ~branch checkout_dir with 951 986 | Ok ab -> ab.behind 952 987 | Error _ -> 0 953 988 ··· 955 990 let fs_t = fs_typed fs in 956 991 (* Update the opam repo first - clone if needed *) 957 992 let opam_repo = Config.Paths.opam_repo config in 958 958 - if Git.is_repo ~proc ~fs:fs_t opam_repo then begin 993 993 + if Git_cli.is_repo ~proc ~fs:fs_t opam_repo then begin 959 994 Log.info (fun m -> m "Updating opam repo at %a" Fpath.pp opam_repo); 960 995 let result = 961 996 let ( let* ) = Result.bind in 962 962 - let* () = Git.fetch ~proc ~fs:fs_t opam_repo in 963 963 - Git.merge_ff ~proc ~fs:fs_t opam_repo 997 997 + let* () = Git_cli.fetch ~proc ~fs:fs_t opam_repo in 998 998 + Git_cli.merge_ff ~proc ~fs:fs_t opam_repo 964 999 in 965 1000 match result with 966 1001 | Ok () -> () 967 1002 | Error e -> 968 968 - Log.warn (fun m -> m "Failed to update opam repo: %a" Git.pp_error e) 1003 1003 + Log.warn (fun m -> 1004 1004 + m "Failed to update opam repo: %a" Git_cli.pp_error e) 969 1005 end 970 1006 else begin 971 1007 (* Opam repo doesn't exist - clone it if we have a URL *) ··· 975 1011 m "Cloning opam repo from %s to %a" url Fpath.pp opam_repo); 976 1012 let url = Uri.of_string url in 977 1013 let branch = Config.default_branch in 978 978 - match Git.clone ~proc ~fs:fs_t ~url ~branch opam_repo with 1014 1014 + match Git_cli.clone ~proc ~fs:fs_t ~url ~branch opam_repo with 979 1015 | Ok () -> Log.info (fun m -> m "Opam repo cloned successfully") 980 1016 | Error e -> 981 981 - Log.warn (fun m -> m "Failed to clone opam repo: %a" Git.pp_error e) 982 982 - ) 1017 1017 + Log.warn (fun m -> 1018 1018 + m "Failed to clone opam repo: %a" Git_cli.pp_error e)) 983 1019 | None -> 984 1020 Log.info (fun m -> 985 1021 m "Opam repo at %a does not exist and no URL provided" Fpath.pp ··· 1135 1171 let checkouts_root = Config.Paths.checkouts config in 1136 1172 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 1137 1173 let branch = get_branch ~config pkg in 1138 1138 - if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then begin 1174 1174 + if not (Git_cli.subtree_prefix_exists ~fs ~repo:monorepo ~prefix) then begin 1139 1175 Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix); 1140 1176 Ok () 1141 1177 end ··· 1144 1180 let needs_clone = 1145 1181 match Eio.Path.kind ~follow:true checkout_eio with 1146 1182 | exception Eio.Io _ -> true 1147 1147 - | `Directory when Git.is_repo ~proc ~fs checkout_dir -> false 1183 1183 + | `Directory when Git_cli.is_repo ~proc ~fs checkout_dir -> false 1148 1184 | _ -> true 1149 1185 in 1150 1186 let* () = ··· 1154 1190 end 1155 1191 else Ok () 1156 1192 in 1157 1157 - (* Use git subtree push to export commits to the checkout. 1193 1193 + (* Use native subtree split + push to export commits to the checkout. 1158 1194 This preserves commit identity, ensuring round-trips converge. *) 1159 1195 let checkout_url = Uri.of_string (Fpath.to_string checkout_dir) in 1160 1196 Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir); 1161 1161 - let* () = 1162 1162 - Git.Subtree.push ~proc ~fs ~repo:monorepo ~prefix ~url:checkout_url 1163 1163 - ~branch () 1164 1164 - in 1165 1165 - Ok () 1197 1197 + let repo_path = Fpath.to_string monorepo in 1198 1198 + let git_repo = Git.Repository.open_repo ~fs repo_path in 1199 1199 + match Git.Repository.read_ref git_repo "HEAD" with 1200 1200 + | None -> Error (Git_error (Git_cli.Io_error "no HEAD ref found")) 1201 1201 + | Some head -> ( 1202 1202 + match Git.Subtree.split git_repo ~prefix ~head () with 1203 1203 + | Ok None -> Error (Git_error (Git_cli.Subtree_prefix_missing prefix)) 1204 1204 + | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 1205 1205 + | Ok (Some split_hash) -> 1206 1206 + let refspec = 1207 1207 + Git.Hash.to_hex split_hash ^ ":refs/heads/" ^ branch 1208 1208 + in 1209 1209 + let* () = 1210 1210 + Git_cli.push_refspec ~proc ~fs ~repo:monorepo ~url:checkout_url 1211 1211 + ~refspec () 1212 1212 + in 1213 1213 + Ok ()) 1166 1214 end 1167 1215 1168 1216 let push ~proc ~fs ~config ?package ?(upstream = false) () = ··· 1223 1271 m "Pushing %s to %s" (Package.repo_name pkg) push_url); 1224 1272 (* Set the push URL for origin *) 1225 1273 (match 1226 1226 - Git.set_push_url ~proc ~fs:fs_t ~url:push_url 1274 1274 + Git_cli.set_push_url ~proc ~fs:fs_t ~url:push_url 1227 1275 checkout_dir 1228 1276 with 1229 1277 | Ok () -> () 1230 1278 | Error e -> 1231 1279 Log.warn (fun m -> 1232 1232 - m "Failed to set push URL: %a" Git.pp_error e)); 1280 1280 + m "Failed to set push URL: %a" Git_cli.pp_error e)); 1233 1281 match 1234 1234 - Git.push_remote ~proc ~fs:fs_t ~branch checkout_dir 1282 1282 + Git_cli.push_remote ~proc ~fs:fs_t ~branch checkout_dir 1235 1283 with 1236 1284 | Ok () -> 1237 1285 Log.app (fun m -> ··· 1256 1304 type sync_failure = { 1257 1305 repo_name : string; 1258 1306 phase : sync_phase; 1259 1259 - error : Git.error; 1307 1307 + error : Git_cli.error; 1260 1308 } 1261 1309 1262 1310 type sync_summary = { ··· 1275 1323 | `Push_remote -> Fmt.string ppf "push-remote" 1276 1324 1277 1325 let pp_sync_failure ppf f = 1278 1278 - Fmt.pf ppf "%s (%a): %a" f.repo_name pp_sync_phase f.phase Git.pp_error 1326 1326 + Fmt.pf ppf "%s (%a): %a" f.repo_name pp_sync_phase f.phase Git_cli.pp_error 1279 1327 f.error 1280 1328 1281 1329 let pp_sync_summary ppf s = ··· 1298 1346 | _ -> false 1299 1347 | exception Eio.Io _ -> false 1300 1348 in 1301 1301 - let was_cloned = not (is_directory && Git.is_repo ~proc ~fs checkout_dir) in 1349 1349 + let was_cloned = 1350 1350 + not (is_directory && Git_cli.is_repo ~proc ~fs checkout_dir) 1351 1351 + in 1302 1352 if was_cloned then begin 1303 1353 Log.info (fun m -> 1304 1354 m "Cloning %s from %a (branch: %s)" (Package.repo_name pkg) Uri.pp 1305 1355 (Package.dev_repo pkg) branch); 1306 1356 match 1307 1307 - Git.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 1357 1357 + Git_cli.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 1308 1358 with 1309 1359 | Ok () -> 1310 1360 (* Configure checkout to accept pushes to current branch. ··· 1340 1390 let branch = get_branch ~config pkg in 1341 1391 (* Get commits behind before fetching *) 1342 1392 let behind_before = 1343 1343 - match Git.ahead_behind ~proc ~fs ~branch checkout_dir with 1393 1393 + match Git_cli.ahead_behind ~proc ~fs ~branch checkout_dir with 1344 1394 | Ok ab -> ab.behind 1345 1395 | Error _ -> 0 1346 1396 in 1347 1397 Log.info (fun m -> m "Fetching %s (all remotes)" (Package.repo_name pkg)); 1348 1348 - match Git.fetch_all ~proc ~fs checkout_dir with 1398 1398 + match Git_cli.fetch_all ~proc ~fs checkout_dir with 1349 1399 | Error e -> Error e 1350 1400 | Ok () -> 1351 1401 (* Get commits behind after fetching *) 1352 1402 let behind_after = 1353 1353 - match Git.ahead_behind ~proc ~fs ~branch checkout_dir with 1403 1403 + match Git_cli.ahead_behind ~proc ~fs ~branch checkout_dir with 1354 1404 | Ok ab -> ab.behind 1355 1405 | Error _ -> 0 1356 1406 in ··· 1362 1412 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 1363 1413 let branch = get_branch ~config pkg in 1364 1414 Log.info (fun m -> m "Merging %s to %s" (Package.repo_name pkg) branch); 1365 1365 - Git.merge_ff ~proc ~fs ~branch checkout_dir 1415 1415 + Git_cli.merge_ff ~proc ~fs ~branch checkout_dir 1366 1416 1367 1417 (* Push checkout to remote - safe for parallel execution *) 1368 1418 let push_remote_safe ~proc ~fs ~config pkg = ··· 1372 1422 let push_url = url_to_push_url (Package.dev_repo pkg) in 1373 1423 Log.info (fun m -> m "Pushing %s to %s" (Package.repo_name pkg) push_url); 1374 1424 (* Set the push URL for origin *) 1375 1375 - (match Git.set_push_url ~proc ~fs ~url:push_url checkout_dir with 1425 1425 + (match Git_cli.set_push_url ~proc ~fs ~url:push_url checkout_dir with 1376 1426 | Ok () -> () 1377 1377 - | Error e -> Log.warn (fun m -> m "Failed to set push URL: %a" Git.pp_error e)); 1378 1378 - Git.push_remote ~proc ~fs ~branch checkout_dir 1427 1427 + | Error e -> 1428 1428 + Log.warn (fun m -> m "Failed to set push URL: %a" Git_cli.pp_error e)); 1429 1429 + Git_cli.push_remote ~proc ~fs ~branch checkout_dir 1379 1430 1380 1431 (* Sanitize handle for use as git remote name *) 1381 1432 let sanitize_remote_name handle = ··· 1389 1440 let repo_name = Package.repo_name pkg in 1390 1441 1391 1442 (* Only process if checkout exists *) 1392 1392 - if not (Git.is_repo ~proc ~fs checkout_dir) then () 1443 1443 + if not (Git_cli.is_repo ~proc ~fs checkout_dir) then () 1393 1444 else begin 1394 1445 (* Get all verse members who have this repo *) 1395 1446 let members_with_repo = ··· 1397 1448 in 1398 1449 1399 1450 (* Get current remotes *) 1400 1400 - let current_remotes = Git.list_remotes ~proc ~fs checkout_dir in 1451 1451 + let current_remotes = Git_cli.list_remotes ~proc ~fs checkout_dir in 1401 1452 let verse_remotes = 1402 1453 List.filter 1403 1454 (fun r -> String.starts_with ~prefix:"verse-" r) ··· 1420 1471 if Sys.file_exists (Fpath.to_string verse_src) then begin 1421 1472 let url = Fpath.to_string verse_src in 1422 1473 match 1423 1423 - Git.ensure_remote ~proc ~fs ~name:remote_name ~url checkout_dir 1474 1474 + Git_cli.ensure_remote ~proc ~fs ~name:remote_name ~url checkout_dir 1424 1475 with 1425 1476 | Ok () -> 1426 1477 Log.debug (fun m -> 1427 1478 m "Ensured verse remote %s -> %s" remote_name url) 1428 1479 | Error e -> 1429 1480 Log.warn (fun m -> 1430 1430 - m "Failed to add verse remote %s: %a" remote_name Git.pp_error 1431 1431 - e) 1481 1481 + m "Failed to add verse remote %s: %a" remote_name 1482 1482 + Git_cli.pp_error e) 1432 1483 end) 1433 1484 members_with_repo; 1434 1485 ··· 1437 1488 (fun remote_name -> 1438 1489 if not (List.mem remote_name expected_remotes) then begin 1439 1490 Log.debug (fun m -> m "Removing outdated verse remote %s" remote_name); 1440 1440 - match Git.remove_remote ~proc ~fs ~name:remote_name checkout_dir with 1491 1491 + match 1492 1492 + Git_cli.remove_remote ~proc ~fs ~name:remote_name checkout_dir 1493 1493 + with 1441 1494 | Ok () -> () 1442 1495 | Error e -> 1443 1496 Log.warn (fun m -> 1444 1497 m "Failed to remove verse remote %s: %a" remote_name 1445 1445 - Git.pp_error e) 1498 1498 + Git_cli.pp_error e) 1446 1499 end) 1447 1500 verse_remotes 1448 1501 end ··· 1462 1515 let fetch_verse_remotes ~proc ~fs ~config pkg = 1463 1516 let checkouts_root = Config.Paths.checkouts config in 1464 1517 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 1465 1465 - let remotes = Git.list_remotes ~proc ~fs checkout_dir in 1518 1518 + let remotes = Git_cli.list_remotes ~proc ~fs checkout_dir in 1466 1519 let verse_remotes = 1467 1520 List.filter (fun r -> String.starts_with ~prefix:"verse-" r) remotes 1468 1521 in 1469 1522 List.iter 1470 1523 (fun remote -> 1471 1524 Log.debug (fun m -> m "Fetching from verse remote %s" remote); 1472 1472 - match Git.fetch ~proc ~fs ~remote checkout_dir with 1525 1525 + match Git_cli.fetch ~proc ~fs ~remote checkout_dir with 1473 1526 | Ok () -> () 1474 1527 | Error e -> 1475 1528 Log.debug (fun m -> 1476 1476 - m "Failed to fetch from %s: %a" remote Git.pp_error e)) 1529 1529 + m "Failed to fetch from %s: %a" remote Git_cli.pp_error e)) 1477 1530 verse_remotes 1478 1531 1479 1532 (* Helper to read file contents, returning None if file doesn't exist *) ··· 1518 1571 let clone_from_verse_if_needed ~proc ~fs ~config () = 1519 1572 let monorepo = Config.Paths.monorepo config in 1520 1573 let opam_repo = Config.Paths.opam_repo config in 1521 1521 - let monorepo_exists = Git.is_repo ~proc ~fs monorepo in 1522 1522 - let opam_repo_exists = Git.is_repo ~proc ~fs opam_repo in 1574 1574 + let monorepo_exists = Git_cli.is_repo ~proc ~fs monorepo in 1575 1575 + let opam_repo_exists = Git_cli.is_repo ~proc ~fs opam_repo in 1523 1576 1524 1577 (* If both exist, nothing to do *) 1525 1578 if monorepo_exists && opam_repo_exists then Ok () ··· 1557 1610 let branch = 1558 1611 Option.value ~default:"main" member.monorepo_branch 1559 1612 in 1560 1560 - match Git.clone ~proc ~fs ~url ~branch monorepo with 1613 1613 + match Git_cli.clone ~proc ~fs ~url ~branch monorepo with 1561 1614 | Ok () -> 1562 1615 Log.app (fun m -> m "Monorepo cloned successfully"); 1563 1616 Ok () 1564 1617 | Error e -> 1565 1618 Log.err (fun m -> 1566 1566 - m "Failed to clone monorepo: %a" Git.pp_error e); 1619 1619 + m "Failed to clone monorepo: %a" Git_cli.pp_error e); 1567 1620 Error (Git_error e) 1568 1621 end 1569 1622 in ··· 1579 1632 let branch = 1580 1633 Option.value ~default:"main" member.opamrepo_branch 1581 1634 in 1582 1582 - match Git.clone ~proc ~fs ~url ~branch opam_repo with 1635 1635 + match Git_cli.clone ~proc ~fs ~url ~branch opam_repo with 1583 1636 | Ok () -> 1584 1637 Log.app (fun m -> m "Opam-repo cloned successfully"); 1585 1638 Ok () 1586 1639 | Error e -> 1587 1640 Log.err (fun m -> 1588 1588 - m "Failed to clone opam-repo: %a" Git.pp_error e); 1641 1641 + m "Failed to clone opam-repo: %a" Git_cli.pp_error 1642 1642 + e); 1589 1643 Error (Git_error e) 1590 1644 end))) 1591 1645 ··· 1609 1663 | Ok () -> ( 1610 1664 (* Update the opam repo first - clone if needed *) 1611 1665 let opam_repo = Config.Paths.opam_repo config in 1612 1612 - if (not skip_pull) && Git.is_repo ~proc ~fs:fs_t opam_repo then begin 1666 1666 + if (not skip_pull) && Git_cli.is_repo ~proc ~fs:fs_t opam_repo then begin 1613 1667 Log.info (fun m -> m "Updating opam repo at %a" Fpath.pp opam_repo); 1614 1668 let result = 1615 1669 let ( let* ) = Result.bind in 1616 1616 - let* () = Git.fetch ~proc ~fs:fs_t opam_repo in 1617 1617 - Git.merge_ff ~proc ~fs:fs_t opam_repo 1670 1670 + let* () = Git_cli.fetch ~proc ~fs:fs_t opam_repo in 1671 1671 + Git_cli.merge_ff ~proc ~fs:fs_t opam_repo 1618 1672 in 1619 1673 match result with 1620 1674 | Ok () -> () 1621 1675 | Error e -> 1622 1676 Log.warn (fun m -> 1623 1623 - m "Failed to update opam repo: %a" Git.pp_error e) 1677 1677 + m "Failed to update opam repo: %a" Git_cli.pp_error e) 1624 1678 end; 1625 1679 (* Ensure directories exist *) 1626 1680 ensure_checkouts_dir ~fs:fs_t ~config; ··· 1629 1683 | Ok () -> 1630 1684 (* Check for uncommitted changes in monorepo *) 1631 1685 let monorepo = Config.Paths.monorepo config in 1632 1632 - if Git.is_dirty ~proc ~fs:fs_t monorepo then begin 1686 1686 + if Git_cli.is_dirty ~proc ~fs:fs_t monorepo then begin 1633 1687 Log.err (fun m -> m "Monorepo has uncommitted changes"); 1634 1688 Error Monorepo_dirty 1635 1689 end ··· 1852 1906 (* Check if monorepo has local modifications first *) 1853 1907 let monorepo = Config.Paths.monorepo config in 1854 1908 let monorepo_dirty = 1855 1855 - Git.is_dirty ~proc ~fs:fs_t monorepo 1909 1909 + Git_cli.is_dirty ~proc ~fs:fs_t monorepo 1856 1910 in 1857 1911 let subtree_errs = ref [] in 1858 1912 if monorepo_dirty then begin ··· 2218 2272 let fs = fs_typed fs in 2219 2273 let monorepo = Config.Paths.monorepo config in 2220 2274 let prefix = package in 2221 2221 - if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then Ok () 2275 2275 + if not (Git_cli.subtree_prefix_exists ~fs ~repo:monorepo ~prefix) then Ok () 2222 2276 else 2223 2277 let subtree_path = Eio.Path.(fs / Fpath.to_string monorepo / prefix) in 2224 2278 try 2225 2279 Eio.Path.rmtree subtree_path; 2226 2280 Ok () 2227 2281 with Eio.Io _ as e -> 2228 2228 - Error (Git_error (Git.Io_error (Printexc.to_string e))) 2282 2282 + Error (Git_error (Git_cli.Io_error (Printexc.to_string e))) 2229 2283 2230 2284 (* Changes command - generate weekly changelogs using Claude *) 2231 2285 ··· 2297 2351 let since = week_start ^ " 00:00:00" in 2298 2352 let until = week_end ^ " 23:59:59" in 2299 2353 match 2300 2300 - Git.log ~proc ~fs:fs_t ~since ~until ~path:repo_name 2301 2301 - monorepo 2354 2354 + Git_cli.log ~proc ~fs:fs_t ~since ~until 2355 2355 + ~path:repo_name monorepo 2302 2356 with 2303 2357 | Error e -> Error (Git_error e) 2304 2358 | Ok commits -> ··· 2340 2394 repo_name week_start); 2341 2395 (* Create new entry *) 2342 2396 let first_hash = 2343 2343 - (List.hd commits).Git.hash 2397 2397 + (List.hd commits).Git_cli.hash 2344 2398 in 2345 2399 let last_hash = 2346 2346 - (List.hd (List.rev commits)).Git.hash 2400 2400 + (List.hd (List.rev commits)).Git_cli.hash 2347 2401 in 2348 2402 let entry : Changes.weekly_entry = 2349 2403 { ··· 2506 2560 let since = date ^ " 00:00:00" in 2507 2561 let until = date ^ " 23:59:59" in 2508 2562 match 2509 2509 - Git.log ~proc ~fs:fs_t ~since ~until ~path:repo_name 2510 2510 - monorepo 2563 2563 + Git_cli.log ~proc ~fs:fs_t ~since ~until 2564 2564 + ~path:repo_name monorepo 2511 2565 with 2512 2566 | Error e -> Error (Git_error e) 2513 2567 | Ok commits -> ··· 2550 2604 (* Extract unique contributors from commits *) 2551 2605 let contributors = 2552 2606 commits 2553 2553 - |> List.map (fun (c : Git.log_entry) -> 2554 2554 - c.author) 2607 2607 + |> List.map 2608 2608 + (fun (c : Git_cli.log_entry) -> 2609 2609 + c.author) 2555 2610 |> List.sort_uniq String.compare 2556 2611 in 2557 2612 (* Get repo URL from package dev_repo *) ··· 2568 2623 in 2569 2624 (* Create new entry with hour and timestamp *) 2570 2625 let first_hash = 2571 2571 - (List.hd commits).Git.hash 2626 2626 + (List.hd commits).Git_cli.hash 2572 2627 in 2573 2628 let last_hash = 2574 2574 - (List.hd (List.rev commits)).Git.hash 2629 2629 + (List.hd (List.rev commits)).Git_cli.hash 2575 2630 in 2576 2631 let _, ((hour, _, _), _) = 2577 2632 Ptime.to_date_time now_ptime ··· 2668 2723 if (not dry_run) && aggregate then begin 2669 2724 let today = Changes.date_of_ptime now_ptime in 2670 2725 let git_head = 2671 2671 - match Git.rev_parse ~proc ~fs:fs_t ~rev:"HEAD" monorepo with 2726 2726 + match Git_cli.rev_parse ~proc ~fs:fs_t ~rev:"HEAD" monorepo with 2672 2727 | Ok hash -> String.sub hash 0 (min 7 (String.length hash)) 2673 2728 | Error _ -> "unknown" 2674 2729 in ··· 2693 2748 repo_name : string; 2694 2749 handle : string; 2695 2750 relationship : Forks.relationship; 2696 2696 - commits : Git.log_entry list; 2751 2751 + commits : Git_cli.log_entry list; 2697 2752 patches : (string * string) list; (* hash -> patch content *) 2698 2753 } 2699 2754 ··· 2707 2762 n_commits 2708 2763 (if n_commits = 1 then "" else "s"); 2709 2764 List.iter 2710 2710 - (fun (c : Git.log_entry) -> 2765 2765 + (fun (c : Git_cli.log_entry) -> 2711 2766 let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 2712 2767 Fmt.pf ppf " %a %s %a@," 2713 2768 Fmt.(styled `Yellow string) ··· 2776 2831 List.filter_map 2777 2832 (fun (handle, _src, rel) -> 2778 2833 let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2779 2779 - if not (Git.is_repo ~proc ~fs checkout_path) then None 2834 2834 + if not (Git_cli.is_repo ~proc ~fs checkout_path) then None 2780 2835 else begin 2781 2836 let remote_name = "verse/" ^ handle in 2782 2837 let my_ref = "origin/main" in 2783 2838 let their_ref = remote_name ^ "/main" in 2784 2839 (* Get commits they have that I don't *) 2785 2840 match 2786 2786 - Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2841 2841 + Git_cli.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2787 2842 ~max_count:20 checkout_path 2788 2843 with 2789 2844 | Error _ -> None ··· 2793 2848 let patches = 2794 2849 if patch then 2795 2850 List.filter_map 2796 2796 - (fun (c : Git.log_entry) -> 2851 2851 + (fun (c : Git_cli.log_entry) -> 2797 2852 match 2798 2798 - Git.show_patch ~proc ~fs ~commit:c.hash 2853 2853 + Git_cli.show_patch ~proc ~fs ~commit:c.hash 2799 2854 checkout_path 2800 2855 with 2801 2856 | Ok p -> Some (c.hash, p) ··· 2845 2900 List.find_map 2846 2901 (fun (r : Forks.repo_analysis) -> 2847 2902 let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2848 2848 - if not (Git.is_repo ~proc ~fs checkout_path) then None 2903 2903 + if not (Git_cli.is_repo ~proc ~fs checkout_path) then None 2849 2904 else 2850 2905 (* Check each verse source *) 2851 2906 List.find_map ··· 2857 2912 let their_ref = remote_name ^ "/main" in 2858 2913 (* Get commits they have that I don't *) 2859 2914 match 2860 2860 - Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2915 2915 + Git_cli.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2861 2916 ~max_count:50 checkout_path 2862 2917 with 2863 2918 | Error _ -> None ··· 2865 2920 (* Check if our sha matches any commit *) 2866 2921 let matching = 2867 2922 List.find_opt 2868 2868 - (fun (c : Git.log_entry) -> 2923 2923 + (fun (c : Git_cli.log_entry) -> 2869 2924 String.starts_with ~prefix:sha c.hash 2870 2925 || String.starts_with 2871 2926 ~prefix:(String.lowercase_ascii sha) ··· 2876 2931 | None -> None 2877 2932 | Some c -> ( 2878 2933 match 2879 2879 - Git.show_patch ~proc ~fs ~commit:c.hash 2934 2934 + Git_cli.show_patch ~proc ~fs ~commit:c.hash 2880 2935 checkout_path 2881 2936 with 2882 2937 | Ok patch -> ··· 2958 3013 () 2959 3014 | Some (_, _, rel) -> 2960 3015 let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2961 2961 - if not (Git.is_repo ~proc ~fs checkout_path) then 3016 3016 + if not (Git_cli.is_repo ~proc ~fs checkout_path) then 2962 3017 repos_skipped := r.repo_name :: !repos_skipped 2963 3018 else begin 2964 3019 match rel with ··· 2970 3025 (* Merge their changes *) 2971 3026 let remote_ref = "verse/" ^ handle ^ "/main" in 2972 3027 match 2973 2973 - Git.merge ~proc ~fs ~ref_name:remote_ref ~ff_only:true 3028 3028 + Git_cli.merge ~proc ~fs ~ref_name:remote_ref ~ff_only:true 2974 3029 checkout_path 2975 3030 with 2976 3031 | Ok () -> repos_pulled := (r.repo_name, count) :: !repos_pulled 2977 3032 | Error e -> 2978 3033 repos_failed := 2979 2979 - (r.repo_name, Fmt.str "%a" Git.pp_error e) 3034 3034 + (r.repo_name, Fmt.str "%a" Git_cli.pp_error e) 2980 3035 :: !repos_failed) 2981 3036 | Forks.Diverged { their_ahead; _ } -> ( 2982 3037 (* Merge their changes (may create a merge commit) *) 2983 3038 let remote_ref = "verse/" ^ handle ^ "/main" in 2984 3039 match 2985 2985 - Git.merge ~proc ~fs ~ref_name:remote_ref checkout_path 3040 3040 + Git_cli.merge ~proc ~fs ~ref_name:remote_ref checkout_path 2986 3041 with 2987 3042 | Ok () -> 2988 3043 repos_pulled := (r.repo_name, their_ahead) :: !repos_pulled 2989 3044 | Error e -> 2990 3045 repos_failed := 2991 2991 - (r.repo_name, Fmt.str "%a" Git.pp_error e) 3046 3046 + (r.repo_name, Fmt.str "%a" Git_cli.pp_error e) 2992 3047 :: !repos_failed) 2993 3048 end) 2994 3049 repos_to_check; ··· 3027 3082 (Printf.sprintf "Commit %s not found in any verse diff" sha)) 3028 3083 | Some info -> 3029 3084 let checkout_path = Fpath.(checkouts_path / info.commit_repo) in 3030 3030 - if not (Git.is_repo ~proc ~fs checkout_path) then 3085 3085 + if not (Git_cli.is_repo ~proc ~fs checkout_path) then 3031 3086 Error 3032 3087 (Config_error 3033 3088 (Printf.sprintf "No checkout for repository %s" info.commit_repo)) 3034 3089 else begin 3035 3090 match 3036 3036 - Git.cherry_pick ~proc ~fs ~commit:info.commit_hash checkout_path 3091 3091 + Git_cli.cherry_pick ~proc ~fs ~commit:info.commit_hash checkout_path 3037 3092 with 3038 3093 | Ok () -> 3039 3094 Ok

+5 -5

lib/monopam.mli

reviewed

··· 17 17 - {!Config} - Configuration management 18 18 - {!Package} - Package metadata 19 19 - {!Opam_repo} - Opam repository scanning 20 20 - - {!Git} - Git operations 20 20 + - {!Git_cli} - Git operations (CLI-based) 21 21 - {!Status} - Status computation *) 22 22 23 23 (** Re-export modules for convenience. *) ··· 25 25 module Config = Config 26 26 module Package = Package 27 27 module Opam_repo = Opam_repo 28 28 - module Git = Git 28 28 + module Git_cli = Git_cli 29 29 module Status = Status 30 30 module Changes = Changes 31 31 module Verse = Verse ··· 47 47 type error = 48 48 | Config_error of string (** Configuration error *) 49 49 | Repo_error of Opam_repo.error (** Opam repository error *) 50 50 - | Git_error of Git.error (** Git operation error *) 50 50 + | Git_error of Git_cli.error (** Git operation error *) 51 51 | Dirty_state of Package.t list 52 52 (** Operation blocked due to dirty packages *) 53 53 | Monorepo_dirty (** Monorepo has uncommitted changes *) ··· 143 143 type sync_failure = { 144 144 repo_name : string; 145 145 phase : sync_phase; 146 146 - error : Git.error; 146 146 + error : Git_cli.error; 147 147 } 148 148 (** A failure during sync for a specific repository. *) 149 149 ··· 414 414 repo_name : string; 415 415 handle : string; 416 416 relationship : Forks.relationship; 417 417 - commits : Git.log_entry list; 417 417 + commits : Git_cli.log_entry list; 418 418 patches : (string * string) list; (** hash -> patch content *) 419 419 } 420 420 (** A diff entry for a single repository showing commits from a verse member. *)

+18 -16

lib/status.ml

reviewed

··· 2 2 | Missing 3 3 | Not_a_repo 4 4 | Dirty 5 5 - | Clean of Git.ahead_behind 5 5 + | Clean of Git_cli.ahead_behind 6 6 7 7 type subtree_status = Not_added | Present 8 8 ··· 41 41 match Eio.Path.kind ~follow:true fs_dir with 42 42 | exception Eio.Io _ -> Missing 43 43 | `Directory -> ( 44 44 - if not (Git.is_repo ~proc ~fs:fs_t checkout_dir) then Not_a_repo 45 45 - else if Git.is_dirty ~proc ~fs:fs_t checkout_dir then Dirty 44 44 + if not (Git_cli.is_repo ~proc ~fs:fs_t checkout_dir) then Not_a_repo 45 45 + else if Git_cli.is_dirty ~proc ~fs:fs_t checkout_dir then Dirty 46 46 else 47 47 - match Git.ahead_behind ~proc ~fs:fs_t checkout_dir with 47 47 + match Git_cli.ahead_behind ~proc ~fs:fs_t checkout_dir with 48 48 | Ok ab -> Clean ab 49 49 | Error _ -> Clean { ahead = 0; behind = 0 }) 50 50 | _ -> Missing 51 51 in 52 52 let subtree = 53 53 - if Git.Subtree.exists ~fs:fs_t ~repo:monorepo ~prefix then Present 53 53 + if Git_cli.Subtree.exists ~fs:fs_t ~repo:monorepo ~prefix then Present 54 54 else Not_added 55 55 in 56 56 (* Compute subtree sync state: compare tree content between monorepo subtree and checkout. ··· 63 63 | Clean _, Present -> ( 64 64 (* Get tree hash of subtree directory in monorepo *) 65 65 let subtree_tree = 66 66 - Git.rev_parse ~proc ~fs:fs_t ~rev:("HEAD:" ^ prefix) monorepo 66 66 + Git_cli.rev_parse ~proc ~fs:fs_t ~rev:("HEAD:" ^ prefix) monorepo 67 67 in 68 68 (* Get tree hash of checkout root *) 69 69 let checkout_tree = 70 70 - Git.rev_parse ~proc ~fs:fs_t ~rev:"HEAD^{tree}" checkout_dir 70 70 + Git_cli.rev_parse ~proc ~fs:fs_t ~rev:"HEAD^{tree}" checkout_dir 71 71 in 72 72 match (subtree_tree, checkout_tree) with 73 73 | Ok st, Ok ct when st = ct -> In_sync 74 74 | Ok _, Ok _ -> ( 75 75 (* Trees differ - check commit ancestry to determine direction *) 76 76 let subtree_commit = 77 77 - Git.subtree_last_upstream_commit ~proc ~fs:fs_t ~repo:monorepo 77 77 + Git_cli.subtree_last_upstream_commit ~proc ~fs:fs_t ~repo:monorepo 78 78 ~prefix () 79 79 in 80 80 - let checkout_head = Git.head_commit ~proc ~fs:fs_t checkout_dir in 80 80 + let checkout_head = 81 81 + Git_cli.head_commit ~proc ~fs:fs_t checkout_dir 82 82 + in 81 83 match (subtree_commit, checkout_head) with 82 84 | Some subtree_sha, Ok checkout_sha -> 83 85 if 84 84 - Git.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir 86 86 + Git_cli.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir 85 87 ~commit1:subtree_sha ~commit2:checkout_sha () 86 88 then 87 89 (* Checkout has commits not in subtree - need subtree pull *) 88 90 let count = 89 89 - Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir 90 90 - ~base:subtree_sha ~head:checkout_sha () 91 91 + Git_cli.count_commits_between ~proc ~fs:fs_t 92 92 + ~repo:checkout_dir ~base:subtree_sha ~head:checkout_sha () 91 93 in 92 94 if count > 0 then Subtree_behind count else Trees_differ 93 95 (* Same commit but trees differ - monorepo has changes *) 94 96 else if 95 95 - Git.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir 97 97 + Git_cli.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir 96 98 ~commit1:checkout_sha ~commit2:subtree_sha () 97 99 then 98 100 (* Subtree has content not in checkout - need push *) 99 101 let count = 100 100 - Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir 101 101 - ~base:checkout_sha ~head:subtree_sha () 102 102 + Git_cli.count_commits_between ~proc ~fs:fs_t 103 103 + ~repo:checkout_dir ~base:checkout_sha ~head:subtree_sha () 102 104 in 103 105 if count > 0 then Subtree_ahead count else Trees_differ 104 106 else Trees_differ (* Diverged *) ··· 218 220 let entry = Option.bind sources (fun s -> Sources_registry.find s ~subtree) in 219 221 (* Helper to print remote sync info *) 220 222 let pp_remote ab = 221 221 - if ab.Git.ahead > 0 && ab.behind > 0 then 223 223 + if ab.Git_cli.ahead > 0 && ab.behind > 0 then 222 224 Fmt.pf ppf " %a" 223 225 Fmt.(styled `Yellow (fun ppf (a, b) -> pf ppf "remote:+%d/-%d" a b)) 224 226 (ab.ahead, ab.behind)

+1 -1

lib/status.mli

reviewed

··· 10 10 | Missing (** Checkout directory does not exist *) 11 11 | Not_a_repo (** Directory exists but is not a git repository *) 12 12 | Dirty (** Has uncommitted changes *) 13 13 - | Clean of Git.ahead_behind 13 13 + | Clean of Git_cli.ahead_behind 14 14 (** Clean with ahead/behind info relative to remote *) 15 15 16 16 (** Status of a subtree in the monorepo. *)

+25 -23

lib/verse.ml

reviewed

··· 1 1 type error = 2 2 | Config_error of string 3 3 - | Git_error of Git.error 3 3 + | Git_error of Git_cli.error 4 4 | Registry_error of string 5 5 | Member_not_found of string 6 6 | Workspace_exists of Fpath.t ··· 12 12 13 13 let pp_error ppf = function 14 14 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg 15 15 - | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 15 15 + | Git_error e -> Fmt.pf ppf "Git error: %a" Git_cli.pp_error e 16 16 | Registry_error msg -> Fmt.pf ppf "Registry error: %s" msg 17 17 | Member_not_found h -> Fmt.pf ppf "Member not in registry: %s" h 18 18 | Workspace_exists p -> Fmt.pf ppf "Workspace already exists: %a" Fpath.pp p ··· 28 28 let error_hint = function 29 29 | Config_error _ -> 30 30 Some "Run 'monopam init --handle <your-handle>' to create a workspace." 31 31 - | Git_error (Git.Dirty_worktree _) -> 31 31 + | Git_error (Git_cli.Dirty_worktree _) -> 32 32 Some "Commit or stash your changes first: git status" 33 33 - | Git_error (Git.Command_failed (cmd, _)) 33 33 + | Git_error (Git_cli.Command_failed (cmd, _)) 34 34 when String.starts_with ~prefix:"git clone" cmd -> 35 35 Some "Check the URL is correct and you have network access." 36 36 - | Git_error (Git.Command_failed (cmd, _)) 36 36 + | Git_error (Git_cli.Command_failed (cmd, _)) 37 37 when String.starts_with ~prefix:"git pull" cmd -> 38 38 Some "Check your network connection. Try: git fetch origin" 39 39 | Git_error _ -> None ··· 73 73 local_path : Fpath.t; 74 74 cloned : bool; 75 75 clean : bool option; 76 76 - ahead_behind : Git.ahead_behind option; 76 76 + ahead_behind : Git_cli.ahead_behind option; 77 77 } 78 78 79 79 type status = { ··· 188 188 Logs.info (fun m -> m "Cloning monorepo to %a" Fpath.pp mono_path); 189 189 let mono_url = Uri.of_string member.monorepo in 190 190 match 191 191 - Git.clone ~proc ~fs ~url:mono_url 191 191 + Git_cli.clone ~proc ~fs ~url:mono_url 192 192 ~branch:Verse_config.default_branch mono_path 193 193 with 194 194 | Error e -> 195 195 - Logs.err (fun m -> m "Monorepo clone failed: %a" Git.pp_error e); 195 195 + Logs.err (fun m -> 196 196 + m "Monorepo clone failed: %a" Git_cli.pp_error e); 196 197 Error (Git_error e) 197 198 | Ok () -> ( 198 199 Logs.info (fun m -> m "Monorepo cloned"); ··· 202 203 m "Cloning opam repo to %a" Fpath.pp opam_path); 203 204 let opam_url = Uri.of_string member.opamrepo in 204 205 match 205 205 - Git.clone ~proc ~fs ~url:opam_url 206 206 + Git_cli.clone ~proc ~fs ~url:opam_url 206 207 ~branch:Verse_config.default_branch opam_path 207 208 with 208 209 | Error e -> 209 210 Logs.err (fun m -> 210 210 - m "Opam repo clone failed: %a" Git.pp_error e); 211 211 + m "Opam repo clone failed: %a" Git_cli.pp_error e); 211 212 Error (Git_error e) 212 213 | Ok () -> ( 213 214 Logs.info (fun m -> m "Opam repo cloned"); ··· 255 256 let local_path = 256 257 Fpath.(Verse_config.verse_path config / handle) 257 258 in 258 258 - let cloned = Git.is_repo ~proc ~fs local_path in 259 259 + let cloned = Git_cli.is_repo ~proc ~fs local_path in 259 260 let clean = 260 260 - if cloned then Some (not (Git.is_dirty ~proc ~fs local_path)) 261 261 + if cloned then 262 262 + Some (not (Git_cli.is_dirty ~proc ~fs local_path)) 261 263 else None 262 264 in 263 265 let ahead_behind = 264 266 if cloned then 265 265 - match Git.ahead_behind ~proc ~fs local_path with 267 267 + match Git_cli.ahead_behind ~proc ~fs local_path with 266 268 | Ok ab -> Some ab 267 269 | Error _ -> None 268 270 else None ··· 289 291 if reset. Uses fetch+reset instead of pull since verse repos should not have 290 292 local changes. *) 291 293 let clone_or_reset_repo ~proc ~fs ~url ~branch path = 292 292 - if Git.is_repo ~proc ~fs path then begin 293 293 - match Git.fetch_and_reset ~proc ~fs ~branch path with 294 294 + if Git_cli.is_repo ~proc ~fs path then begin 295 295 + match Git_cli.fetch_and_reset ~proc ~fs ~branch path with 294 296 | Error e -> Error e 295 297 | Ok () -> Ok false 296 298 end 297 299 else begin 298 300 let url = Uri.of_string url in 299 299 - match Git.clone ~proc ~fs ~url ~branch path with 301 301 + match Git_cli.clone ~proc ~fs ~url ~branch path with 300 302 | Error e -> Error e 301 303 | Ok () -> Ok true 302 304 end ··· 346 348 None 347 349 | Error e -> 348 350 Logs.warn (fun m -> 349 349 - m " Failed %s monorepo: %a" h Git.pp_error e); 350 350 - Some (Fmt.str "%s monorepo: %a" h Git.pp_error e) 351 351 + m " Failed %s monorepo: %a" h Git_cli.pp_error e); 352 352 + Some (Fmt.str "%s monorepo: %a" h Git_cli.pp_error e) 351 353 in 352 354 (* Clone or fetch+reset opam repo *) 353 355 Logs.info (fun m -> m "Syncing %s opam repo" h); ··· 369 371 None 370 372 | Error e -> 371 373 Logs.warn (fun m -> 372 372 - m " Failed %s opam repo: %a" h Git.pp_error e); 373 373 - Some (Fmt.str "%s opam: %a" h Git.pp_error e) 374 374 + m " Failed %s opam repo: %a" h Git_cli.pp_error e); 375 375 + Some (Fmt.str "%s opam: %a" h Git_cli.pp_error e) 374 376 in 375 377 match (mono_err, opam_err) with 376 378 | None, None -> None ··· 379 381 members 380 382 in 381 383 if errors = [] then Ok () 382 382 - else Error (Git_error (Git.Io_error (String.concat "; " errors))) 384 384 + else Error (Git_error (Git_cli.Io_error (String.concat "; " errors))) 383 385 end 384 386 385 387 let sync ~proc ~fs ~config () = ··· 389 391 (** Scan a monorepo for subtree directories. Returns a list of directory names 390 392 that look like subtrees (have commits). *) 391 393 let scan_subtrees ~proc ~fs monorepo_path = 392 392 - if not (Git.is_repo ~proc ~fs monorepo_path) then [] 394 394 + if not (Git_cli.is_repo ~proc ~fs monorepo_path) then [] 393 395 else 394 396 let eio_path = Eio.Path.(fs / Fpath.to_string monorepo_path) in 395 397 try ··· 411 413 List.iter 412 414 (fun handle -> 413 415 let member_mono = Fpath.(verse_path / handle) in 414 414 - if Git.is_repo ~proc ~fs member_mono then begin 416 416 + if Git_cli.is_repo ~proc ~fs member_mono then begin 415 417 let subtrees = scan_subtrees ~proc ~fs member_mono in 416 418 List.iter 417 419 (fun subtree ->

+2 -2

lib/verse.mli

reviewed

··· 7 7 8 8 type error = 9 9 | Config_error of string (** Configuration loading/saving error *) 10 10 - | Git_error of Git.error (** Git operation failed *) 10 10 + | Git_error of Git_cli.error (** Git operation failed *) 11 11 | Registry_error of string (** Registry clone/pull/parse error *) 12 12 | Member_not_found of string (** Handle not in registry *) 13 13 | Workspace_exists of Fpath.t (** Workspace already initialized *) ··· 36 36 local_path : Fpath.t; (** Local path under verse/ *) 37 37 cloned : bool; (** Whether the monorepo is cloned locally *) 38 38 clean : bool option; (** Whether the clone is clean (None if not cloned) *) 39 39 - ahead_behind : Git.ahead_behind option; 39 39 + ahead_behind : Git_cli.ahead_behind option; 40 40 (** Ahead/behind status (None if not cloned) *) 41 41 } 42 42 (** Status of a member's monorepo in the workspace. *)

+6 -6

lib/verse_registry.ml

reviewed

··· 125 125 let exists = 126 126 let path = Eio.Path.(fs / Fpath.to_string registry_path) in 127 127 match Eio.Path.kind ~follow:true path with 128 128 - | `Directory -> Git.is_repo ~proc ~fs registry_path 128 128 + | `Directory -> Git_cli.is_repo ~proc ~fs registry_path 129 129 | _ -> false 130 130 | exception _ -> false 131 131 in 132 132 if exists then begin 133 133 Logs.info (fun m -> m "Registry exists, pulling updates..."); 134 134 (* Pull updates, but don't fail if pull fails *) 135 135 - (match Git.pull ~proc ~fs registry_path with 135 135 + (match Git_cli.pull ~proc ~fs registry_path with 136 136 | Ok () -> Logs.info (fun m -> m "Registry pull succeeded") 137 137 | Error e -> 138 138 Logs.warn (fun m -> 139 139 - m "Registry pull failed: %a (using cached)" Git.pp_error e)); 139 139 + m "Registry pull failed: %a (using cached)" Git_cli.pp_error e)); 140 140 Logs.info (fun m -> m "Loading registry from %a" Fpath.pp registry_toml); 141 141 load ~fs registry_toml 142 142 end ··· 149 149 (* Try to clone the registry *) 150 150 let url = Uri.of_string default_url in 151 151 let branch = "main" in 152 152 - match Git.clone ~proc ~fs ~url ~branch registry_path with 152 152 + match Git_cli.clone ~proc ~fs ~url ~branch registry_path with 153 153 | Ok () -> 154 154 Logs.info (fun m -> m "Registry cloned successfully"); 155 155 load ~fs registry_toml 156 156 | Error e -> 157 157 - Logs.warn (fun m -> m "Registry clone failed: %a" Git.pp_error e); 157 157 + Logs.warn (fun m -> m "Registry clone failed: %a" Git_cli.pp_error e); 158 158 Logs.info (fun m -> m "Creating empty local registry..."); 159 159 (* Clone failed - create local registry directory with empty registry *) 160 160 let registry_eio = Eio.Path.(fs / Fpath.to_string registry_path) in 161 161 (try Eio.Path.mkdirs ~perm:0o755 registry_eio with Eio.Io _ -> ()); 162 162 (* Initialize as git repo *) 163 163 - (match Git.init ~proc ~fs registry_path with 163 163 + (match Git_cli.init ~proc ~fs registry_path with 164 164 | Ok () -> () 165 165 | Error _ -> ()); 166 166 (* Create empty registry file *)