Port show_patch, cherry_pick, merge from Git_cli to ocaml-git

-15

lib/git_cli.ml

··· 214 214 let push_ref ~proc ~fs ~repo ~target ~ref_spec () = 215 215 let cwd = path_to_eio ~fs repo in 216 216 run_git_ok ~proc ~cwd [ "push"; target; ref_spec ] |> Result.map ignore 217 - 218 - let show_patch ~proc ~fs ~commit repo_path = 219 - let cwd = path_to_eio ~fs repo_path in 220 - run_git_ok ~proc ~cwd [ "show"; "--patch"; "--stat"; commit ] 221 - 222 - let cherry_pick ~proc ~fs ~commit path = 223 - let cwd = path_to_eio ~fs path in 224 - run_git_ok ~proc ~cwd [ "cherry-pick"; commit ] |> Result.map ignore 225 - 226 - let merge ~proc ~fs ~ref_name ?(ff_only = false) path = 227 - let cwd = path_to_eio ~fs path in 228 - let args = 229 - [ "merge" ] @ (if ff_only then [ "--ff-only" ] else []) @ [ ref_name ] 230 - in 231 - run_git_ok ~proc ~cwd args |> Result.map ignore

-40

lib/git_cli.mli

··· 167 167 @param repo Path to the git repository to push from 168 168 @param target Target repository path or remote name 169 169 @param ref_spec The refspec to push (e.g., "abc123:refs/heads/main") *) 170 - 171 - (** {1 Commit History} *) 172 - 173 - val show_patch : 174 - proc:_ Eio.Process.mgr -> 175 - fs:Eio.Fs.dir_ty Eio.Path.t -> 176 - commit:string -> 177 - Fpath.t -> 178 - (string, error) result 179 - (** [show_patch ~proc ~fs ~commit repo] returns the patch content for a commit. 180 - 181 - Runs [git show --patch --stat commit] to get the full diff with stats. *) 182 - 183 - (** {1 Cherry-pick Operations} *) 184 - 185 - val cherry_pick : 186 - proc:_ Eio.Process.mgr -> 187 - fs:Eio.Fs.dir_ty Eio.Path.t -> 188 - commit:string -> 189 - Fpath.t -> 190 - (unit, error) result 191 - (** [cherry_pick ~proc ~fs ~commit path] applies a single commit to the current 192 - branch. 193 - 194 - @param commit The commit hash to cherry-pick 195 - @param path Path to the repository *) 196 - 197 - val merge : 198 - proc:_ Eio.Process.mgr -> 199 - fs:Eio.Fs.dir_ty Eio.Path.t -> 200 - ref_name:string -> 201 - ?ff_only:bool -> 202 - Fpath.t -> 203 - (unit, error) result 204 - (** [merge ~proc ~fs ~ref_name ?ff_only path] merges a ref into the current 205 - branch. 206 - 207 - @param ref_name The ref to merge (e.g., "verse/handle/main") 208 - @param ff_only If true, only allow fast-forward merges (default: false) 209 - @param path Path to the repository *)

+64 -37

lib/monopam.ml

