Monorepo management for opam overlays
Handle trees-differ-but-count-unknown case in status
When monorepo subtree and checkout trees differ but the commit count
can't be determined (e.g., changes made directly in monorepo), show
"local:sync" instead of "local:-0".
Added Trees_differ variant to subtree_sync type for this case.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+35
-26
+33
-26
lib/status.ml
+33
-26
lib/status.ml
···
11
11
| In_sync (** Subtree matches checkout HEAD *)
12
12
| Subtree_behind of int (** Subtree needs pull from checkout (checkout has new commits) *)
13
13
| Subtree_ahead of int (** Subtree has commits not in checkout (need push to checkout) *)
14
+
| Trees_differ (** Trees differ but can't determine direction/count *)
14
15
| Unknown (** Can't determine (subtree not added or checkout missing) *)
15
16
16
17
type t = {
···
77
78
(* Checkout has commits not in subtree - need subtree pull *)
78
79
let count = Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir
79
80
~base:subtree_sha ~head:checkout_sha () in
80
-
Subtree_behind count
81
+
if count > 0 then Subtree_behind count
82
+
else Trees_differ (* Same commit but trees differ - monorepo has changes *)
81
83
else if Git.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir
82
84
~commit1:checkout_sha ~commit2:subtree_sha () then
83
85
(* Subtree has content not in checkout - need push *)
84
86
let count = Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir
85
87
~base:checkout_sha ~head:subtree_sha () in
86
-
Subtree_ahead count
88
+
if count > 0 then Subtree_ahead count
89
+
else Trees_differ
87
90
else
88
-
Unknown
89
-
| _ -> Unknown)
91
+
Trees_differ (* Diverged *)
92
+
| _ -> Trees_differ) (* Trees differ but can't determine ancestry *)
90
93
| _ -> Unknown
91
94
in
92
95
{ package = pkg; checkout; subtree; subtree_sync }
···
105
108
(** Needs local sync: monorepo subtree out of sync with checkout *)
106
109
let needs_local_sync t =
107
110
match t.subtree_sync with
108
-
| Subtree_behind _ | Subtree_ahead _ -> true
111
+
| Subtree_behind _ | Subtree_ahead _ | Trees_differ -> true
109
112
| In_sync | Unknown -> false
110
113
111
114
(** Needs remote action: checkout ahead/behind of upstream *)
···
149
152
(** Compact status for actionable items with colors *)
150
153
let pp_compact ppf t =
151
154
let name = Package.name t.package in
152
-
(* First check for local sync issues (monorepo <-> checkout) *)
153
-
let local_sync_info =
154
-
match t.subtree_sync with
155
-
| Subtree_behind n -> Some (Fmt.(styled `Blue (fun ppf n -> pf ppf "local:-%d" n)), n)
156
-
| Subtree_ahead n -> Some (Fmt.(styled `Blue (fun ppf n -> pf ppf "local:+%d" n)), n)
157
-
| In_sync | Unknown -> None
155
+
(* Helper to print remote sync info *)
156
+
let pp_remote ab =
157
+
if ab.Git.ahead > 0 && ab.behind > 0 then
158
+
Fmt.pf ppf " %a" Fmt.(styled `Yellow (fun ppf (a, b) -> pf ppf "remote:+%d/-%d" a b)) (ab.ahead, ab.behind)
159
+
else if ab.ahead > 0 then
160
+
Fmt.pf ppf " %a" Fmt.(styled `Cyan (fun ppf n -> pf ppf "remote:+%d" n)) ab.ahead
161
+
else if ab.behind > 0 then
162
+
Fmt.pf ppf " %a" Fmt.(styled `Red (fun ppf n -> pf ppf "remote:-%d" n)) ab.behind
158
163
in
159
-
(* Then check for remote sync issues (checkout <-> upstream) *)
160
-
match (t.checkout, t.subtree, local_sync_info) with
161
-
(* Local sync issues take precedence when present *)
162
-
| Clean ab, Present, Some (fmt, n) when ab.ahead > 0 || ab.behind > 0 ->
163
-
(* Both local and remote sync needed *)
164
-
Fmt.pf ppf "%-22s %a %a" name fmt n
165
-
Fmt.(styled `Yellow (fun ppf (a, b) -> pf ppf "remote:+%d/-%d" a b)) (ab.ahead, ab.behind)
166
-
| Clean _, Present, Some (fmt, n) ->
167
-
(* Only local sync needed *)
168
-
Fmt.pf ppf "%-22s %a" name fmt n
169
-
(* Remote sync issues *)
170
-
| Clean ab, Present, None when ab.ahead > 0 && ab.behind > 0 ->
164
+
match (t.checkout, t.subtree, t.subtree_sync) with
165
+
(* Local sync issues with count *)
166
+
| Clean ab, Present, Subtree_behind n ->
167
+
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Blue (fun ppf n -> pf ppf "local:-%d" n)) n;
168
+
pp_remote ab
169
+
| Clean ab, Present, Subtree_ahead n ->
170
+
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Blue (fun ppf n -> pf ppf "local:+%d" n)) n;
171
+
pp_remote ab
172
+
(* Trees differ but can't determine count *)
173
+
| Clean ab, Present, Trees_differ ->
174
+
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Blue string) "local:sync";
175
+
pp_remote ab
176
+
(* Remote sync issues only *)
177
+
| Clean ab, Present, (In_sync | Unknown) when ab.ahead > 0 && ab.behind > 0 ->
171
178
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Yellow (fun ppf (a,b) -> pf ppf "remote:+%d/-%d" a b)) (ab.ahead, ab.behind)
172
-
| Clean ab, Present, None when ab.ahead > 0 ->
179
+
| Clean ab, Present, (In_sync | Unknown) when ab.ahead > 0 ->
173
180
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Cyan (fun ppf n -> pf ppf "remote:+%d" n)) ab.ahead
174
-
| Clean ab, Present, None when ab.behind > 0 ->
181
+
| Clean ab, Present, (In_sync | Unknown) when ab.behind > 0 ->
175
182
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Red (fun ppf n -> pf ppf "remote:-%d" n)) ab.behind
176
183
(* Other issues *)
177
184
| Clean _, Not_added, _ ->
···
182
189
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Red string) "(not a repo)"
183
190
| Dirty, _, _ ->
184
191
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Yellow string) "(dirty)"
185
-
| Clean _, Present, None ->
192
+
| Clean _, Present, (In_sync | Unknown) ->
186
193
Fmt.pf ppf "%-22s %a" name Fmt.(styled `Green string) "ok"
187
194
188
195
let pp_summary ppf statuses =
+2
lib/status.mli
+2
lib/status.mli
···
27
27
(** Subtree needs pull from checkout (checkout has n new commits) *)
28
28
| Subtree_ahead of int
29
29
(** Subtree has n commits not in checkout (need push to checkout) *)
30
+
| Trees_differ
31
+
(** Trees differ but can't determine direction/count (needs sync) *)
30
32
| Unknown (** Can't determine (subtree not added or checkout missing) *)
31
33
32
34
type t = {