A monorepo management tool for the agentic ages
1(** Git operations wrapped with Eio and robust error handling. *)
2
3let src = Logs.Src.create "unpac.git" ~doc:"Git operations"
4module Log = (val Logs.src_log src : Logs.LOG)
5
6(* Error types *)
7
8type error =
9 | Command_failed of {
10 cmd : string list;
11 exit_code : int;
12 stdout : string;
13 stderr : string;
14 }
15 | Not_a_repository
16 | Remote_exists of string
17 | Remote_not_found of string
18 | Branch_exists of string
19 | Branch_not_found of string
20 | Merge_conflict of { branch : string; conflicting_files : string list }
21 | Rebase_conflict of { onto : string; hint : string }
22 | Uncommitted_changes
23 | Not_on_branch
24 | Detached_head
25
26let pp_error fmt = function
27 | Command_failed { cmd; exit_code; stderr; _ } ->
28 Format.fprintf fmt "git %a failed (exit %d): %s"
29 Fmt.(list ~sep:sp string) cmd exit_code
30 (String.trim stderr)
31 | Not_a_repository ->
32 Format.fprintf fmt "not a git repository"
33 | Remote_exists name ->
34 Format.fprintf fmt "remote '%s' already exists" name
35 | Remote_not_found name ->
36 Format.fprintf fmt "remote '%s' not found" name
37 | Branch_exists name ->
38 Format.fprintf fmt "branch '%s' already exists" name
39 | Branch_not_found name ->
40 Format.fprintf fmt "branch '%s' not found" name
41 | Merge_conflict { branch; conflicting_files } ->
42 Format.fprintf fmt "merge conflict in '%s': %a" branch
43 Fmt.(list ~sep:comma string) conflicting_files
44 | Rebase_conflict { onto; hint } ->
45 Format.fprintf fmt "rebase conflict onto '%s': %s" onto hint
46 | Uncommitted_changes ->
47 Format.fprintf fmt "uncommitted changes in working directory"
48 | Not_on_branch ->
49 Format.fprintf fmt "not on any branch"
50 | Detached_head ->
51 Format.fprintf fmt "HEAD is detached"
52
53type Eio.Exn.err += E of error
54
55let () =
56 Eio.Exn.register_pp (fun fmt -> function
57 | E e -> Format.fprintf fmt "Git %a" pp_error e; true
58 | _ -> false)
59
60let err e = Eio.Exn.create (E e)
61
62(* Types *)
63
64type proc_mgr = [ `Generic | `Unix ] Eio.Process.mgr_ty Eio.Resource.t
65type path = Eio.Fs.dir_ty Eio.Path.t
66
67(* Helpers *)
68
69let string_trim s = String.trim s
70
71let lines s =
72 String.split_on_char '\n' s
73 |> List.filter (fun s -> String.trim s <> "")
74
75(* Low-level execution *)
76
77let run ~proc_mgr ?cwd ?audit args =
78 let full_cmd = "git" :: args in
79 Log.debug (fun m -> m "Running: %a" Fmt.(list ~sep:sp string) full_cmd);
80 let started = Unix.gettimeofday () in
81 let cwd_str = match cwd with Some p -> snd p | None -> Sys.getcwd () in
82 let stdout_buf = Buffer.create 256 in
83 let stderr_buf = Buffer.create 256 in
84 try
85 Eio.Switch.run @@ fun sw ->
86 let stdout_r, stdout_w = Eio.Process.pipe proc_mgr ~sw in
87 let stderr_r, stderr_w = Eio.Process.pipe proc_mgr ~sw in
88 let child = Eio.Process.spawn proc_mgr ~sw
89 ?cwd:(Option.map (fun p -> (p :> Eio.Fs.dir_ty Eio.Path.t)) cwd)
90 ~stdout:stdout_w ~stderr:stderr_w
91 full_cmd
92 in
93 Eio.Flow.close stdout_w;
94 Eio.Flow.close stderr_w;
95 (* Read stdout and stderr concurrently *)
96 Eio.Fiber.both
97 (fun () ->
98 let chunk = Cstruct.create 4096 in
99 let rec loop () =
100 match Eio.Flow.single_read stdout_r chunk with
101 | n ->
102 Buffer.add_string stdout_buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
103 loop ()
104 | exception End_of_file -> ()
105 in
106 loop ())
107 (fun () ->
108 let chunk = Cstruct.create 4096 in
109 let rec loop () =
110 match Eio.Flow.single_read stderr_r chunk with
111 | n ->
112 Buffer.add_string stderr_buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
113 loop ()
114 | exception End_of_file -> ()
115 in
116 loop ());
117 let status = Eio.Process.await child in
118 let stdout = Buffer.contents stdout_buf in
119 let stderr = Buffer.contents stderr_buf in
120 let exit_code, result = match status with
121 | `Exited 0 ->
122 Log.debug (fun m -> m "Output: %s" (string_trim stdout));
123 0, Ok stdout
124 | `Exited code ->
125 Log.debug (fun m -> m "Failed (exit %d): %s" code (string_trim stderr));
126 code, Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
127 | `Signaled signal ->
128 Log.debug (fun m -> m "Killed by signal %d" signal);
129 let code = 128 + signal in
130 code, Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
131 in
132 (* Record to audit if provided *)
133 Option.iter (fun ctx ->
134 let git_result : Audit.git_result = { exit_code; stdout; stderr } in
135 Audit.record_git ctx ~cmd:args ~cwd:cwd_str ~started ~result:git_result
136 ) audit;
137 result
138 with exn ->
139 Log.err (fun m -> m "Exception running git: %a" Fmt.exn exn);
140 raise exn
141
142let run_exn ~proc_mgr ?cwd ?audit args =
143 match run ~proc_mgr ?cwd ?audit args with
144 | Ok output -> output
145 | Error e ->
146 let ex = err e in
147 raise (Eio.Exn.add_context ex "running git %a" Fmt.(list ~sep:sp string) args)
148
149let run_lines ~proc_mgr ?cwd ?audit args =
150 run_exn ~proc_mgr ?cwd ?audit args |> string_trim |> lines
151
152(* Queries *)
153
154let is_repository path =
155 let git_dir = Eio.Path.(path / ".git") in
156 match Eio.Path.kind ~follow:false git_dir with
157 | `Directory | `Regular_file -> true (* .git can be a file for worktrees *)
158 | _ -> false
159 | exception _ -> false
160
161let current_branch ~proc_mgr ~cwd =
162 match run ~proc_mgr ~cwd ["symbolic-ref"; "--short"; "HEAD"] with
163 | Ok output -> Some (string_trim output)
164 | Error _ -> None
165
166let current_branch_exn ~proc_mgr ~cwd =
167 match current_branch ~proc_mgr ~cwd with
168 | Some b -> b
169 | None -> raise (err Not_on_branch)
170
171let current_head ~proc_mgr ~cwd =
172 run_exn ~proc_mgr ~cwd ["rev-parse"; "HEAD"] |> string_trim
173
174let has_uncommitted_changes ~proc_mgr ~cwd =
175 let status = run_exn ~proc_mgr ~cwd ["status"; "--porcelain"] in
176 String.trim status <> ""
177
178let remote_exists ~proc_mgr ~cwd name =
179 match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
180 | Ok _ -> true
181 | Error _ -> false
182
183let branch_exists ~proc_mgr ~cwd name =
184 match run ~proc_mgr ~cwd ["show-ref"; "--verify"; "--quiet"; "refs/heads/" ^ name] with
185 | Ok _ -> true
186 | Error _ -> false
187
188let rev_parse ~proc_mgr ~cwd ref_ =
189 match run ~proc_mgr ~cwd ["rev-parse"; "--verify"; "--quiet"; ref_] with
190 | Ok output -> Some (string_trim output)
191 | Error _ -> None
192
193let rev_parse_exn ~proc_mgr ~cwd ref_ =
194 match rev_parse ~proc_mgr ~cwd ref_ with
195 | Some sha -> sha
196 | None -> raise (err (Branch_not_found ref_))
197
198let rev_parse_short ~proc_mgr ~cwd ref_ =
199 run_exn ~proc_mgr ~cwd ["rev-parse"; "--short"; ref_] |> string_trim
200
201let ls_remote_default_branch ~proc_mgr ~cwd ~url =
202 Log.info (fun m -> m "Detecting default branch for %s..." url);
203 (* Try to get the default branch from the remote *)
204 let output = run_exn ~proc_mgr ~cwd ["ls-remote"; "--symref"; url; "HEAD"] in
205 (* Parse output like: ref: refs/heads/main\tHEAD *)
206 let default =
207 let lines = String.split_on_char '\n' output in
208 List.find_map (fun line ->
209 if String.starts_with ~prefix:"ref:" line then
210 let parts = String.split_on_char '\t' line in
211 match parts with
212 | ref_part :: _ ->
213 let ref_part = String.trim ref_part in
214 if String.starts_with ~prefix:"ref: refs/heads/" ref_part then
215 Some (String.sub ref_part 16 (String.length ref_part - 16))
216 else None
217 | _ -> None
218 else None
219 ) lines
220 in
221 match default with
222 | Some branch ->
223 Log.info (fun m -> m "Default branch: %s" branch);
224 branch
225 | None ->
226 (* Fallback: try common branch names *)
227 Log.debug (fun m -> m "Could not detect default branch, trying common names...");
228 let try_branch name =
229 match run ~proc_mgr ~cwd ["ls-remote"; "--heads"; url; name] with
230 | Ok output when String.trim output <> "" -> true
231 | _ -> false
232 in
233 if try_branch "main" then "main"
234 else if try_branch "master" then "master"
235 else begin
236 Log.warn (fun m -> m "Could not detect default branch, assuming 'main'");
237 "main"
238 end
239
240let list_remotes ~proc_mgr ~cwd =
241 run_lines ~proc_mgr ~cwd ["remote"]
242
243let remote_url ~proc_mgr ~cwd name =
244 match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
245 | Ok output -> Some (string_trim output)
246 | Error _ -> None
247
248let log_oneline ~proc_mgr ~cwd ?max_count from_ref to_ref =
249 let range = from_ref ^ ".." ^ to_ref in
250 let args = ["log"; "--oneline"; range] in
251 let args = match max_count with
252 | Some n -> args @ ["--max-count"; string_of_int n]
253 | None -> args
254 in
255 run_lines ~proc_mgr ~cwd args
256
257let diff_stat ~proc_mgr ~cwd from_ref to_ref =
258 let range = from_ref ^ ".." ^ to_ref in
259 run_exn ~proc_mgr ~cwd ["diff"; "--stat"; range]
260
261let ls_tree ~proc_mgr ~cwd ~tree ~path =
262 match run ~proc_mgr ~cwd ["ls-tree"; tree; path] with
263 | Ok output -> String.trim output <> ""
264 | Error _ -> false
265
266let rev_list_count ~proc_mgr ~cwd from_ref to_ref =
267 let range = from_ref ^ ".." ^ to_ref in
268 let output = run_exn ~proc_mgr ~cwd ["rev-list"; "--count"; range] in
269 int_of_string (string_trim output)
270
271(* Idempotent mutations *)
272
273let ensure_remote ~proc_mgr ~cwd ~name ~url =
274 match remote_url ~proc_mgr ~cwd name with
275 | None ->
276 Log.info (fun m -> m "Adding remote %s -> %s" name url);
277 run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore;
278 `Created
279 | Some existing_url ->
280 if existing_url = url then begin
281 Log.debug (fun m -> m "Remote %s already exists with correct URL" name);
282 `Existed
283 end else begin
284 Log.info (fun m -> m "Updating remote %s URL: %s -> %s" name existing_url url);
285 run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore;
286 `Updated
287 end
288
289let ensure_branch ~proc_mgr ~cwd ~name ~start_point =
290 if branch_exists ~proc_mgr ~cwd name then begin
291 Log.debug (fun m -> m "Branch %s already exists" name);
292 `Existed
293 end else begin
294 Log.info (fun m -> m "Creating branch %s at %s" name start_point);
295 run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore;
296 `Created
297 end
298
299let ensure_vendored_remotes ~proc_mgr ~cwd (packages : Config.vendored_package list) =
300 let created = ref 0 in
301 List.iter (fun (pkg : Config.vendored_package) ->
302 let remote_name = "origin-" ^ pkg.pkg_name in
303 match ensure_remote ~proc_mgr ~cwd ~name:remote_name ~url:pkg.pkg_url with
304 | `Created ->
305 Log.info (fun m -> m "Recreated remote %s -> %s" remote_name pkg.pkg_url);
306 incr created
307 | `Updated ->
308 Log.info (fun m -> m "Updated remote %s -> %s" remote_name pkg.pkg_url)
309 | `Existed -> ()
310 ) packages;
311 !created
312
313(* State-changing operations *)
314
315let init ~proc_mgr ~cwd =
316 Log.info (fun m -> m "Initializing git repository...");
317 run_exn ~proc_mgr ~cwd ["init"] |> ignore
318
319let fetch ~proc_mgr ~cwd ~remote =
320 Log.info (fun m -> m "Fetching from %s..." remote);
321 run_exn ~proc_mgr ~cwd ["fetch"; remote] |> ignore
322
323let fetch_with_tags ~proc_mgr ~cwd ~remote =
324 Log.info (fun m -> m "Fetching from %s (with tags)..." remote);
325 run_exn ~proc_mgr ~cwd ["fetch"; "--tags"; "--force"; remote] |> ignore
326
327let resolve_branch_or_tag ~proc_mgr ~cwd ~remote ~ref_name =
328 (* Try as a remote tracking branch first *)
329 let branch_ref = remote ^ "/" ^ ref_name in
330 match rev_parse ~proc_mgr ~cwd branch_ref with
331 | Some _ -> branch_ref
332 | None ->
333 (* Try as a tag *)
334 let tag_ref = "refs/tags/" ^ ref_name in
335 match rev_parse ~proc_mgr ~cwd tag_ref with
336 | Some _ -> tag_ref
337 | None ->
338 failwith (Printf.sprintf "Ref not found: %s (tried branch %s and tag %s)"
339 ref_name branch_ref tag_ref)
340
341let checkout ~proc_mgr ~cwd ref_ =
342 Log.debug (fun m -> m "Checking out %s" ref_);
343 run_exn ~proc_mgr ~cwd ["checkout"; ref_] |> ignore
344
345let checkout_orphan ~proc_mgr ~cwd name =
346 Log.info (fun m -> m "Creating orphan branch %s" name);
347 run_exn ~proc_mgr ~cwd ["checkout"; "--orphan"; name] |> ignore
348
349let read_tree_prefix ~proc_mgr ~cwd ~prefix ~tree =
350 Log.debug (fun m -> m "Reading tree %s with prefix %s" tree prefix);
351 run_exn ~proc_mgr ~cwd ["read-tree"; "--prefix=" ^ prefix; tree] |> ignore
352
353let checkout_index ~proc_mgr ~cwd =
354 Log.debug (fun m -> m "Checking out index to working directory");
355 run_exn ~proc_mgr ~cwd ["checkout-index"; "-a"; "-f"] |> ignore
356
357let rm_rf ~proc_mgr ~cwd ~target =
358 Log.debug (fun m -> m "Removing %s from git" target);
359 (* Ignore errors - target might not exist *)
360 ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; target])
361
362let rm_cached_rf ~proc_mgr ~cwd =
363 Log.debug (fun m -> m "Removing all files from index");
364 (* Ignore errors - index might be empty *)
365 ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; "--cached"; "."])
366
367let add_all ~proc_mgr ~cwd =
368 Log.debug (fun m -> m "Staging all changes");
369 run_exn ~proc_mgr ~cwd ["add"; "-A"] |> ignore
370
371let commit ~proc_mgr ~cwd ~message =
372 Log.debug (fun m -> m "Committing: %s" (String.sub message 0 (min 50 (String.length message))));
373 run_exn ~proc_mgr ~cwd ["commit"; "-m"; message] |> ignore
374
375let commit_allow_empty ~proc_mgr ~cwd ~message =
376 Log.debug (fun m -> m "Committing (allow empty): %s" (String.sub message 0 (min 50 (String.length message))));
377 run_exn ~proc_mgr ~cwd ["commit"; "--allow-empty"; "-m"; message] |> ignore
378
379let branch_create ~proc_mgr ~cwd ~name ~start_point =
380 Log.info (fun m -> m "Creating branch %s at %s" name start_point);
381 run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore
382
383let branch_force ~proc_mgr ~cwd ~name ~point =
384 Log.info (fun m -> m "Force-moving branch %s to %s" name point);
385 run_exn ~proc_mgr ~cwd ["branch"; "-f"; name; point] |> ignore
386
387let remote_add ~proc_mgr ~cwd ~name ~url =
388 Log.info (fun m -> m "Adding remote %s -> %s" name url);
389 run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore
390
391let remote_set_url ~proc_mgr ~cwd ~name ~url =
392 Log.info (fun m -> m "Setting remote %s URL to %s" name url);
393 run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore
394
395let merge_allow_unrelated ~proc_mgr ~cwd ~branch ~message =
396 Log.info (fun m -> m "Merging %s (allow unrelated histories)..." branch);
397 match run ~proc_mgr ~cwd ["merge"; "--allow-unrelated-histories"; "-m"; message; branch] with
398 | Ok _ -> Ok ()
399 | Error (Command_failed { exit_code = 1; _ }) ->
400 (* Merge conflict - get list of conflicting files *)
401 let output = run_exn ~proc_mgr ~cwd ["diff"; "--name-only"; "--diff-filter=U"] in
402 let files = lines output in
403 Log.warn (fun m -> m "Merge conflict: %a" Fmt.(list ~sep:comma string) files);
404 Error (`Conflict files)
405 | Error e ->
406 raise (err e)
407
408let rebase ~proc_mgr ~cwd ~onto =
409 Log.info (fun m -> m "Rebasing onto %s..." onto);
410 match run ~proc_mgr ~cwd ["rebase"; onto] with
411 | Ok _ -> Ok ()
412 | Error (Command_failed { stderr; _ }) ->
413 let hint =
414 if String.length stderr > 200 then
415 String.sub stderr 0 200 ^ "..."
416 else
417 stderr
418 in
419 Log.warn (fun m -> m "Rebase conflict onto %s" onto);
420 Error (`Conflict hint)
421 | Error e ->
422 raise (err e)
423
424let rebase_abort ~proc_mgr ~cwd =
425 Log.info (fun m -> m "Aborting rebase...");
426 ignore (run ~proc_mgr ~cwd ["rebase"; "--abort"])
427
428let merge_abort ~proc_mgr ~cwd =
429 Log.info (fun m -> m "Aborting merge...");
430 ignore (run ~proc_mgr ~cwd ["merge"; "--abort"])
431
432let reset_hard ~proc_mgr ~cwd ref_ =
433 Log.info (fun m -> m "Hard reset to %s" ref_);
434 run_exn ~proc_mgr ~cwd ["reset"; "--hard"; ref_] |> ignore
435
436let clean_fd ~proc_mgr ~cwd =
437 Log.debug (fun m -> m "Cleaning untracked files");
438 run_exn ~proc_mgr ~cwd ["clean"; "-fd"] |> ignore
439
440let filter_repo_to_subdirectory ~proc_mgr ~cwd ~branch ~subdirectory =
441 Log.info (fun m -> m "Rewriting history of %s into subdirectory %s..." branch subdirectory);
442 (* Use git-filter-repo with --to-subdirectory-filter to rewrite all paths into subdirectory.
443 This preserves full history with paths prefixed. Much faster than filter-branch.
444
445 For bare repositories, we need to create a temporary worktree, run filter-repo
446 there, and then update the branch in the bare repo. *)
447
448 (* Create a unique temporary worktree name using the branch name *)
449 let safe_branch = String.map (fun c -> if c = '/' then '-' else c) branch in
450 let temp_wt_name = ".filter-tmp-" ^ safe_branch in
451 let temp_wt_relpath = "../" ^ temp_wt_name in
452
453 (* Construct the worktree path - cwd is (fs, path_string), so we go up one level *)
454 let fs = fst cwd in
455 let git_path = snd cwd in
456 let parent_path = Filename.dirname git_path in
457 let temp_wt_path = Filename.concat parent_path temp_wt_name in
458 let temp_wt : path = (fs, temp_wt_path) in
459
460 (* Remove any existing temp worktree *)
461 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
462
463 (* Create worktree for the branch *)
464 run_exn ~proc_mgr ~cwd ["worktree"; "add"; temp_wt_relpath; branch] |> ignore;
465
466 (* Run git-filter-repo in the worktree *)
467 let result = run ~proc_mgr ~cwd:temp_wt [
468 "filter-repo";
469 "--to-subdirectory-filter"; subdirectory;
470 "--force";
471 "--refs"; "HEAD"
472 ] in
473
474 (* Handle result: get the new SHA, cleanup worktree, then update branch *)
475 (match result with
476 | Ok _ ->
477 (* Get the new HEAD SHA from the worktree BEFORE removing it *)
478 let new_sha = run_exn ~proc_mgr ~cwd:temp_wt ["rev-parse"; "HEAD"] |> string_trim in
479 (* Cleanup temporary worktree first (must do this before updating branch) *)
480 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
481 (* Now update the branch in the bare repo *)
482 run_exn ~proc_mgr ~cwd ["branch"; "-f"; branch; new_sha] |> ignore
483 | Error e ->
484 (* Cleanup and re-raise *)
485 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
486 raise (err e))
487
488let filter_repo_from_subdirectory ~proc_mgr ~cwd ~branch ~subdirectory =
489 Log.info (fun m -> m "Extracting %s from subdirectory %s to root..." branch subdirectory);
490 (* Use git-filter-repo with --subdirectory-filter to extract files from subdirectory
491 to root. This is the inverse of --to-subdirectory-filter.
492 Preserves history for files that were in the subdirectory.
493
494 For bare repositories, we need to create a temporary worktree, run filter-repo
495 there, and then update the branch in the bare repo. *)
496
497 (* Create a unique temporary worktree name using the branch name *)
498 let safe_branch = String.map (fun c -> if c = '/' then '-' else c) branch in
499 let temp_wt_name = ".filter-tmp-" ^ safe_branch in
500 let temp_wt_relpath = "../" ^ temp_wt_name in
501
502 (* Construct the worktree path - cwd is (fs, path_string), so we go up one level *)
503 let fs = fst cwd in
504 let git_path = snd cwd in
505 let parent_path = Filename.dirname git_path in
506 let temp_wt_path = Filename.concat parent_path temp_wt_name in
507 let temp_wt : path = (fs, temp_wt_path) in
508
509 (* Remove any existing temp worktree *)
510 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
511
512 (* Create worktree for the branch *)
513 run_exn ~proc_mgr ~cwd ["worktree"; "add"; temp_wt_relpath; branch] |> ignore;
514
515 (* Run git-filter-repo in the worktree with --subdirectory-filter *)
516 let result = run ~proc_mgr ~cwd:temp_wt [
517 "filter-repo";
518 "--subdirectory-filter"; subdirectory;
519 "--force";
520 "--refs"; "HEAD"
521 ] in
522
523 (* Handle result: get the new SHA, cleanup worktree, then update branch *)
524 (match result with
525 | Ok _ ->
526 (* Get the new HEAD SHA from the worktree BEFORE removing it *)
527 let new_sha = run_exn ~proc_mgr ~cwd:temp_wt ["rev-parse"; "HEAD"] |> string_trim in
528 (* Cleanup temporary worktree first (must do this before updating branch) *)
529 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
530 (* Now update the branch in the bare repo *)
531 run_exn ~proc_mgr ~cwd ["branch"; "-f"; branch; new_sha] |> ignore
532 | Error e ->
533 (* Cleanup and re-raise *)
534 ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
535 raise (err e))