··· 1096 1096 let repos = unique_repos pkgs in 1097 1097 Log.info (fun m -> m "Pushing %d unique repos" (List.length repos)); 1098 1098 let total = List.length repos in 1099 - let rec loop i pushed_repos = function 1099 + let progress = Tty.Progress.create ~total "Push" in 1100 + let rec loop pushed_repos = function 1100 1101 | [] -> Ok (List.rev pushed_repos) 1101 1102 | pkg :: rest -> ( 1102 - Log.info (fun m -> 1103 - m "[%d/%d] Processing %s" i total 1104 - (Package.subtree_prefix pkg)); 1103 + let name = Package.subtree_prefix pkg in 1104 + Tty.Progress.message progress 1105 + (Fmt.str "Push: %s (%d/%d)" name 1106 + (List.length pushed_repos + 1) 1107 + total); 1108 + Log.info (fun m -> m "Subtree push %s" name); 1105 1109 match push_one ~proc ~fs ~config ~clean pkg with 1106 - | Ok () -> loop (i + 1) (pkg :: pushed_repos) rest 1107 - | Error e -> Error e) 1110 + | Ok () -> 1111 + Tty.Progress.tick progress; 1112 + loop (pkg :: pushed_repos) rest 1113 + | Error e -> 1114 + Tty.Progress.clear progress; 1115 + Error e) 1108 1116 in 1109 - match loop 1 [] repos with 1117 + match loop [] repos with 1110 1118 | Error e -> Error e 1111 1119 | Ok pushed_repos -> 1120 + Tty.Progress.clear progress; 1121 + List.iter 1122 + (fun pkg -> 1123 + Log.app (fun m -> m " ✓ %s" (Package.subtree_prefix pkg))) 1124 + pushed_repos; 1112 1125 if upstream && pushed_repos <> [] then begin 1113 1126 Log.info (fun m -> 1114 1127 m "Pushing %d repos to upstream (parallel)" 1115 1128 (List.length pushed_repos)); 1116 1129 let checkouts_root = Config.Paths.checkouts config in 1130 + let remote_total = List.length pushed_repos in 1131 + let remote_progress = 1132 + Tty.Progress.create ~total:remote_total "Push remote" 1133 + in 1134 + let completed = Atomic.make 0 in 1117 1135 (* Push to remotes in parallel, limited to 2 concurrent pushes *) 1118 1136 let push_results = 1119 1137 Eio.Fiber.List.map ~max_fibers:2 ··· 1123 1141 in 1124 1142 let branch = branch ~config pkg in 1125 1143 let push_url = url_to_push_url (Package.dev_repo pkg) in 1144 + let n = Atomic.fetch_and_add completed 1 + 1 in 1145 + Tty.Progress.message remote_progress 1146 + (Fmt.str "Push: %s (%d/%d)" (Package.repo_name pkg) n 1147 + remote_total); 1126 1148 Log.info (fun m -> 1127 1149 m "Pushing %s to %s" (Package.repo_name pkg) push_url); 1128 1150 (* Set the push URL for origin *) ··· 1136 1158 | Ok () -> () 1137 1159 | Error (`Msg msg) -> 1138 1160 Log.warn (fun m -> m "Failed to set push URL: %s" msg)); 1139 - match 1161 + let result = 1140 1162 Git_cli.push_remote ~proc ~fs:fs_t ~branch ~force 1141 1163 checkout_dir 1142 - with 1143 - | Ok () -> 1144 - Log.app (fun m -> 1145 - m " Pushed %s to %s (%s)%s" 1146 - (Package.repo_name pkg) push_url branch 1147 - (if force then " [force]" else "")); 1148 - Ok () 1149 - | Error e -> Error (Git_error e)) 1164 + in 1165 + Tty.Progress.tick remote_progress; 1166 + match result with 1167 + | Ok () -> Ok (Package.repo_name pkg) 1168 + | Error e -> Error (Package.repo_name pkg, Git_error e)) 1150 1169 pushed_repos 1151 1170 in 1171 + Tty.Progress.clear remote_progress; 1172 + let successes, failures = 1173 + List.partition_map 1174 + (function 1175 + | Ok name -> Left name | Error (name, _) -> Right name) 1176 + push_results 1177 + in 1178 + List.iter 1179 + (fun name -> Log.app (fun m -> m " ✓ %s" name)) 1180 + successes; 1181 + List.iter 1182 + (fun name -> Log.app (fun m -> m " ✗ %s" name)) 1183 + failures; 1152 1184 (* Return first error if any *) 1153 1185 match List.find_opt Result.is_error push_results with 1154 - | Some (Error e) -> Error e 1186 + | Some (Error (_, e)) -> Error e 1155 1187 | _ -> Ok () 1156 1188 end 1157 1189 else Ok () ··· 2895 2927 List.filter_map 2896 2928 (fun (c : Git.Repository.log_entry) -> 2897 2929 match 2898 - Git_cli.show_patch ~proc ~fs ~commit:c.hash 2899 - checkout_path 2930 + Git.Repository.show_patch repo ~commit:c.hash 2900 2931 with 2901 2932 | Ok p -> Some (c.hash, p) 2902 2933 | Error _ -> None) ··· 2977 3008 | None -> None 2978 3009 | Some c -> ( 2979 3010 match 2980 - Git_cli.show_patch ~proc ~fs ~commit:c.hash 2981 - checkout_path 3011 + Git.Repository.show_patch repo ~commit:c.hash 2982 3012 with 2983 3013 | Ok patch -> 2984 3014 Some ··· 3062 3092 if not (Git.Repository.is_repo ~fs checkout_path) then 3063 3093 repos_skipped := r.repo_name :: !repos_skipped 3064 3094 else begin 3095 + let git_repo = Git.Repository.open_repo ~fs checkout_path in 3065 3096 match rel with 3066 3097 | Forks.Same_url | Forks.Same_commit | Forks.I_am_ahead _ -> 3067 3098 repos_skipped := r.repo_name :: !repos_skipped ··· 3071 3102 (* Merge their changes *) 3072 3103 let remote_ref = "verse/" ^ handle ^ "/main" in 3073 3104 match 3074 - Git_cli.merge ~proc ~fs ~ref_name:remote_ref ~ff_only:true 3075 - checkout_path 3105 + Git.Repository.merge git_repo ~ref_name:remote_ref 3106 + ~ff_only:true 3076 3107 with 3077 3108 | Ok () -> repos_pulled := (r.repo_name, count) :: !repos_pulled 3078 - | Error e -> 3079 - repos_failed := 3080 - (r.repo_name, Fmt.str "%a" Git_cli.pp_error e) 3081 - :: !repos_failed) 3109 + | Error (`Msg msg) -> 3110 + repos_failed := (r.repo_name, msg) :: !repos_failed) 3082 3111 | Forks.Diverged { their_ahead; _ } -> ( 3083 3112 (* Merge their changes (may create a merge commit) *) 3084 3113 let remote_ref = "verse/" ^ handle ^ "/main" in 3085 3114 match 3086 - Git_cli.merge ~proc ~fs ~ref_name:remote_ref checkout_path 3115 + Git.Repository.merge git_repo ~ref_name:remote_ref 3116 + ~ff_only:false 3087 3117 with 3088 3118 | Ok () -> 3089 3119 repos_pulled := (r.repo_name, their_ahead) :: !repos_pulled 3090 - | Error e -> 3091 - repos_failed := 3092 - (r.repo_name, Fmt.str "%a" Git_cli.pp_error e) 3093 - :: !repos_failed) 3120 + | Error (`Msg msg) -> 3121 + repos_failed := (r.repo_name, msg) :: !repos_failed) 3094 3122 end) 3095 3123 repos_to_check; 3096 3124 ··· 3133 3161 (Config_error 3134 3162 (Printf.sprintf "No checkout for repository %s" info.commit_repo)) 3135 3163 else begin 3136 - match 3137 - Git_cli.cherry_pick ~proc ~fs ~commit:info.commit_hash checkout_path 3138 - with 3139 - | Ok () -> 3164 + let git_repo = Git.Repository.open_repo ~fs checkout_path in 3165 + match Git.Repository.cherry_pick git_repo ~commit:info.commit_hash with 3166 + | Ok _new_hash -> 3140 3167 Ok 3141 3168 { 3142 3169 repo_name = info.commit_repo; 3143 3170 commit_hash = info.commit_hash; 3144 3171 commit_subject = info.commit_subject; 3145 3172 } 3146 - | Error e -> Error (Git_error e) 3173 + | Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg)) 3147 3174 end

Configure Feed

Configure Feed