forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
monopam: add clean command to remove empty commits
- Add Subtree.check_mono and fix_mono to detect/remove empty commits
- Add `monopam clean` command with --dry-run and --force options
- Clean removes empty commits from mono and unrelated merges from checkouts
+199
+48
bin/cmd_clean.ml
+48
bin/cmd_clean.ml
···
1
+
open Cmdliner
2
+
3
+
let cmd =
4
+
let doc = "Remove empty commits from history" in
5
+
let man =
6
+
[
7
+
`S Manpage.s_description;
8
+
`P
9
+
"Removes empty commits from the monorepo and all checkout histories. \
10
+
An empty commit is one where the tree is unchanged from its first \
11
+
parent (no actual file changes).";
12
+
`P
13
+
"This cleans up noise from subtree merge operations that created \
14
+
commits with no content changes.";
15
+
`S "WHAT IT DOES";
16
+
`I ("1.", "Scans mono/ for empty commits");
17
+
`I ("2.", "Scans each checkout in src/ for empty commits");
18
+
`I ("3.", "Rewrites history to remove empty commits");
19
+
`I ("4.", "Updates branch refs to point to cleaned history");
20
+
`S "OPTIONS";
21
+
`I ("--dry-run", "Show what would be cleaned without making changes");
22
+
`I ("--force", "Also force-push cleaned checkouts to upstream remotes");
23
+
`S Manpage.s_see_also;
24
+
`P "$(b,monopam status)(1), $(b,monopam push)(1)";
25
+
]
26
+
in
27
+
let info = Cmd.info "clean" ~doc ~man in
28
+
let dry_run_arg =
29
+
let doc = "Show what would be cleaned without making changes." in
30
+
Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
31
+
in
32
+
let force_arg =
33
+
let doc = "Force-push cleaned checkouts to upstream remotes." in
34
+
Arg.(value & flag & info [ "force"; "f" ] ~doc)
35
+
in
36
+
let run dry_run force () =
37
+
Eio_main.run @@ fun env ->
38
+
Common.with_config env @@ fun config ->
39
+
let fs = Eio.Stdenv.fs env in
40
+
let proc = Eio.Stdenv.process_mgr env in
41
+
match Monopam.clean ~proc ~fs ~config ~dry_run ~force () with
42
+
| Ok () -> `Ok ()
43
+
| Error e ->
44
+
Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
45
+
`Error (false, "clean failed")
46
+
in
47
+
Cmd.v info
48
+
Term.(ret (const run $ dry_run_arg $ force_arg $ Common.logging_term))
+1
bin/main.ml
+1
bin/main.ml
+128
lib/monopam.ml
+128
lib/monopam.ml
···
1224
1224
push_repo "mono" mono;
1225
1225
push_repo "opam-repo" opam_repo
1226
1226
1227
+
(* Clean empty commits from mono and all checkouts *)
1228
+
let clean ~proc ~fs ~config ~dry_run ~force () =
1229
+
let fs_t = fs_typed fs in
1230
+
let mono = Config.Paths.monorepo config in
1231
+
let checkouts = Config.Paths.checkouts config in
1232
+
1233
+
(* Clean mono using fix_mono (removes all empty commits) *)
1234
+
let clean_mono () =
1235
+
if not (Git.Repository.is_repo ~fs:fs_t mono) then None
1236
+
else begin
1237
+
let repo = Git.Repository.open_repo ~fs:fs_t mono in
1238
+
match Git.Repository.head repo with
1239
+
| None -> None
1240
+
| Some head ->
1241
+
let checked, issues = Git.Subtree.check_mono repo ~head () in
1242
+
if issues = [] then None
1243
+
else begin
1244
+
Log.app (fun m ->
1245
+
m "mono: %d empty commits (of %d checked)" (List.length issues)
1246
+
checked);
1247
+
if dry_run then Some (List.length issues)
1248
+
else begin
1249
+
match Git.Subtree.fix_mono repo ~head () with
1250
+
| Error (`Msg msg) ->
1251
+
Log.warn (fun m -> m " Failed to clean mono: %s" msg);
1252
+
None
1253
+
| Ok None ->
1254
+
Log.warn (fun m -> m " mono: history became empty");
1255
+
None
1256
+
| Ok (Some new_head) ->
1257
+
(match Git.Repository.current_branch repo with
1258
+
| Some branch ->
1259
+
Git.Repository.write_ref repo ("refs/heads/" ^ branch)
1260
+
new_head
1261
+
| None -> Git.Repository.write_ref repo "HEAD" new_head);
1262
+
Log.app (fun m -> m " ✓ mono cleaned");
1263
+
Some (List.length issues)
1264
+
end
1265
+
end
1266
+
end
1267
+
in
1268
+
1269
+
(* Clean checkout using Subtree.fix (removes unrelated subtree merges) *)
1270
+
let clean_checkout name =
1271
+
let path = Fpath.(checkouts / name) in
1272
+
if not (Git.Repository.is_repo ~fs:fs_t path) then None
1273
+
else begin
1274
+
let repo = Git.Repository.open_repo ~fs:fs_t path in
1275
+
match Git.Repository.head repo with
1276
+
| None -> None
1277
+
| Some head ->
1278
+
let checked, issues = Git.Subtree.check repo ~prefix:name ~head () in
1279
+
if issues = [] then None
1280
+
else begin
1281
+
Log.app (fun m ->
1282
+
m "%s: %d unrelated merges (of %d checked)" name
1283
+
(List.length issues) checked);
1284
+
if dry_run then Some (List.length issues)
1285
+
else begin
1286
+
match Git.Subtree.fix repo ~prefix:name ~head () with
1287
+
| Error (`Msg msg) ->
1288
+
Log.warn (fun m -> m " Failed to clean %s: %s" name msg);
1289
+
None
1290
+
| Ok None ->
1291
+
Log.warn (fun m -> m " %s: history became empty" name);
1292
+
None
1293
+
| Ok (Some new_head) ->
1294
+
(match Git.Repository.current_branch repo with
1295
+
| Some branch ->
1296
+
Git.Repository.write_ref repo ("refs/heads/" ^ branch)
1297
+
new_head
1298
+
| None -> Git.Repository.write_ref repo "HEAD" new_head);
1299
+
Log.app (fun m -> m " ✓ %s cleaned" name);
1300
+
Some (List.length issues)
1301
+
end
1302
+
end
1303
+
end
1304
+
in
1305
+
1306
+
(* Clean mono first *)
1307
+
let mono_cleaned = clean_mono () in
1308
+
1309
+
(* Clean all checkouts *)
1310
+
let checkouts_path = Eio.Path.(fs_t / Fpath.to_string checkouts) in
1311
+
let checkout_results =
1312
+
try Eio.Path.read_dir checkouts_path |> List.filter_map clean_checkout
1313
+
with Eio.Io _ -> []
1314
+
in
1315
+
1316
+
let total_cleaned =
1317
+
Option.value ~default:0 mono_cleaned
1318
+
+ List.fold_left ( + ) 0 checkout_results
1319
+
in
1320
+
1321
+
if total_cleaned = 0 then begin
1322
+
Log.app (fun m -> m "No empty commits found");
1323
+
Ok ()
1324
+
end
1325
+
else if dry_run then begin
1326
+
Log.app (fun m ->
1327
+
m "Would remove %d commits (use without --dry-run to apply)"
1328
+
total_cleaned);
1329
+
Ok ()
1330
+
end
1331
+
else begin
1332
+
Log.app (fun m -> m "Removed %d commits" total_cleaned);
1333
+
(* Optionally force-push to upstream *)
1334
+
if force then begin
1335
+
Log.app (fun m -> m "Force-pushing cleaned histories to upstream...");
1336
+
(try
1337
+
Eio.Path.read_dir checkouts_path
1338
+
|> List.iter (fun name ->
1339
+
let path = Fpath.(checkouts / name) in
1340
+
if Git.Repository.is_repo ~fs:fs_t path then
1341
+
match
1342
+
Git_cli.push_remote ~proc
1343
+
~fs:(fs_t :> _ Eio.Path.t)
1344
+
~force:true path
1345
+
with
1346
+
| Ok () -> Log.app (fun m -> m " ✓ %s" name)
1347
+
| Error e ->
1348
+
Log.app (fun m -> m " ✗ %s: %a" name Git_cli.pp_error e))
1349
+
with Eio.Io _ -> ());
1350
+
Ok ()
1351
+
end
1352
+
else Ok ()
1353
+
end
1354
+
1227
1355
(* Thin wrappers to extracted modules *)
1228
1356
let pp_opam_sync_result = Opam_sync.pp
1229
1357
+22
lib/monopam.mli
+22
lib/monopam.mli
···
142
142
@param clean If true, clean history by removing unrelated merge commits
143
143
@param force If true, force push to upstream (use with --clean) *)
144
144
145
+
(** {2 Clean} *)
146
+
147
+
val clean :
148
+
proc:_ Eio.Process.mgr ->
149
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
150
+
config:Config.t ->
151
+
dry_run:bool ->
152
+
force:bool ->
153
+
unit ->
154
+
(unit, error) result
155
+
(** [clean ~proc ~fs ~config ~dry_run ~force ()] removes empty commits from the
156
+
monorepo and all checkout histories.
157
+
158
+
An empty commit is one where the tree is unchanged from its first parent (no
159
+
actual file changes). These typically result from subtree merge operations.
160
+
161
+
@param proc Eio process manager
162
+
@param fs Eio filesystem
163
+
@param config Monopam configuration
164
+
@param dry_run If true, only report what would be cleaned without changes
165
+
@param force If true, force-push cleaned checkouts to upstream remotes *)
166
+
145
167
(** {2 Opam Metadata Sync} *)
146
168
147
169
type opam_sync_result = Opam_sync.t