Monorepo management for opam overlays
Add verse remote management to monopam sync
Automatically manages git remotes for verse members during sync:
- Adds verse/<handle> remotes pointing to verse member src/ checkouts
- Updates remotes if URLs change
- Removes remotes for members no longer in registry or repos we don't have
- Fetches from verse remotes after subtree sync phase
Also adds remote management functions to Git module:
- list_remotes, get_remote_url, add_remote, remove_remote
- set_remote_url, ensure_remote
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+183
+40
lib/git.ml
+40
lib/git.ml
···
208
208
| Ok url -> Some url
209
209
| Error _ -> None
210
210
211
+
let list_remotes ~proc ~fs path =
212
+
let cwd = path_to_eio ~fs path in
213
+
match run_git_ok ~proc ~cwd [ "remote" ] with
214
+
| Ok output ->
215
+
String.split_on_char '\n' output
216
+
|> List.filter (fun s -> String.trim s <> "")
217
+
| Error _ -> []
218
+
219
+
let get_remote_url ~proc ~fs ~remote path =
220
+
let cwd = path_to_eio ~fs path in
221
+
match run_git_ok ~proc ~cwd [ "remote"; "get-url"; remote ] with
222
+
| Ok url -> Some (String.trim url)
223
+
| Error _ -> None
224
+
225
+
let add_remote ~proc ~fs ~name ~url path =
226
+
let cwd = path_to_eio ~fs path in
227
+
run_git_ok ~proc ~cwd [ "remote"; "add"; name; url ]
228
+
|> Result.map ignore
229
+
230
+
let remove_remote ~proc ~fs ~name path =
231
+
let cwd = path_to_eio ~fs path in
232
+
run_git_ok ~proc ~cwd [ "remote"; "remove"; name ]
233
+
|> Result.map ignore
234
+
235
+
let set_remote_url ~proc ~fs ~name ~url path =
236
+
let cwd = path_to_eio ~fs path in
237
+
run_git_ok ~proc ~cwd [ "remote"; "set-url"; name; url ]
238
+
|> Result.map ignore
239
+
240
+
let ensure_remote ~proc ~fs ~name ~url path =
241
+
let remotes = list_remotes ~proc ~fs path in
242
+
if List.mem name remotes then begin
243
+
(* Remote exists, check if URL matches *)
244
+
match get_remote_url ~proc ~fs ~remote:name path with
245
+
| Some existing_url when existing_url = url -> Ok ()
246
+
| _ -> set_remote_url ~proc ~fs ~name ~url path
247
+
end
248
+
else
249
+
add_remote ~proc ~fs ~name ~url path
250
+
211
251
type log_entry = {
212
252
hash : string;
213
253
author : string;
+54
lib/git.mli
+54
lib/git.mli
···
272
272
273
273
@param remote Remote name (default: "origin") *)
274
274
275
+
(** {1 Remote Management} *)
276
+
277
+
val list_remotes :
278
+
proc:_ Eio.Process.mgr ->
279
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
280
+
Fpath.t ->
281
+
string list
282
+
(** [list_remotes ~proc ~fs path] returns a list of all remote names. *)
283
+
284
+
val get_remote_url :
285
+
proc:_ Eio.Process.mgr ->
286
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
287
+
remote:string ->
288
+
Fpath.t ->
289
+
string option
290
+
(** [get_remote_url ~proc ~fs ~remote path] returns the URL for a remote. *)
291
+
292
+
val add_remote :
293
+
proc:_ Eio.Process.mgr ->
294
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
295
+
name:string ->
296
+
url:string ->
297
+
Fpath.t ->
298
+
(unit, error) result
299
+
(** [add_remote ~proc ~fs ~name ~url path] adds a new remote. *)
300
+
301
+
val remove_remote :
302
+
proc:_ Eio.Process.mgr ->
303
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
304
+
name:string ->
305
+
Fpath.t ->
306
+
(unit, error) result
307
+
(** [remove_remote ~proc ~fs ~name path] removes a remote. *)
308
+
309
+
val set_remote_url :
310
+
proc:_ Eio.Process.mgr ->
311
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
312
+
name:string ->
313
+
url:string ->
314
+
Fpath.t ->
315
+
(unit, error) result
316
+
(** [set_remote_url ~proc ~fs ~name ~url path] updates the URL for an existing remote. *)
317
+
318
+
val ensure_remote :
319
+
proc:_ Eio.Process.mgr ->
320
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
321
+
name:string ->
322
+
url:string ->
323
+
Fpath.t ->
324
+
(unit, error) result
325
+
(** [ensure_remote ~proc ~fs ~name ~url path] ensures a remote exists with the given URL.
326
+
If the remote exists with a different URL, it is updated.
327
+
If the remote doesn't exist, it is added. *)
328
+
275
329
(** {1 Commit History} *)
276
330
277
331
type log_entry = {
+89
lib/monopam.ml
+89
lib/monopam.ml
···
1150
1150
Log.warn (fun m -> m "Failed to set push URL: %a" Git.pp_error e));
1151
1151
Git.push_remote ~proc ~fs ~branch checkout_dir
1152
1152
1153
+
(* Sanitize handle for use as git remote name *)
1154
+
let sanitize_remote_name handle =
1155
+
(* Replace @ and . with - for valid git remote names *)
1156
+
String.map (function
1157
+
| '@' | '.' -> '-'
1158
+
| c -> c) handle
1159
+
1160
+
(* Ensure verse remotes for a single repo *)
1161
+
let ensure_verse_remotes_for_repo ~proc ~fs ~config ~verse_subtrees pkg =
1162
+
let checkouts_root = Config.Paths.checkouts config in
1163
+
let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
1164
+
let repo_name = Package.repo_name pkg in
1165
+
1166
+
(* Only process if checkout exists *)
1167
+
if not (Git.is_repo ~proc ~fs checkout_dir) then ()
1168
+
else begin
1169
+
(* Get all verse members who have this repo *)
1170
+
let members_with_repo =
1171
+
Hashtbl.find_opt verse_subtrees repo_name
1172
+
|> Option.value ~default:[]
1173
+
in
1174
+
1175
+
(* Get current remotes *)
1176
+
let current_remotes = Git.list_remotes ~proc ~fs checkout_dir in
1177
+
let verse_remotes =
1178
+
List.filter (fun r -> String.starts_with ~prefix:"verse-" r) current_remotes
1179
+
in
1180
+
1181
+
(* Build set of expected verse remotes *)
1182
+
let expected_remotes =
1183
+
List.map (fun (handle, _) -> "verse-" ^ sanitize_remote_name handle) members_with_repo
1184
+
in
1185
+
1186
+
(* Add/update remotes for verse members *)
1187
+
List.iter (fun (handle, verse_mono_path) ->
1188
+
let remote_name = "verse-" ^ sanitize_remote_name handle in
1189
+
(* Point to their src/ checkout for this repo *)
1190
+
let verse_src = Fpath.(parent verse_mono_path / "src" / repo_name) in
1191
+
if Sys.file_exists (Fpath.to_string verse_src) then begin
1192
+
let url = Fpath.to_string verse_src in
1193
+
match Git.ensure_remote ~proc ~fs ~name:remote_name ~url checkout_dir with
1194
+
| Ok () -> Log.debug (fun m -> m "Ensured verse remote %s -> %s" remote_name url)
1195
+
| Error e -> Log.warn (fun m -> m "Failed to add verse remote %s: %a" remote_name Git.pp_error e)
1196
+
end)
1197
+
members_with_repo;
1198
+
1199
+
(* Remove outdated verse remotes *)
1200
+
List.iter (fun remote_name ->
1201
+
if not (List.mem remote_name expected_remotes) then begin
1202
+
Log.debug (fun m -> m "Removing outdated verse remote %s" remote_name);
1203
+
match Git.remove_remote ~proc ~fs ~name:remote_name checkout_dir with
1204
+
| Ok () -> ()
1205
+
| Error e -> Log.warn (fun m -> m "Failed to remove verse remote %s: %a" remote_name Git.pp_error e)
1206
+
end)
1207
+
verse_remotes
1208
+
end
1209
+
1210
+
(* Sync verse remotes for all repos *)
1211
+
let sync_verse_remotes ~proc ~fs ~config ~verse_config repos =
1212
+
Log.app (fun m -> m " Updating verse remotes...");
1213
+
let verse_subtrees = Verse.get_verse_subtrees ~proc ~fs ~config:verse_config () in
1214
+
List.iter (fun pkg ->
1215
+
ensure_verse_remotes_for_repo ~proc ~fs ~config ~verse_subtrees pkg)
1216
+
repos
1217
+
1218
+
(* Fetch from verse remotes for a repo *)
1219
+
let fetch_verse_remotes ~proc ~fs ~config pkg =
1220
+
let checkouts_root = Config.Paths.checkouts config in
1221
+
let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
1222
+
let remotes = Git.list_remotes ~proc ~fs checkout_dir in
1223
+
let verse_remotes = List.filter (fun r -> String.starts_with ~prefix:"verse-" r) remotes in
1224
+
List.iter (fun remote ->
1225
+
Log.debug (fun m -> m "Fetching from verse remote %s" remote);
1226
+
match Git.fetch ~proc ~fs ~remote checkout_dir with
1227
+
| Ok () -> ()
1228
+
| Error e -> Log.debug (fun m -> m "Failed to fetch from %s: %a" remote Git.pp_error e))
1229
+
verse_remotes
1230
+
1153
1231
let sync ~proc ~fs ~config ?package ?(remote = false) ?(skip_push = false) ?(skip_pull = false) () =
1154
1232
let fs_t = fs_typed fs in
1155
1233
(* Update the opam repo first - clone if needed *)
···
1293
1371
(fetch_errs, unchanged, commits_pulled, merge_errs, subtree_errs)
1294
1372
end
1295
1373
in
1374
+
1375
+
(* Step 5.5: Verse remotes - update and fetch from verse members *)
1376
+
(match Verse_config.load ~fs:(fs_t :> _ Eio.Path.t) () with
1377
+
| Error _ -> () (* No verse config, skip verse remotes *)
1378
+
| Ok verse_config ->
1379
+
sync_verse_remotes ~proc ~fs:fs_t ~config ~verse_config repos;
1380
+
(* Fetch from verse remotes in parallel *)
1381
+
Log.app (fun m -> m " Fetching from verse remotes...");
1382
+
Eio.Fiber.List.iter (fun pkg ->
1383
+
fetch_verse_remotes ~proc ~fs:fs_t ~config pkg)
1384
+
repos);
1296
1385
1297
1386
(* Step 6: Finalize - write README.md, CLAUDE.md, and dune-project (SEQUENTIAL) *)
1298
1387
Log.app (fun m -> m " Writing README.md, CLAUDE.md, and dune-project...");