gazagnaire.org / monopam
forked from anil.recoil.org/monopam
Monorepo management for opam overlays
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

monopam: accurate push wrap-up message

Before: when [monopam push] had no subtrees to push but workspace
repos still got pushed, the output contradicted itself --

Nothing to push (all repos in sync)
✓ opam-repo
✓ Changes pushed to your remotes. (3.6s)

"Nothing to push" came from the lib's [run_after_sync], "✓ opam-repo"
came from [workspace_repos] (which still ran), and "Changes pushed"
came from [cmd_push.ml]'s unconditional success message.

Restructure to track what actually got pushed and let the caller
print one accurate summary line.

- New type [Push.outcome = { subtrees : int; workspace : int }]
reporting how many of each kind of repo were pushed (Everything-up-
to-date counts as 0).
- [Push.run] returns [(outcome, error) result] instead of
[(unit, error) result].
- [workspace_repos] returns [(pushed_count * errors)] so the count
threads up. The "Everything up-to-date" branch demoted from
[Log.app] (visible "✓ already synced") to [Log.debug] -- when
nothing changed there's nothing to show.
- [run_after_sync] returns
[Ok { subtrees = 0; workspace = ws }] when subtrees are in sync,
and [Ok { subtrees = N; workspace = ws }] after [export_and_push].
The "Nothing to push (all repos in sync)" Log.app is gone -- the
caller now prints the wrap-up.
- [cmd_push.ml]'s [success_message] picks one of three forms based
on the outcome:
- total = 0: "All repos already in sync."
- local-only with subtree push: "Exported N subtree(s) to checkouts."
- upstream push: "Pushed N subtrees + M workspace repos
to your remotes."

[cmd_publish.ml]'s call to [Push.run] now ignores the outcome
explicitly via [Ok _outcome].

Thomas Gazagnaire f19fae70 bf50800b

