A monorepo management tool for the agentic ages
1(** Git backend for direct repository vendoring.
2
3 Implements vendoring of arbitrary git repositories using the three-tier branch model:
4 - git/upstream/<name> - pristine upstream code
5 - git/vendor/<name> - upstream history rewritten with vendor/git/<name>/ prefix
6 - git/patches/<name> - local modifications *)
7
8(** {1 Branch Naming} *)
9
10let upstream_branch name = "git/upstream/" ^ name
11let vendor_branch name = "git/vendor/" ^ name
12let patches_branch name = "git/patches/" ^ name
13let vendor_path name = "vendor/git/" ^ name
14
15(** {1 Worktree Kinds} *)
16
17let upstream_kind name = Worktree.Git_upstream name
18let vendor_kind name = Worktree.Git_vendor name
19let patches_kind name = Worktree.Git_patches name
20
21(** {1 Repository Info} *)
22
23type repo_info = {
24 name : string;
25 url : string;
26 branch : string option;
27 subdir : string option;
28}
29
30(** {1 Repository Operations} *)
31
32let add_repo ~proc_mgr ~root ?cache info =
33 let repo_name = info.name in
34 let git = Worktree.git_dir root in
35
36 try
37 (* Check if already exists *)
38 if Worktree.branch_exists ~proc_mgr root (patches_kind repo_name) then
39 Backend.Already_exists repo_name
40 else begin
41 (* Rewrite URL for known mirrors *)
42 let url = Git_repo_lookup.rewrite_url info.url in
43
44 (* Determine the ref to use: explicit > override > default *)
45 let branch = match info.branch with
46 | Some b -> b
47 | None ->
48 match Git_repo_lookup.branch_override ~name:repo_name ~url with
49 | Some b -> b
50 | None -> Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url
51 in
52
53 (* Fetch - either via cache or directly *)
54 let ref_point = match cache with
55 | Some cache_path ->
56 (* Fetch through vendor cache *)
57 Vendor_cache.fetch_to_project ~proc_mgr
58 ~cache:cache_path ~project_git:git ~url ~branch
59 | None ->
60 (* Direct fetch (with tags to support version tags) *)
61 let remote = "origin-" ^ repo_name in
62 ignore (Git.ensure_remote ~proc_mgr ~cwd:git ~name:remote ~url);
63 Git.fetch_with_tags ~proc_mgr ~cwd:git ~remote;
64 Git.resolve_branch_or_tag ~proc_mgr ~cwd:git ~remote ~ref_name:branch
65 in
66
67 (* Step 1: Create upstream branch from fetched ref *)
68 Git.branch_force ~proc_mgr ~cwd:git
69 ~name:(upstream_branch repo_name) ~point:ref_point;
70
71 (* Step 2: Create vendor branch from upstream and rewrite history *)
72 Git.branch_force ~proc_mgr ~cwd:git
73 ~name:(vendor_branch repo_name) ~point:(upstream_branch repo_name);
74
75 (* If subdir is specified, we first filter to that subdirectory,
76 then move to vendor path. Otherwise, just move to vendor path. *)
77 (match info.subdir with
78 | Some subdir ->
79 (* First filter to extract only the subdirectory *)
80 Git.filter_repo_to_subdirectory ~proc_mgr ~cwd:git
81 ~branch:(vendor_branch repo_name)
82 ~subdirectory:subdir;
83 (* Now the subdir is at root, rewrite to vendor path *)
84 Git.filter_repo_to_subdirectory ~proc_mgr ~cwd:git
85 ~branch:(vendor_branch repo_name)
86 ~subdirectory:(vendor_path repo_name)
87 | None ->
88 (* Rewrite vendor branch history to move all files into vendor/git/<name>/ *)
89 Git.filter_repo_to_subdirectory ~proc_mgr ~cwd:git
90 ~branch:(vendor_branch repo_name)
91 ~subdirectory:(vendor_path repo_name));
92
93 (* Get the vendor SHA after rewriting *)
94 let vendor_sha = match Git.rev_parse ~proc_mgr ~cwd:git (vendor_branch repo_name) with
95 | Some sha -> sha
96 | None -> failwith "Vendor branch not found after filter-repo"
97 in
98
99 (* Step 3: Create patches branch from vendor *)
100 Git.branch_create ~proc_mgr ~cwd:git
101 ~name:(patches_branch repo_name)
102 ~start_point:(vendor_branch repo_name);
103
104 Backend.Added { name = repo_name; sha = vendor_sha }
105 end
106 with exn ->
107 (* Cleanup on failure *)
108 (try Worktree.remove_force ~proc_mgr root (upstream_kind repo_name) with _ -> ());
109 (try Worktree.remove_force ~proc_mgr root (vendor_kind repo_name) with _ -> ());
110 Backend.Failed { name = repo_name; error = Printexc.to_string exn }
111
112let copy_with_prefix ~src_dir ~dst_dir ~prefix =
113 (* Recursively copy files from src_dir to dst_dir/prefix/ *)
114 let prefix_dir = Eio.Path.(dst_dir / prefix) in
115 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 prefix_dir;
116
117 let rec copy_dir src dst =
118 Eio.Path.read_dir src |> List.iter (fun name ->
119 let src_path = Eio.Path.(src / name) in
120 let dst_path = Eio.Path.(dst / name) in
121 if Eio.Path.is_directory src_path then begin
122 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
123 copy_dir src_path dst_path
124 end else begin
125 let content = Eio.Path.load src_path in
126 Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
127 end
128 )
129 in
130
131 (* Copy everything except .git *)
132 Eio.Path.read_dir src_dir |> List.iter (fun name ->
133 if name <> ".git" then begin
134 let src_path = Eio.Path.(src_dir / name) in
135 let dst_path = Eio.Path.(prefix_dir / name) in
136 if Eio.Path.is_directory src_path then begin
137 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
138 copy_dir src_path dst_path
139 end else begin
140 let content = Eio.Path.load src_path in
141 Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
142 end
143 end
144 )
145
146let update_repo ~proc_mgr ~root ?cache repo_name =
147 let git = Worktree.git_dir root in
148
149 try
150 (* Check if repo exists *)
151 if not (Worktree.branch_exists ~proc_mgr root (patches_kind repo_name)) then
152 Backend.Update_failed { name = repo_name; error = "Repository not vendored" }
153 else begin
154 (* Get remote URL *)
155 let remote = "origin-" ^ repo_name in
156 let url = match Git.remote_url ~proc_mgr ~cwd:git remote with
157 | Some u -> u
158 | None -> failwith ("Remote not found: " ^ remote)
159 in
160
161 (* Fetch latest - either via cache or directly (with tags for completeness) *)
162 (match cache with
163 | Some cache_path ->
164 let branch = Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url in
165 ignore (Vendor_cache.fetch_to_project ~proc_mgr
166 ~cache:cache_path ~project_git:git ~url ~branch)
167 | None ->
168 Git.fetch_with_tags ~proc_mgr ~cwd:git ~remote);
169
170 (* Get old SHA *)
171 let old_sha = match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch repo_name) with
172 | Some sha -> sha
173 | None -> failwith "Upstream branch not found"
174 in
175
176 (* Determine default branch and update upstream *)
177 let default_branch = Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url in
178 let ref_point = remote ^ "/" ^ default_branch in
179 Git.branch_force ~proc_mgr ~cwd:git
180 ~name:(upstream_branch repo_name) ~point:ref_point;
181
182 (* Get new SHA *)
183 let new_sha = match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch repo_name) with
184 | Some sha -> sha
185 | None -> failwith "Upstream branch not found"
186 in
187
188 if old_sha = new_sha then
189 Backend.No_changes repo_name
190 else begin
191 (* Create worktrees *)
192 Worktree.ensure ~proc_mgr root (upstream_kind repo_name);
193 Worktree.ensure ~proc_mgr root (vendor_kind repo_name);
194
195 let upstream_wt = Worktree.path root (upstream_kind repo_name) in
196 let vendor_wt = Worktree.path root (vendor_kind repo_name) in
197
198 (* Clear vendor content and copy new *)
199 let vendor_pkg_path = Eio.Path.(vendor_wt / "vendor" / "git" / repo_name) in
200 (try Eio.Path.rmtree vendor_pkg_path with _ -> ());
201
202 copy_with_prefix
203 ~src_dir:upstream_wt
204 ~dst_dir:vendor_wt
205 ~prefix:(vendor_path repo_name);
206
207 (* Commit *)
208 Git.add_all ~proc_mgr ~cwd:vendor_wt;
209 Git.commit ~proc_mgr ~cwd:vendor_wt
210 ~message:(Printf.sprintf "Update %s to %s" repo_name (String.sub new_sha 0 7));
211
212 (* Cleanup *)
213 Worktree.remove ~proc_mgr root (upstream_kind repo_name);
214 Worktree.remove ~proc_mgr root (vendor_kind repo_name);
215
216 Backend.Updated { name = repo_name; old_sha; new_sha }
217 end
218 end
219 with exn ->
220 (try Worktree.remove_force ~proc_mgr root (upstream_kind repo_name) with _ -> ());
221 (try Worktree.remove_force ~proc_mgr root (vendor_kind repo_name) with _ -> ());
222 Backend.Update_failed { name = repo_name; error = Printexc.to_string exn }
223
224let list_repos ~proc_mgr ~root =
225 Worktree.list_git_repos ~proc_mgr root
226
227let remove_repo ~proc_mgr ~root repo_name =
228 let git = Worktree.git_dir root in
229
230 (* Remove worktrees if exist *)
231 (try Worktree.remove_force ~proc_mgr root (upstream_kind repo_name) with _ -> ());
232 (try Worktree.remove_force ~proc_mgr root (vendor_kind repo_name) with _ -> ());
233 (try Worktree.remove_force ~proc_mgr root (patches_kind repo_name) with _ -> ());
234
235 (* Delete branches *)
236 (try Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; upstream_branch repo_name] |> ignore with _ -> ());
237 (try Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; vendor_branch repo_name] |> ignore with _ -> ());
238 (try Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; patches_branch repo_name] |> ignore with _ -> ());
239
240 (* Remove remote *)
241 let remote = "origin-" ^ repo_name in
242 (try Git.run_exn ~proc_mgr ~cwd:git ["remote"; "remove"; remote] |> ignore with _ -> ())