Monorepo management for opam overlays
monopam: animate progress bars via tty-eio
Threads `clock` through push/pull/opam_sync so each progress bar can be
driven by `Tty_eio.Progress.animate`, which redraws on a dedicated Eio
fiber. The bars no longer rely on tick-time redraws hidden inside the
worker loop.
+56
-33
+5
-4
bin/cmd_publish.ml
+5
-4
bin/cmd_publish.ml
···
4
4
Eio_main.run @@ fun env ->
5
5
let fs = Eio.Stdenv.fs env in
6
6
let proc = Eio.Stdenv.process_mgr env in
7
+
let clock = Eio.Stdenv.clock env in
7
8
Eio.Switch.run @@ fun sw ->
8
9
let source = Fpath.v (Sys.getcwd ()) in
9
10
let config_opt = Result.to_option (Common.load_config env) in
···
20
21
if dry_run then
21
22
Fmt.pr "Dry run: publishing from %a to %a@." Fpath.pp source Fpath.pp target;
22
23
match
23
-
Monopam.Opam_sync.run_from_cwd ~sw ~fs ~proc ~source ~target ~packages
24
-
~no_commit ~dry_run ()
24
+
Monopam.Opam_sync.run_from_cwd ~sw ~clock ~fs ~proc ~source ~target
25
+
~packages ~no_commit ~dry_run ()
25
26
with
26
27
| Error (`Config_error e) ->
27
28
let hint =
···
36
37
| Some config when (not no_checkouts) && not dry_run -> (
37
38
Fmt.pr "@.Exporting to checkouts...@.";
38
39
match
39
-
Monopam.Push.run ~sw ~proc ~fs ~config ~packages ~upstream:false
40
-
~clean:false ~force:false ()
40
+
Monopam.Push.run ~sw ~clock ~proc ~fs ~config ~packages
41
+
~upstream:false ~clean:false ~force:false ()
41
42
with
42
43
| Ok () -> Fmt.pr "Checkouts updated.@."
43
44
| Error e ->
+3
-3
bin/cmd_pull.ml
+3
-3
bin/cmd_pull.ml
···
79
79
Common.with_config env @@ fun config ->
80
80
let fs = Eio.Stdenv.fs env in
81
81
let proc = Eio.Stdenv.process_mgr env in
82
+
let clock = Eio.Stdenv.clock env in
82
83
Eio.Switch.run @@ fun sw ->
83
84
let auto_opts =
84
85
if not auto then None
···
90
91
| `Theirs -> Monopam.Auto_resolve.theirs_client
91
92
| `Union -> Monopam.Auto_resolve.union_client
92
93
| `Claude ->
93
-
Monopam.Auto_resolve.claude_client ~sw ~process_mgr:proc
94
-
~clock:(Eio.Stdenv.clock env)
94
+
Monopam.Auto_resolve.claude_client ~sw ~process_mgr:proc ~clock
95
95
in
96
96
let always_accept =
97
97
match strategy with
···
119
119
Some Monopam.Pull.{ client; confirm }
120
120
in
121
121
match
122
-
Monopam.Pull.run ~sw ~proc ~fs ~config ~packages ?auto:auto_opts ()
122
+
Monopam.Pull.run ~sw ~clock ~proc ~fs ~config ~packages ?auto:auto_opts ()
123
123
with
124
124
| Ok () ->
125
125
let elapsed = Unix.gettimeofday () -. t0 in
+3
-2
bin/cmd_push.ml
+3
-2
bin/cmd_push.ml
···
95
95
Common.with_config env @@ fun config ->
96
96
let fs = Eio.Stdenv.fs env in
97
97
let proc = Eio.Stdenv.process_mgr env in
98
+
let clock = Eio.Stdenv.clock env in
98
99
Eio.Switch.run @@ fun sw ->
99
100
match
100
-
Monopam.Push.run ~sw ~proc ~fs ~config ~packages ~upstream:(not local_only)
101
-
~clean ~force ()
101
+
Monopam.Push.run ~sw ~clock ~proc ~fs ~config ~packages
102
+
~upstream:(not local_only) ~clean ~force ()
102
103
with
103
104
| Ok () ->
104
105
let elapsed = Unix.gettimeofday () -. t0 in
+1
dune-project
+1
dune-project
+11
-7
lib/opam_sync.ml
+11
-7
lib/opam_sync.ml
···
147
147
(fun p -> List.exists (fun n -> Pkg.matches_name n p) names)
148
148
all_pkgs
149
149
150
-
let sync_packages_with_progress ~sw ~fs ~opam_repo ~label pkgs =
150
+
let sync_packages_with_progress ~sw ~clock ~fs ~opam_repo ~label pkgs =
151
151
let total = List.length pkgs in
152
152
let progress = Tty.Progress.v ~color:(`Hex (0x19, 0x96, 0xf3)) ~total label in
153
+
Tty_eio.Progress.animate ~sw ~clock progress;
153
154
let sync_results =
154
155
List.map
155
156
(fun pkg ->
···
204
205
not_in_repo = List.rev !not_in_repo;
205
206
}
206
207
207
-
let run ~sw ~fs ~config ?(packages = []) () =
208
+
let run ~sw ~clock ~fs ~config ?(packages = []) () =
208
209
let monorepo = Config.Paths.monorepo config in
209
210
let sources = load_sources ~fs ~dir:monorepo in
210
211
match Pkg.discover ~fs ~config ~sources () with
···
214
215
let opam_repo = Config.Paths.opam_repo config in
215
216
ensure_repo_file ~sw ~fs opam_repo;
216
217
let sync_results =
217
-
sync_packages_with_progress ~sw ~fs ~opam_repo ~label:"syncing opam"
218
-
pkgs
218
+
sync_packages_with_progress ~sw ~clock ~fs ~opam_repo
219
+
~label:"syncing opam" pkgs
219
220
in
220
221
let synced, unchanged =
221
222
List.fold_left
···
430
431
end
431
432
else []
432
433
433
-
let export_packages ~sw ~fs ~target ~packages ~dry_run ~no_commit pkgs =
434
+
let export_packages ~sw ~clock ~fs ~target ~packages ~dry_run ~no_commit pkgs =
434
435
if not dry_run then ensure_repo_file ~sw ~fs target;
435
436
let total = List.length pkgs in
436
437
let progress =
437
438
Tty.Progress.v ~color:(`Hex (0x06, 0xae, 0xed)) ~total "exporting opam"
438
439
in
440
+
Tty_eio.Progress.animate ~sw ~clock progress;
439
441
let sync_results =
440
442
List.map
441
443
(fun pkg ->
···
462
464
commit_if_needed ~sw ~fs ~target ~no_commit ~dry_run result;
463
465
Ok result
464
466
465
-
let run_from_cwd ~sw ~fs ~proc:_ ~source ~target ?(packages = [])
467
+
let run_from_cwd ~sw ~clock ~fs ~proc:_ ~source ~target ?(packages = [])
466
468
?(no_commit = false) ?(dry_run = false) () =
467
469
match discover_from_cwd ~fs ~source with
468
470
| Error e -> Error e
···
472
474
Log.info (fun m -> m "No packages found to export");
473
475
Ok { synced = []; unchanged = []; missing = []; orphaned = [] }
474
476
end
475
-
else export_packages ~sw ~fs ~target ~packages ~dry_run ~no_commit pkgs
477
+
else
478
+
export_packages ~sw ~clock ~fs ~target ~packages ~dry_run ~no_commit
479
+
pkgs
+5
-3
lib/opam_sync.mli
+5
-3
lib/opam_sync.mli
···
22
22
23
23
val run :
24
24
sw:Eio.Switch.t ->
25
+
clock:_ Eio.Time.clock ->
25
26
fs:Eio.Fs.dir_ty Eio.Path.t ->
26
27
config:Config.t ->
27
28
?packages:string list ->
28
29
unit ->
29
30
(t, [> `Config_error of string ]) result
30
-
(** [run ~sw ~fs ~config ?packages ()] syncs opam files from monorepo subtrees
31
-
to the local opam-repo. If [packages] is specified, only syncs those
32
-
packages. *)
31
+
(** [run ~sw ~clock ~fs ~config ?packages ()] syncs opam files from monorepo
32
+
subtrees to the local opam-repo. If [packages] is specified, only syncs
33
+
those packages. *)
33
34
34
35
val run_from_cwd :
35
36
sw:Eio.Switch.t ->
37
+
clock:_ Eio.Time.clock ->
36
38
fs:Eio.Fs.dir_ty Eio.Path.t ->
37
39
proc:_ Eio.Process.mgr ->
38
40
source:Fpath.t ->
+11
-5
lib/pull.ml
+11
-5
lib/pull.ml
···
208
208
let repo = Git.Repository.open_repo ~sw ~fs checkout_dir in
209
209
Git.Repository.head repo
210
210
211
-
let clone_repos ~sw ~proc ~fs ~config repos =
211
+
let clone_repos ~sw ~clock ~proc ~fs ~config repos =
212
212
let total = List.length repos in
213
213
let progress =
214
214
Tty.Progress.v ~color:(`Hex (0x3d, 0xea, 0xd5)) ~total "Fetch"
215
215
in
216
+
Tty_eio.Progress.animate ~sw ~clock progress;
216
217
let rec loop acc = function
217
218
| [] ->
218
219
Tty.Progress.clear progress;
···
253
254
in
254
255
loop [] repos
255
256
256
-
let process_subtrees ~sw ~proc ~fs ~config ?sources repos checkout_results =
257
+
let process_subtrees ~sw ~clock ~proc ~fs ~config ?sources repos
258
+
checkout_results =
257
259
let total = List.length repos in
258
260
let progress =
259
261
Tty.Progress.v ~color:(`Hex (0x52, 0xf5, 0xcb)) ~total "Subtree"
260
262
in
263
+
Tty_eio.Progress.animate ~sw ~clock progress;
261
264
let rec loop results_acc repos_left checkout_results_left =
262
265
match (repos_left, checkout_results_left) with
263
266
| [], [] ->
···
573
576
| Ok s -> Some s
574
577
| Error _ -> None
575
578
576
-
let run ~sw ~proc ~fs ~config ?(packages = []) ?opam_repo_url ?auto () =
579
+
let run ~sw ~clock ~proc ~fs ~config ?(packages = []) ?opam_repo_url ?auto () =
577
580
let ( let* ) = Result.bind in
578
581
let fs_t = Ctx.fs_typed fs in
579
582
let opam_repo = Config.Paths.opam_repo config in
···
598
601
let repos = Ctx.unique_repos pkgs in
599
602
Log.info (fun m ->
600
603
m "Cloning/fetching %d unique repositories" (List.length repos));
601
-
let* checkout_results = clone_repos ~sw ~proc ~fs:fs_t ~config repos in
604
+
let* checkout_results =
605
+
clone_repos ~sw ~clock ~proc ~fs:fs_t ~config repos
606
+
in
602
607
Log.info (fun m -> m "Processing %d unique subtrees" (List.length repos));
603
608
let* results =
604
-
process_subtrees ~sw ~proc ~fs ~config ?sources repos checkout_results
609
+
process_subtrees ~sw ~clock ~proc ~fs ~config ?sources repos
610
+
checkout_results
605
611
in
606
612
log_pull_results results;
607
613
let unresolved =
+4
-3
lib/pull.mli
+4
-3
lib/pull.mli
···
37
37
38
38
val run :
39
39
sw:Eio.Switch.t ->
40
+
clock:_ Eio.Time.clock ->
40
41
proc:_ Eio.Process.mgr ->
41
42
fs:Eio.Fs.dir_ty Eio.Path.t ->
42
43
config:Config.t ->
···
45
46
?auto:auto_options ->
46
47
unit ->
47
48
(unit, Ctx.error) Stdlib.result
48
-
(** [run ~sw ~proc ~fs ~config ()] fetches checkouts and merges subtrees. When
49
-
[auto] is supplied, conflicts are run through the AI resolver instead of
50
-
immediately exiting with [Pull_conflict]. *)
49
+
(** [run ~sw ~clock ~proc ~fs ~config ()] fetches checkouts and merges subtrees.
50
+
When [auto] is supplied, conflicts are run through the AI resolver instead
51
+
of immediately exiting with [Pull_conflict]. *)
+8
-6
lib/push.ml
+8
-6
lib/push.ml
···
716
716
missing
717
717
end
718
718
719
-
let export_and_push ~sw ~proc ~fs ~fs_t ~config ~sources ~upstream ~push_mono
720
-
~clean ~force ~all_pkgs repos =
719
+
let export_and_push ~sw ~clock ~proc ~fs ~fs_t ~config ~sources ~upstream
720
+
~push_mono ~clean ~force ~all_pkgs repos =
721
721
(* Update README and llms.txt before push *)
722
722
Init.write_readme ~proc ~fs:fs_t ~config all_pkgs;
723
723
Init.write_llms_txt ~proc ~fs:fs_t ~config all_pkgs;
···
740
740
~color:(`Hex (0x10, 0xc6, 0xe6))
741
741
~total "splitting"
742
742
in
743
+
Tty_eio.Progress.animate ~sw ~clock b;
743
744
split_progress := Some b;
744
745
b
745
746
in
···
755
756
let progress =
756
757
Tty.Progress.v ~color:(`Hex (0x27, 0xda, 0xde)) ~total "exporting"
757
758
in
759
+
Tty_eio.Progress.animate ~sw ~clock progress;
758
760
match
759
761
export_repos ~sw ~proc ~fs ~config ~sources ~clean ~force ~progress repos
760
762
with
···
798
800
| Ok s -> Some s
799
801
| Error _ -> None
800
802
801
-
let run ~sw ~proc ~fs ~config ?(packages = []) ?(upstream = false)
803
+
let run ~sw ~clock ~proc ~fs ~config ?(packages = []) ?(upstream = false)
802
804
?(clean = false) ?(force = false) () =
803
805
let fs_t = Ctx.fs_typed fs in
804
806
Ctx.ensure_checkouts_dir ~fs:fs_t ~config;
···
827
829
checkouts because merging into one would destroy real work. *)
828
830
begin
829
831
(* Sync opam files to opam-repo before pushing *)
830
-
(match Opam_sync.run ~sw ~fs:fs_t ~config ~packages () with
832
+
(match Opam_sync.run ~sw ~clock ~fs:fs_t ~config ~packages () with
831
833
| Ok r ->
832
834
if r.Opam_sync.synced <> [] then
833
835
Log.info (fun m ->
···
861
863
else Ok ()
862
864
end
863
865
else
864
-
export_and_push ~sw ~proc ~fs ~fs_t ~config ~sources ~upstream
865
-
~push_mono ~clean ~force ~all_pkgs:pkgs to_push
866
+
export_and_push ~sw ~clock ~proc ~fs ~fs_t ~config ~sources
867
+
~upstream ~push_mono ~clean ~force ~all_pkgs:pkgs to_push
866
868
end
867
869
end
+1
lib/push.mli
+1
lib/push.mli
+1
monopam.opam
+1
monopam.opam
+1
test/test_pull.ml
+1
test/test_pull.ml