+59 -21
+1 -1
bin/cmd_publish.ml
··· 40 40 Monopam.Push.run ~sw ~clock ~proc ~fs ~config ~packages 41 41 ~upstream:false ~clean:false ~force:false () 42 42 with 43 - | Ok () -> Fmt.pr "Checkouts updated.@." 43 + | Ok _outcome -> Fmt.pr "Checkouts updated.@." 44 44 | Error e -> 45 45 Fmt.epr "Warning: checkout export failed: %a@." 46 46 Monopam.Ctx.pp_error_with_hint e)
+23 -6
bin/cmd_push.ml
··· 89 89 in 90 90 Arg.(value & flag & info [ "force" ] ~doc) 91 91 92 - let success_message ~local_only = 93 - if local_only then 94 - ("Changes exported to checkouts.", "monopam push # to send to your remotes") 95 - else ("Changes pushed to your remotes.", "monopam status") 92 + let success_message ~local_only ~(outcome : Monopam.Push.outcome) = 93 + let total = outcome.subtrees + outcome.workspace in 94 + if total = 0 then ("All repos already in sync.", "monopam status") 95 + else if local_only then 96 + ( Fmt.str "Exported %d subtree%s to checkouts." outcome.subtrees 97 + (if outcome.subtrees = 1 then "" else "s"), 98 + "monopam push # to send to your remotes" ) 99 + else 100 + let parts = 101 + [ 102 + ( outcome.subtrees, 103 + if outcome.subtrees = 1 then "subtree" else "subtrees" ); 104 + ( outcome.workspace, 105 + if outcome.workspace = 1 then "workspace repo" else "workspace repos" 106 + ); 107 + ] 108 + |> List.filter (fun (n, _) -> n > 0) 109 + |> List.map (fun (n, label) -> Fmt.str "%d %s" n label) 110 + in 111 + ( Fmt.str "Pushed %s to your remotes." (String.concat " + " parts), 112 + "monopam status" ) 96 113 97 114 let run_push ~sw ~clock ~proc ~fs ~config ~packages ~local_only ~clean ~force 98 115 ~t0 = ··· 101 118 ~upstream:(not local_only) ~clean ~force () 102 119 with 103 120 | Error e -> Common.fail_ctx e 104 - | Ok () -> 121 + | Ok outcome -> 105 122 let elapsed = Unix.gettimeofday () -. t0 in 106 - let msg, next = success_message ~local_only in 123 + let msg, next = success_message ~local_only ~outcome in 107 124 Common.print_success ~elapsed ~next_step:next msg; 108 125 `Ok () 109 126
+25 -12
lib/push.ml
··· 110 110 | Skipped (** Nothing to push (up-to-date or not in monorepo) *) 111 111 | Clone_failed of string (** Remote repo doesn't exist or is unreachable *) 112 112 113 + (* See {!Push.outcome} in the mli for the contract. *) 114 + type outcome = { subtrees : int; workspace : int } 115 + 113 116 (** Merge a monorepo's split subtree into a checkout that's a full clone of the 114 117 source monorepo, at the configured [path]. This is the push-side of the 115 118 [--path] feature: the split produced at [prefix] in the local monorepo ··· 325 328 let workspace_repos ~sw ~proc ~fs ~config ~force ~push_mono = 326 329 let knot = Config.knot config in 327 330 let errors = ref [] in 331 + let pushed = ref 0 in 328 332 let push_repo ~commit name path = 329 333 if Git.Repository.is_repo ~fs path then begin 330 334 let repo = Git.Repository.open_repo ~sw ~fs path in ··· 349 353 match 350 354 Git_cli.push_remote ~proc ~fs:(fs :> _ Eio.Path.t) ~force path 351 355 with 352 - | Ok () -> Log.app (fun m -> m " ✓ %s" name) 356 + | Ok () -> 357 + incr pushed; 358 + Log.app (fun m -> m " ✓ %s" name) 353 359 | Error (Git_cli.Command_failed (_, result)) 354 360 when String.starts_with ~prefix:"Everything up-to-date" 355 361 result.Git_cli.stderr -> 356 - Log.app (fun m -> m " ✓ %s (already synced)" name) 362 + Log.debug (fun m -> m "%s already synced, skipping" name) 357 363 | Error e -> 358 364 Log.app (fun m -> m " ✗ %s: %a" name Git_cli.pp_error e); 359 365 errors := (name, e) :: !errors) ··· 363 369 let opam_repo = Config.Paths.opam_repo config in 364 370 if push_mono then push_repo ~commit:false "mono" mono; 365 371 push_repo ~commit:true "opam-repo" opam_repo; 366 - !errors 372 + (!pushed, !errors) 367 373 368 374 (** {1 Main Push Operation} *) 369 375 ··· 749 755 else local_results ~config pushed_repos 750 756 751 757 let workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream = 752 - let ws_errors = 758 + let ws_pushed, ws_errors = 753 759 if upstream then 754 760 workspace_repos ~sw ~proc ~fs:fs_t ~config ~force ~push_mono 755 - else [] 761 + else (0, []) 756 762 in 757 - if ws_errors = [] then Ok () 763 + if ws_errors = [] then Ok ws_pushed 758 764 else 759 765 let _name, e = List.hd ws_errors in 760 766 Error (Ctx.Git_error e) ··· 793 799 log_missing_repos ~all_pkgs missing; 794 800 match log_results results with 795 801 | Error e -> Error e 796 - | Ok () -> 797 - workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream) 802 + | Ok () -> ( 803 + match 804 + workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream 805 + with 806 + | Error e -> Error e 807 + | Ok ws -> Ok { subtrees = List.length pushed_repos; workspace = ws }) 808 + ) 798 809 799 810 let load_sources ~fs ~config = 800 811 let sources_path = Fpath.(Config.Paths.monorepo config / "sources.toml") in ··· 835 846 let to_push = repos_to_push statuses pkgs in 836 847 Log.info (fun m -> m "Pushing %d unique repos" (List.length to_push)); 837 848 let push_mono = packages = [] in 838 - if to_push = [] then begin 839 - Log.app (fun m -> m "Nothing to push (all repos in sync)"); 840 - workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream 841 - end 849 + if to_push = [] then 850 + match 851 + workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream 852 + with 853 + | Error e -> Error e 854 + | Ok ws -> Ok { subtrees = 0; workspace = ws } 842 855 else 843 856 export_and_push ~sw ~clock ~proc ~fs ~fs_t ~config ~sources ~upstream 844 857 ~push_mono ~clean ~force ~all_pkgs:pkgs to_push
+10 -2
lib/push.mli
··· 1 1 (** Push operations for exporting monorepo changes to checkouts and upstream. *) 2 2 3 + type outcome = { subtrees : int; workspace : int } 4 + (** What [run] actually pushed. [subtrees] is the number of package subtree 5 + repos that received a push (each one gets [✓ <name>] in the live output); 6 + [workspace] is the same for non-package workspace repos like [opam-repo]. 7 + [subtrees + workspace = 0] means "everything was already in sync". *) 8 + 3 9 val run : 4 10 sw:Eio.Switch.t -> 5 11 clock:_ Eio.Time.clock -> ··· 11 17 ?clean:bool -> 12 18 ?force:bool -> 13 19 unit -> 14 - (unit, Ctx.error) result 20 + (outcome, Ctx.error) result 15 21 (** [run ~sw ~clock ~proc ~fs ~config ()] exports changes via subtree split and 16 - pushes to local checkouts and optionally to remote upstreams. *) 22 + pushes to local checkouts and optionally to remote upstreams. The returned 23 + {!outcome} reports how many repos were actually pushed so the caller can 24 + print an accurate wrap-up. *)