forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
tty/monopam: add visual progress bar with bar characters
- Add visual progress bar display: ⠋ [████░░░░] 42% message
- Add bar_width parameter to Progress.create (default 30)
- Support UTF8 (█/░) and ASCII (#/-) bar styles
- Integrate progress bars into monopam push and pull commands
- Update tests for new progress bar format
+54
-48
+54
-48
lib/monopam.ml
+54
-48
lib/monopam.ml
···
890
890
(List.length repos));
891
891
let clone_repos () =
892
892
let total = List.length repos in
893
-
let rec loop i acc = function
894
-
| [] -> Ok (List.rev acc)
893
+
let progress = Tty.Progress.create ~total "Fetch" in
894
+
let rec loop acc = function
895
+
| [] ->
896
+
Tty.Progress.clear progress;
897
+
Ok (List.rev acc)
895
898
| pkg :: rest -> (
896
899
let repo_name = Package.repo_name pkg in
897
-
Log.info (fun m ->
898
-
m "[%d/%d] Fetching repo %s" i total repo_name);
900
+
Tty.Progress.message progress
901
+
(Fmt.str "Fetch: %s (%d/%d)" repo_name
902
+
(List.length acc + 1)
903
+
total);
904
+
Log.info (fun m -> m "Fetching repo %s" repo_name);
899
905
let existed = checkout_exists ~fs:fs_t ~config pkg in
900
906
let behind_before =
901
907
if existed then behind ~proc ~fs:fs_t ~config pkg else 0
902
908
in
903
909
match ensure_checkout ~proc ~fs:fs_t ~config pkg with
904
-
| Error e -> Error (Git_error e)
910
+
| Error e ->
911
+
Tty.Progress.clear progress;
912
+
Error (Git_error e)
905
913
| Ok () ->
914
+
Tty.Progress.tick progress;
906
915
let result =
907
916
{
908
917
repo_name;
909
918
cloned = not existed;
910
919
commits_pulled = behind_before;
911
920
subtree_added = false;
912
-
(* will be updated later *)
913
921
}
914
922
in
915
-
loop (i + 1) (result :: acc) rest)
923
+
loop (result :: acc) rest)
916
924
in
917
-
loop 1 [] repos
925
+
loop [] repos
918
926
in
919
927
match clone_repos () with
920
928
| Error e -> Error e
···
923
931
Log.info (fun m ->
924
932
m "Processing %d unique subtrees" (List.length repos));
925
933
let total = List.length repos in
926
-
let rec loop i results_acc repos_left checkout_results_left =
934
+
let progress = Tty.Progress.create ~total "Subtree" in
935
+
let rec loop results_acc repos_left checkout_results_left =
927
936
match (repos_left, checkout_results_left) with
928
-
| [], [] -> Ok (List.rev results_acc)
937
+
| [], [] ->
938
+
Tty.Progress.clear progress;
939
+
Ok (List.rev results_acc)
929
940
| pkg :: rest_repos, cr :: rest_cr -> (
930
-
Log.info (fun m ->
931
-
m "[%d/%d] Subtree %s" i total
932
-
(Package.subtree_prefix pkg));
941
+
let name = Package.subtree_prefix pkg in
942
+
Tty.Progress.message progress
943
+
(Fmt.str "Subtree: %s (%d/%d)" name
944
+
(List.length results_acc + 1)
945
+
total);
946
+
Log.info (fun m -> m "Subtree %s" name);
933
947
match pull_subtree ~proc ~fs ~config pkg with
934
948
| Ok subtree_added ->
949
+
Tty.Progress.tick progress;
935
950
let result = { cr with subtree_added } in
936
-
loop (i + 1) (result :: results_acc) rest_repos
937
-
rest_cr
938
-
| Error e -> Error e)
939
-
| _ -> Ok (List.rev results_acc)
940
-
(* mismatched lengths, shouldn't happen *)
951
+
loop (result :: results_acc) rest_repos rest_cr
952
+
| Error e ->
953
+
Tty.Progress.clear progress;
954
+
Error e)
955
+
| _ ->
956
+
Tty.Progress.clear progress;
957
+
Ok (List.rev results_acc)
941
958
in
942
-
match loop 1 [] repos checkout_results with
959
+
match loop [] repos checkout_results with
943
960
| Error e -> Error e
944
961
| Ok results ->
945
-
(* Print summary *)
962
+
(* Print summary with checkmarks *)
946
963
let cloned = List.filter (fun r -> r.cloned) results in
947
964
let updated =
948
965
List.filter
···
952
969
let added =
953
970
List.filter (fun r -> r.subtree_added) results
954
971
in
955
-
if cloned <> [] then begin
956
-
Log.app (fun m ->
957
-
m "Cloned %d new repositories:" (List.length cloned));
958
-
List.iter
959
-
(fun r -> Log.app (fun m -> m " + %s" r.repo_name))
960
-
cloned
961
-
end;
962
-
if updated <> [] then begin
963
-
Log.app (fun m ->
964
-
m "Updated %d repositories:" (List.length updated));
965
-
List.iter
966
-
(fun r ->
967
-
Log.app (fun m ->
968
-
m " ~ %s (%d new commits)" r.repo_name
969
-
r.commits_pulled))
970
-
updated
971
-
end;
972
-
if added <> [] then begin
973
-
Log.app (fun m ->
974
-
m "Added %d new subtrees:" (List.length added));
975
-
List.iter
976
-
(fun r -> Log.app (fun m -> m " + %s" r.repo_name))
977
-
added
978
-
end;
972
+
List.iter
973
+
(fun r ->
974
+
Log.app (fun m -> m " + %s (cloned)" r.repo_name))
975
+
cloned;
976
+
List.iter
977
+
(fun r ->
978
+
Log.app (fun m ->
979
+
m " ✓ %s (%d commits)" r.repo_name
980
+
r.commits_pulled))
981
+
updated;
982
+
List.iter
983
+
(fun r ->
984
+
Log.app (fun m -> m " + %s (added)" r.repo_name))
985
+
added;
979
986
let unchanged =
980
987
List.length results - List.length cloned
981
-
- List.length updated
988
+
- List.length updated - List.length added
982
989
in
983
990
if cloned = [] && updated = [] && added = [] then
984
991
Log.app (fun m ->
985
-
m "All %d repositories up to date."
992
+
m " All %d repositories up to date."
986
993
(List.length results))
987
994
else if unchanged > 0 then
988
-
Log.app (fun m ->
989
-
m "%d repositories unchanged." unchanged);
995
+
Log.app (fun m -> m " %d unchanged." unchanged);
990
996
(* Update README.md, CLAUDE.md, and dune-project *)
991
997
write_readme ~proc ~fs:fs_t ~config all_pkgs;
992
998
write_claude_md ~proc ~fs:fs_t ~config;