anil.recoil.org
A monorepo management tool for the agentic ages
1(** Git worktree lifecycle management for unpac.
2
3 Manages creation, cleanup, and paths of worktrees within the unpac
4 directory structure. All branch operations happen in isolated worktrees. *)
5
6(** {1 Types} *)
7
8type root = Eio.Fs.dir_ty Eio.Path.t
9(** The unpac project root directory (contains git/, main/, etc.) *)
10
11type kind =
12 | Main
13 | Project of string
14 | Opam_upstream of string
15 | Opam_vendor of string
16 | Opam_patches of string
17 | Git_upstream of string
18 | Git_vendor of string
19 | Git_patches of string
20(** Worktree kinds with their associated names.
21 Opam_* variants are for opam package vendoring.
22 Git_* variants are for direct git repository vendoring. *)
23
24(** {1 Path and Branch Helpers} *)
25
26let git_dir root = Eio.Path.(root / "git")
27(** Path to the bare git repository. *)
28
29let path root = function
30 | Main -> Eio.Path.(root / "main")
31 | Project name -> Eio.Path.(root / "project" / name)
32 | Opam_upstream name -> Eio.Path.(root / "opam" / "upstream" / name)
33 | Opam_vendor name -> Eio.Path.(root / "opam" / "vendor" / name)
34 | Opam_patches name -> Eio.Path.(root / "opam" / "patches" / name)
35 | Git_upstream name -> Eio.Path.(root / "git-repos" / "upstream" / name)
36 | Git_vendor name -> Eio.Path.(root / "git-repos" / "vendor" / name)
37 | Git_patches name -> Eio.Path.(root / "git-repos" / "patches" / name)
38
39let branch = function
40 | Main -> "main"
41 | Project name -> "project/" ^ name
42 | Opam_upstream name -> "opam/upstream/" ^ name
43 | Opam_vendor name -> "opam/vendor/" ^ name
44 | Opam_patches name -> "opam/patches/" ^ name
45 | Git_upstream name -> "git/upstream/" ^ name
46 | Git_vendor name -> "git/vendor/" ^ name
47 | Git_patches name -> "git/patches/" ^ name
48
49let relative_path = function
50 | Main -> "main"
51 | Project name -> "project/" ^ name
52 | Opam_upstream name -> "opam/upstream/" ^ name
53 | Opam_vendor name -> "opam/vendor/" ^ name
54 | Opam_patches name -> "opam/patches/" ^ name
55 | Git_upstream name -> "git-repos/upstream/" ^ name
56 | Git_vendor name -> "git-repos/vendor/" ^ name
57 | Git_patches name -> "git-repos/patches/" ^ name
58
59(** {1 Queries} *)
60
61let exists root kind =
62 let p = path root kind in
63 Eio.Path.is_directory p
64
65let branch_exists ~proc_mgr root kind =
66 let git = git_dir root in
67 Git.branch_exists ~proc_mgr ~cwd:git (branch kind)
68
69(** {1 Operations} *)
70
71let ensure ~proc_mgr root kind =
72 if exists root kind then ()
73 else begin
74 let git = git_dir root in
75 let wt_path = path root kind in
76 let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
77 let br = branch kind in
78
79 (* Ensure parent directories exist *)
80 let parent = Eio.Path.split wt_path |> Option.map fst in
81 Option.iter (fun p -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p) parent;
82
83 (* Create worktree *)
84 Git.run_exn ~proc_mgr ~cwd:git
85 ["worktree"; "add"; rel_path; br] |> ignore
86 end
87
88let ensure_orphan ~proc_mgr root kind =
89 if exists root kind then ()
90 else begin
91 let git = git_dir root in
92 let wt_path = path root kind in
93 let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
94 let br = branch kind in
95
96 (* Ensure parent directories exist *)
97 let parent = Eio.Path.split wt_path |> Option.map fst in
98 Option.iter (fun p -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p) parent;
99
100 (* Create a detached worktree from main branch, then make it an orphan *)
101 let start_commit = Git.run_exn ~proc_mgr ~cwd:git ["rev-parse"; "main"] |> String.trim in
102 Git.run_exn ~proc_mgr ~cwd:git
103 ["worktree"; "add"; "--detach"; rel_path; start_commit] |> ignore;
104
105 (* Now in the worktree, create an orphan branch and clear files *)
106 Git.run_exn ~proc_mgr ~cwd:wt_path ["checkout"; "--orphan"; br] |> ignore;
107 (* Remove all tracked files from index *)
108 Git.run_exn ~proc_mgr ~cwd:wt_path ["rm"; "-rf"; "--cached"; "."] |> ignore;
109 (* Clean the working directory *)
110 Git.run_exn ~proc_mgr ~cwd:wt_path ["clean"; "-fd"] |> ignore
111 end
112
113let ensure_detached ~proc_mgr root kind ~commit =
114 if exists root kind then ()
115 else begin
116 let git = git_dir root in
117 let wt_path = path root kind in
118 let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
119
120 (* Ensure parent directories exist *)
121 let parent = Eio.Path.split wt_path |> Option.map fst in
122 Option.iter (fun p -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p) parent;
123
124 (* Create detached worktree at commit *)
125 Git.run_exn ~proc_mgr ~cwd:git
126 ["worktree"; "add"; "--detach"; rel_path; commit] |> ignore
127 end
128
129let remove ~proc_mgr root kind =
130 if not (exists root kind) then ()
131 else begin
132 let git = git_dir root in
133 let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
134 Git.run_exn ~proc_mgr ~cwd:git
135 ["worktree"; "remove"; rel_path] |> ignore
136 end
137
138let remove_force ~proc_mgr root kind =
139 if not (exists root kind) then ()
140 else begin
141 let git = git_dir root in
142 let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
143 Git.run_exn ~proc_mgr ~cwd:git
144 ["worktree"; "remove"; "--force"; rel_path] |> ignore
145 end
146
147let with_temp ~proc_mgr root kind f =
148 ensure ~proc_mgr root kind;
149 Fun.protect
150 ~finally:(fun () -> remove ~proc_mgr root kind)
151 (fun () -> f (path root kind))
152
153let with_temp_orphan ~proc_mgr root kind f =
154 ensure_orphan ~proc_mgr root kind;
155 Fun.protect
156 ~finally:(fun () -> remove ~proc_mgr root kind)
157 (fun () -> f (path root kind))
158
159(** {1 Listing} *)
160
161let list_worktrees ~proc_mgr root =
162 let git = git_dir root in
163 Git.run_lines ~proc_mgr ~cwd:git ["worktree"; "list"; "--porcelain"]
164 |> List.filter_map (fun line ->
165 if String.starts_with ~prefix:"worktree " line then
166 Some (String.sub line 9 (String.length line - 9))
167 else None)
168
169let list_projects ~proc_mgr root =
170 let git = git_dir root in
171 Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--list"; "project/*"]
172 |> List.filter_map (fun line ->
173 let line = String.trim line in
174 (* Strip "* " (current) or "+ " (linked worktree) prefix *)
175 let line =
176 if String.starts_with ~prefix:"* " line || String.starts_with ~prefix:"+ " line
177 then String.sub line 2 (String.length line - 2)
178 else line
179 in
180 if String.starts_with ~prefix:"project/" line then
181 Some (String.sub line 8 (String.length line - 8))
182 else None)
183
184let list_opam_packages ~proc_mgr root =
185 let git = git_dir root in
186 Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--list"; "opam/patches/*"]
187 |> List.filter_map (fun line ->
188 let line = String.trim line in
189 (* Strip "* " (current) or "+ " (linked worktree) prefix *)
190 let line =
191 if String.starts_with ~prefix:"* " line || String.starts_with ~prefix:"+ " line
192 then String.sub line 2 (String.length line - 2)
193 else line
194 in
195 if String.starts_with ~prefix:"opam/patches/" line then
196 Some (String.sub line 13 (String.length line - 13))
197 else None)
198
199let list_git_repos ~proc_mgr root =
200 let git = git_dir root in
201 Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--list"; "git/patches/*"]
202 |> List.filter_map (fun line ->
203 let line = String.trim line in
204 (* Strip "* " (current) or "+ " (linked worktree) prefix *)
205 let line =
206 if String.starts_with ~prefix:"* " line || String.starts_with ~prefix:"+ " line
207 then String.sub line 2 (String.length line - 2)
208 else line
209 in
210 if String.starts_with ~prefix:"git/patches/" line then
211 Some (String.sub line 12 (String.length line - 12))
212 else None)