anil.recoil.org
Monorepo management for opam overlays
Add cross-user repository comparison to monopam status
Enhances `monopam status` to compare subtrees across verse members'
monorepos. For repos that exist in multiple monorepos, shows which
users have them and their relative commit states (same, ahead, behind,
or diverged).
New features:
- Parse git subtree merge commits to extract upstream commit SHAs
- Scan verse members' monorepos for their subtrees
- Compare commits using src/ checkout as authoritative history
- List repos that verse members have but I don't
Example output:
Cross-user comparison:
monopam:
me: bded6ee
jon.recoil.org e504027 (20 behind)
Not in my monorepo:
ocaml-tls gazagnaire.org
Use --no-verse flag to skip the comparison.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+170
PLAN-cross-user-status.md
+170
PLAN-cross-user-status.md
···
1
+
# Plan: Cross-User Repository Comparison in `monopam status`
2
+
3
+
**Status: IMPLEMENTED**
4
+
5
+
## Goal
6
+
7
+
Enhance `monopam status` to analyze relationships between repos across different verse users' monorepos. When the same upstream repo (e.g., `ocaml-bytesrw-eio`) exists in multiple monorepos, show:
8
+
- Which users have it
9
+
- Common ancestors/branches
10
+
- Who is ahead/behind
11
+
12
+
## Background
13
+
14
+
### Current State
15
+
- My monorepo: `~/tangled/mono/`
16
+
- My checkouts: `~/tangled/src/`
17
+
- Other users' monorepos: `~/tangled/verse/<handle>/`
18
+
- Each subtree directory maps to an upstream repo by name (e.g., `ocaml-bytesrw-eio/`)
19
+
20
+
### Challenge
21
+
Subtrees don't preserve normal git refs—they're merged/squashed into the monorepo. However:
22
+
1. Git subtree merge commits contain messages like: `Squashed 'monopam/' changes from abc123..def456`
23
+
2. `git subtree split --prefix=<dir>` reconstructs the upstream-equivalent history
24
+
3. If we have the checkout in `src/`, we can compare against that
25
+
26
+
## Proposed Approach
27
+
28
+
### Phase 1: Discovery
29
+
30
+
**1.1 Scan verse monorepos for subtrees**
31
+
- For each `verse/<handle>/`, list top-level directories
32
+
- Filter to directories that look like repos (have commits touching them)
33
+
- Build a map: `repo_name -> list of (handle, monorepo_path)`
34
+
35
+
**1.2 Detect common repos**
36
+
- Compare my `mono/` subtrees against each verse user's subtrees
37
+
- Identify repos that exist in 2+ monorepos
38
+
39
+
### Phase 2: Commit Extraction
40
+
41
+
**2.1 Parse subtree merge commits**
42
+
For each monorepo + subtree, find the last subtree-related commit:
43
+
```
44
+
git log --oneline --grep="^Squashed '$prefix/'" -1
45
+
git log --oneline --grep="^Merge commit.*into" -1 # for non-squash merges
46
+
```
47
+
48
+
Extract the upstream commit SHA from the message if present.
49
+
50
+
**2.2 Alternative: Use `git subtree split`**
51
+
```
52
+
git subtree split --prefix=<dir> -q # outputs the split commit SHA
53
+
```
54
+
55
+
This is more accurate but slower. Could be used on-demand.
56
+
57
+
**2.3 Use checkout as reference (if available)**
58
+
If `src/<repo>/` exists:
59
+
- It has the real upstream history
60
+
- Can check if verse subtree commits are ancestors/descendants
61
+
- `git merge-base --is-ancestor <commit1> <commit2>`
62
+
63
+
### Phase 3: Comparison Logic
64
+
65
+
**3.1 Build commit graph relationships**
66
+
For repos present in multiple places, determine:
67
+
1. Are they at the same commit?
68
+
2. If not, who is ahead/behind?
69
+
3. Is there a common ancestor?
70
+
71
+
**3.2 Handling divergence**
72
+
When commits have diverged (no linear relationship):
73
+
- Find merge-base
74
+
- Report "diverged: me +N commits, them +M commits from common ancestor"
75
+
76
+
### Phase 4: Status Display
77
+
78
+
**4.1 New status section**
79
+
Add a "Cross-user comparison" section to `monopam status`:
80
+
81
+
```
82
+
Cross-user comparison:
83
+
ocaml-bytesrw-eio:
84
+
me: abc1234 (2 commits ahead)
85
+
alice.bsky.social: abc1234 (same)
86
+
bob.example.com: def5678 (3 commits behind)
87
+
88
+
ocaml-jsont:
89
+
me: 111aaaa
90
+
alice.bsky.social: 222bbbb (diverged: me +2, them +1)
91
+
92
+
Not in my monorepo:
93
+
ocaml-cohttp alice.bsky.social
94
+
ocaml-tls alice.bsky.social, bob.example.com
95
+
```
96
+
97
+
**4.2 Integration with existing status**
98
+
- Add flag `--compare-verse` or make it default
99
+
- Show alongside existing package status
100
+
- Could add indicators to package lines: `[shared: 2 users]`
101
+
102
+
## Implementation Plan
103
+
104
+
### New Types (in `status.ml` or new `cross_status.ml`)
105
+
106
+
```ocaml
107
+
type subtree_commit = {
108
+
monorepo_path : string;
109
+
subtree_prefix : string;
110
+
commit_sha : string option; (* extracted from subtree merge *)
111
+
upstream_sha : string option; (* if we can determine it *)
112
+
}
113
+
114
+
type cross_comparison = {
115
+
repo_name : string;
116
+
my_commit : subtree_commit option;
117
+
others : (string * subtree_commit) list; (* handle -> commit *)
118
+
relationship : relationship;
119
+
}
120
+
121
+
type relationship =
122
+
| Same
123
+
| I_am_ahead of int
124
+
| I_am_behind of int
125
+
| Diverged of { my_ahead : int; their_ahead : int }
126
+
| Unknown
127
+
```
128
+
129
+
### New Functions
130
+
131
+
1. **`Verse.scan_subtrees : sw:Switch.t -> Eio_unix.Stdenv.base -> verse_path:string -> string list`**
132
+
- List subtree directories in a verse monorepo
133
+
134
+
2. **`Git.subtree_last_commit : sw:Switch.t -> ... -> repo:string -> prefix:string -> string option`**
135
+
- Find the last subtree merge/squash commit SHA
136
+
137
+
3. **`Git.parse_subtree_message : string -> string option`**
138
+
- Extract upstream SHA from subtree commit messages
139
+
140
+
4. **`Cross_status.compare : ... -> cross_comparison list`**
141
+
- Main entry point for cross-user comparison
142
+
143
+
5. **`Cross_status.pp : cross_comparison list Fmt.t`**
144
+
- Pretty-print the comparison
145
+
146
+
### Changes to Existing Code
147
+
148
+
1. **`bin/main.ml`**: Add `--compare-verse` flag to status command
149
+
2. **`lib/monopam.ml(i)`**: Export new cross-status functions
150
+
3. **`lib/status.ml`**: Potentially integrate cross-status into main status type
151
+
152
+
## Design Decisions
153
+
154
+
1. **Performance**: Compute on demand (no caching for now)
155
+
- Start with commit message parsing (fast)
156
+
- Fall back to `git subtree split` when needed
157
+
158
+
2. **Scope**:
159
+
- Primary: Compare repos that I have against verse users
160
+
- Secondary: List 3rd party repos (in verse but not in mine) at bottom of status
161
+
162
+
3. **Branch tracking**: Only main branches for now
163
+
164
+
## Implementation Order
165
+
166
+
1. Add git helpers for parsing subtree commits
167
+
2. Add verse helper to scan subtrees in verse monorepos
168
+
3. Create `cross_status.ml(i)` with comparison logic
169
+
4. Integrate into status command output
170
+
5. Test with real verse checkouts
+23
-2
bin/main.ml
+23
-2
bin/main.ml
···
59
59
"Checkout has N unpushed commits and is M commits behind remote" );
60
60
`I ("present", "Subtree exists in monorepo");
61
61
`I ("missing", "Subtree not yet added to monorepo");
62
+
`S "CROSS-USER COMPARISON";
63
+
`P
64
+
"When verse members are tracked, also shows how your subtrees compare \
65
+
to theirs. Use --no-verse to skip this comparison.";
62
66
]
63
67
in
64
68
let info = Cmd.info "status" ~doc ~man in
65
-
let run () =
69
+
let no_verse_arg =
70
+
let doc = "Skip cross-user comparison with verse members." in
71
+
Arg.(value & flag & info [ "no-verse" ] ~doc)
72
+
in
73
+
let run no_verse () =
66
74
Eio_main.run @@ fun env ->
67
75
with_config env @@ fun config ->
68
76
let fs = Eio.Stdenv.fs env in
···
82
90
Fmt.pr "Consider adding these packages to the opam overlay.@]@."
83
91
end
84
92
| Error _ -> ());
93
+
(* Cross-user comparison if verse config is available *)
94
+
if not no_verse then begin
95
+
match Monopam.Verse_config.load ~fs () with
96
+
| Error _ -> () (* No verse config, skip silently *)
97
+
| Ok verse_config ->
98
+
let cross_status =
99
+
Monopam.Cross_status.compute ~proc ~fs ~verse_config ~monopam_config:config ()
100
+
in
101
+
if cross_status.my_repos <> [] || cross_status.other_repos <> [] then begin
102
+
Fmt.pr "@.";
103
+
Fmt.pr "%a@." Monopam.Cross_status.pp cross_status
104
+
end
105
+
end;
85
106
`Ok ()
86
107
| Error e ->
87
108
Fmt.epr "Error: %a@." Monopam.pp_error e;
88
109
`Error (false, "status failed")
89
110
in
90
-
Cmd.v info Term.(ret (const run $ logging_term))
111
+
Cmd.v info Term.(ret (const run $ no_verse_arg $ logging_term))
91
112
92
113
(* Pull command *)
93
114
+191
lib/cross_status.ml
+191
lib/cross_status.ml
···
1
+
(** Cross-user repository comparison for monopam.
2
+
3
+
Compares subtrees across multiple verse users' monorepos to identify
4
+
common repositories and their relative commit states. *)
5
+
6
+
(** Relationship between two subtree commits. *)
7
+
type relationship =
8
+
| Same (** Commits are the same *)
9
+
| I_am_ahead of int (** My commit is ahead by N commits *)
10
+
| I_am_behind of int (** My commit is behind by N commits *)
11
+
| Diverged of { my_ahead : int; their_ahead : int }
12
+
(** Commits have diverged from a common ancestor *)
13
+
| Unknown (** Cannot determine relationship (missing commits, etc.) *)
14
+
15
+
(** Information about a subtree in a monorepo. *)
16
+
type subtree_info = {
17
+
monorepo_path : Fpath.t; (** Path to the monorepo *)
18
+
prefix : string; (** Subtree directory name *)
19
+
upstream_commit : string option; (** Last synced upstream commit SHA *)
20
+
}
21
+
22
+
(** Comparison of a repo across multiple users. *)
23
+
type repo_comparison = {
24
+
repo_name : string; (** Repository/subtree name *)
25
+
my_info : subtree_info option; (** My subtree info (None if not in my mono) *)
26
+
others : (string * subtree_info * relationship) list;
27
+
(** List of (handle, info, relationship to me) *)
28
+
}
29
+
30
+
(** Summary of all cross-user comparisons. *)
31
+
type t = {
32
+
my_repos : repo_comparison list; (** Repos I have, compared against others *)
33
+
other_repos : (string * string list) list;
34
+
(** Repos I don't have: (repo_name, list of handles who have it) *)
35
+
}
36
+
37
+
let pp_relationship ppf = function
38
+
| Same -> Fmt.string ppf "same"
39
+
| I_am_ahead n -> Fmt.pf ppf "%d behind" n (* They are behind me *)
40
+
| I_am_behind n -> Fmt.pf ppf "%d ahead" n (* They are ahead of me *)
41
+
| Diverged { my_ahead; their_ahead } ->
42
+
Fmt.pf ppf "diverged: them +%d, me +%d" their_ahead my_ahead
43
+
| Unknown -> Fmt.string ppf "unknown"
44
+
45
+
let pp_subtree_info ppf info =
46
+
match info.upstream_commit with
47
+
| Some commit -> Fmt.pf ppf "%s" (String.sub commit 0 (min 7 (String.length commit)))
48
+
| None -> Fmt.string ppf "(no commit)"
49
+
50
+
let pp_repo_comparison ppf comp =
51
+
Fmt.pf ppf "@[<v 2>%s:@," comp.repo_name;
52
+
(match comp.my_info with
53
+
| Some info -> Fmt.pf ppf "me: %a@," pp_subtree_info info
54
+
| None -> ());
55
+
List.iter
56
+
(fun (handle, info, rel) ->
57
+
Fmt.pf ppf "%-19s %a (%a)@," handle pp_subtree_info info pp_relationship rel)
58
+
comp.others;
59
+
Fmt.pf ppf "@]"
60
+
61
+
let pp ppf t =
62
+
if t.my_repos <> [] then begin
63
+
Fmt.pf ppf "@[<v>Cross-user comparison:@,";
64
+
List.iter (fun comp -> Fmt.pf ppf " %a@," pp_repo_comparison comp) t.my_repos;
65
+
Fmt.pf ppf "@]"
66
+
end;
67
+
if t.other_repos <> [] then begin
68
+
Fmt.pf ppf "@[<v>@,Not in my monorepo:@,";
69
+
List.iter
70
+
(fun (repo, handles) ->
71
+
Fmt.pf ppf " %-19s %s@," repo (String.concat ", " handles))
72
+
t.other_repos;
73
+
Fmt.pf ppf "@]"
74
+
end
75
+
76
+
(** Get subtree info for a given prefix in a monorepo. *)
77
+
let get_subtree_info ~proc ~fs ~monorepo_path ~prefix () : subtree_info =
78
+
let upstream_commit =
79
+
Git.subtree_last_upstream_commit ~proc ~fs ~repo:monorepo_path ~prefix ()
80
+
in
81
+
{ monorepo_path; prefix; upstream_commit }
82
+
83
+
(** Compare two subtree commits using a reference checkout.
84
+
If checkout is available, use it as the authoritative source.
85
+
Otherwise, just check if commits match. *)
86
+
let compare_commits ~proc ~fs ~checkout_path ~my_commit ~their_commit () =
87
+
match (my_commit, their_commit) with
88
+
| None, _ | _, None -> Unknown
89
+
| Some my, Some their when my = their -> Same
90
+
| Some my, Some their ->
91
+
(* Try to compare using checkout if available *)
92
+
if not (Git.is_repo ~proc ~fs checkout_path) then Unknown
93
+
else begin
94
+
(* Check if either is ancestor of the other *)
95
+
let my_is_ancestor =
96
+
Git.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:my ~commit2:their ()
97
+
in
98
+
let their_is_ancestor =
99
+
Git.is_ancestor ~proc ~fs ~repo:checkout_path ~commit1:their ~commit2:my ()
100
+
in
101
+
match (my_is_ancestor, their_is_ancestor) with
102
+
| true, false ->
103
+
(* My commit is ancestor of theirs -> I'm behind *)
104
+
let behind =
105
+
Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base:my ~head:their ()
106
+
in
107
+
I_am_behind behind
108
+
| false, true ->
109
+
(* Their commit is ancestor of mine -> I'm ahead *)
110
+
let ahead =
111
+
Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base:their ~head:my ()
112
+
in
113
+
I_am_ahead ahead
114
+
| true, true ->
115
+
(* Both are ancestors of each other -> same commit *)
116
+
Same
117
+
| false, false ->
118
+
(* Neither is ancestor -> diverged *)
119
+
(match Git.merge_base ~proc ~fs ~repo:checkout_path ~commit1:my ~commit2:their () with
120
+
| Error _ -> Unknown
121
+
| Ok base ->
122
+
let my_ahead =
123
+
Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base ~head:my ()
124
+
in
125
+
let their_ahead =
126
+
Git.count_commits_between ~proc ~fs ~repo:checkout_path ~base ~head:their ()
127
+
in
128
+
Diverged { my_ahead; their_ahead })
129
+
end
130
+
131
+
(** Compute cross-user status comparing my monorepo against all verse members. *)
132
+
let compute ~proc ~fs ~verse_config ~monopam_config () =
133
+
let my_mono = Verse_config.mono_path verse_config in
134
+
let checkouts = Config.Paths.checkouts monopam_config in
135
+
136
+
(* Get my subtrees *)
137
+
let my_subtrees = Verse.scan_subtrees ~proc ~fs my_mono in
138
+
139
+
(* Get verse subtrees (map: repo_name -> [(handle, monorepo_path)]) *)
140
+
let verse_subtrees = Verse.get_verse_subtrees ~proc ~fs ~config:verse_config () in
141
+
142
+
(* Build comparisons for repos I have *)
143
+
let my_repos =
144
+
List.filter_map
145
+
(fun repo_name ->
146
+
let my_info = get_subtree_info ~proc ~fs ~monorepo_path:my_mono ~prefix:repo_name () in
147
+
let checkout_path = Fpath.(checkouts / repo_name) in
148
+
149
+
(* Find others who have this repo *)
150
+
let others_with_repo =
151
+
try Hashtbl.find verse_subtrees repo_name with Not_found -> []
152
+
in
153
+
154
+
if others_with_repo = [] then
155
+
None (* No one else has this repo, skip *)
156
+
else begin
157
+
let others =
158
+
List.map
159
+
(fun (handle, their_mono) ->
160
+
let their_info =
161
+
get_subtree_info ~proc ~fs ~monorepo_path:their_mono ~prefix:repo_name ()
162
+
in
163
+
let rel =
164
+
compare_commits ~proc ~fs ~checkout_path
165
+
~my_commit:my_info.upstream_commit
166
+
~their_commit:their_info.upstream_commit ()
167
+
in
168
+
(handle, their_info, rel))
169
+
others_with_repo
170
+
in
171
+
Some { repo_name; my_info = Some my_info; others }
172
+
end)
173
+
my_subtrees
174
+
in
175
+
176
+
(* Find repos others have that I don't *)
177
+
let my_subtrees_set = Hashtbl.create 64 in
178
+
List.iter (fun s -> Hashtbl.add my_subtrees_set s ()) my_subtrees;
179
+
180
+
let other_repos =
181
+
Hashtbl.fold
182
+
(fun repo_name handles_and_paths acc ->
183
+
if Hashtbl.mem my_subtrees_set repo_name then acc
184
+
else
185
+
let handles = List.map fst handles_and_paths in
186
+
(repo_name, handles) :: acc)
187
+
verse_subtrees []
188
+
|> List.sort (fun (a, _) (b, _) -> String.compare a b)
189
+
in
190
+
191
+
{ my_repos; other_repos }
+75
lib/cross_status.mli
+75
lib/cross_status.mli
···
1
+
(** Cross-user repository comparison for monopam.
2
+
3
+
Compares subtrees across multiple verse users' monorepos to identify
4
+
common repositories and their relative commit states. *)
5
+
6
+
(** {1 Types} *)
7
+
8
+
(** Relationship between two subtree commits. *)
9
+
type relationship =
10
+
| Same (** Commits are the same *)
11
+
| I_am_ahead of int (** My commit is ahead by N commits *)
12
+
| I_am_behind of int (** My commit is behind by N commits *)
13
+
| Diverged of { my_ahead : int; their_ahead : int }
14
+
(** Commits have diverged from a common ancestor *)
15
+
| Unknown (** Cannot determine relationship (missing commits, etc.) *)
16
+
17
+
(** Information about a subtree in a monorepo. *)
18
+
type subtree_info = {
19
+
monorepo_path : Fpath.t; (** Path to the monorepo *)
20
+
prefix : string; (** Subtree directory name *)
21
+
upstream_commit : string option; (** Last synced upstream commit SHA *)
22
+
}
23
+
24
+
(** Comparison of a repo across multiple users. *)
25
+
type repo_comparison = {
26
+
repo_name : string; (** Repository/subtree name *)
27
+
my_info : subtree_info option; (** My subtree info (None if not in my mono) *)
28
+
others : (string * subtree_info * relationship) list;
29
+
(** List of (handle, info, relationship to me) *)
30
+
}
31
+
32
+
(** Summary of all cross-user comparisons. *)
33
+
type t = {
34
+
my_repos : repo_comparison list; (** Repos I have, compared against others *)
35
+
other_repos : (string * string list) list;
36
+
(** Repos I don't have: (repo_name, list of handles who have it) *)
37
+
}
38
+
39
+
(** {1 Pretty Printing} *)
40
+
41
+
val pp_relationship : relationship Fmt.t
42
+
(** [pp_relationship] formats a relationship. *)
43
+
44
+
val pp_subtree_info : subtree_info Fmt.t
45
+
(** [pp_subtree_info] formats subtree info (shows commit SHA). *)
46
+
47
+
val pp_repo_comparison : repo_comparison Fmt.t
48
+
(** [pp_repo_comparison] formats a single repo comparison. *)
49
+
50
+
val pp : t Fmt.t
51
+
(** [pp] formats the full cross-user status. *)
52
+
53
+
(** {1 Computation} *)
54
+
55
+
val compute :
56
+
proc:_ Eio.Process.mgr ->
57
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
58
+
verse_config:Verse_config.t ->
59
+
monopam_config:Config.t ->
60
+
unit ->
61
+
t
62
+
(** [compute ~proc ~fs ~verse_config ~monopam_config ()] computes cross-user
63
+
status by comparing subtrees in my monorepo against all tracked verse
64
+
members' monorepos.
65
+
66
+
For repos that exist in multiple monorepos, determines the relationship
67
+
between commits (same, ahead, behind, or diverged).
68
+
69
+
Uses the checkout in [src/] as the reference for commit comparison when
70
+
available.
71
+
72
+
@param proc Eio process manager
73
+
@param fs Eio filesystem
74
+
@param verse_config Verse workspace configuration
75
+
@param monopam_config Monopam configuration (for checkout paths) *)
+1
-1
lib/dune
+1
-1
lib/dune
···
1
1
(library
2
2
(name monopam)
3
3
(public_name monopam)
4
-
(libraries eio tomlt tomlt.eio xdge opam-file-format fmt logs uri fpath claude jsont jsont.bytesrw ptime ptime.clock.os tangled xrpc-auth))
4
+
(libraries eio tomlt tomlt.eio xdge opam-file-format fmt logs uri fpath claude jsont jsont.bytesrw ptime ptime.clock.os tangled xrpc-auth str))
+69
lib/git.ml
+69
lib/git.ml
···
256
256
match run_git_ok ~proc ~cwd args with
257
257
| Ok output -> Ok (parse_log_entries output)
258
258
| Error e -> Error e
259
+
260
+
(** Parse a subtree merge/squash commit message to extract the upstream commit range.
261
+
Messages look like: "Squashed 'prefix/' changes from abc123..def456"
262
+
or "Squashed 'prefix/' content from commit abc123"
263
+
Returns the end commit (most recent) if found. *)
264
+
let parse_subtree_message subject =
265
+
(* Pattern: Squashed 'prefix/' changes from abc123..def456 *)
266
+
let re_range = Str.regexp {|Squashed '[^']+/' changes from [a-f0-9]+\.\.\([a-f0-9]+\)|} in
267
+
(* Pattern: Squashed 'prefix/' content from commit abc123 *)
268
+
let re_single = Str.regexp {|Squashed '[^']+/' content from commit \([a-f0-9]+\)|} in
269
+
(* Pattern: Add 'prefix/' from commit abc123 *)
270
+
let re_add = Str.regexp {|Add '[^']+/' from commit \([a-f0-9]+\)|} in
271
+
if Str.string_match re_range subject 0 then
272
+
Some (Str.matched_group 1 subject)
273
+
else if Str.string_match re_single subject 0 then
274
+
Some (Str.matched_group 1 subject)
275
+
else if Str.string_match re_add subject 0 then
276
+
Some (Str.matched_group 1 subject)
277
+
else
278
+
None
279
+
280
+
(** Find the last subtree-related commit for a given prefix.
281
+
Searches git log for commits with subtree merge/squash messages. *)
282
+
let subtree_last_upstream_commit ~proc ~fs ~repo ~prefix () =
283
+
let cwd = path_to_eio ~fs repo in
284
+
(* Search for subtree-related commits - don't use path filter as it can miss merge commits *)
285
+
let grep_pattern = Printf.sprintf "^Squashed '%s/'" prefix in
286
+
match run_git_ok ~proc ~cwd
287
+
[ "log"; "--oneline"; "-1"; "--grep"; grep_pattern ] with
288
+
| Error _ -> None
289
+
| Ok "" ->
290
+
(* Try alternate pattern: Add 'prefix/' from commit *)
291
+
let add_pattern = Printf.sprintf "^Add '%s/'" prefix in
292
+
(match run_git_ok ~proc ~cwd
293
+
[ "log"; "--oneline"; "-1"; "--grep"; add_pattern ] with
294
+
| Error _ -> None
295
+
| Ok "" -> None
296
+
| Ok line ->
297
+
(* line is "abc1234 Add 'prefix/' from commit ..." *)
298
+
let hash = String.sub line 0 (min 7 (String.length line)) in
299
+
(* Get the full commit message to parse *)
300
+
match run_git_ok ~proc ~cwd [ "log"; "-1"; "--format=%s"; hash ] with
301
+
| Error _ -> None
302
+
| Ok subject -> parse_subtree_message subject)
303
+
| Ok line ->
304
+
let hash = String.sub line 0 (min 7 (String.length line)) in
305
+
match run_git_ok ~proc ~cwd [ "log"; "-1"; "--format=%s"; hash ] with
306
+
| Error _ -> None
307
+
| Ok subject -> parse_subtree_message subject
308
+
309
+
(** Check if commit1 is an ancestor of commit2. *)
310
+
let is_ancestor ~proc ~fs ~repo ~commit1 ~commit2 () =
311
+
let cwd = path_to_eio ~fs repo in
312
+
let result = run_git ~proc ~cwd
313
+
[ "merge-base"; "--is-ancestor"; commit1; commit2 ] in
314
+
result.exit_code = 0
315
+
316
+
(** Find the merge-base (common ancestor) of two commits. *)
317
+
let merge_base ~proc ~fs ~repo ~commit1 ~commit2 () =
318
+
let cwd = path_to_eio ~fs repo in
319
+
run_git_ok ~proc ~cwd [ "merge-base"; commit1; commit2 ]
320
+
321
+
(** Count commits between two commits (exclusive of base, inclusive of head). *)
322
+
let count_commits_between ~proc ~fs ~repo ~base ~head () =
323
+
let cwd = path_to_eio ~fs repo in
324
+
match run_git_ok ~proc ~cwd
325
+
[ "rev-list"; "--count"; base ^ ".." ^ head ] with
326
+
| Error _ -> 0
327
+
| Ok s -> try int_of_string (String.trim s) with _ -> 0
+64
lib/git.mli
+64
lib/git.mli
···
297
297
@param until Include commits older than this date
298
298
@param path Filter to commits affecting this path (relative to repo)
299
299
@param repo Path to the git repository *)
300
+
301
+
(** {1 Subtree Commit Analysis} *)
302
+
303
+
val parse_subtree_message : string -> string option
304
+
(** [parse_subtree_message subject] extracts the upstream commit SHA from a
305
+
subtree merge/squash commit message.
306
+
307
+
Handles messages like:
308
+
- "Squashed 'prefix/' changes from abc123..def456" -> Some "def456"
309
+
- "Squashed 'prefix/' content from commit abc123" -> Some "abc123"
310
+
- "Add 'prefix/' from commit abc123" -> Some "abc123"
311
+
312
+
Returns [None] if the message doesn't match any known pattern. *)
313
+
314
+
val subtree_last_upstream_commit :
315
+
proc:_ Eio.Process.mgr ->
316
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
317
+
repo:Fpath.t ->
318
+
prefix:string ->
319
+
unit ->
320
+
string option
321
+
(** [subtree_last_upstream_commit ~proc ~fs ~repo ~prefix ()] finds the upstream
322
+
commit SHA that the subtree was last synced from.
323
+
324
+
Searches git log for the most recent subtree merge/squash commit for the
325
+
given prefix and extracts the upstream commit reference.
326
+
327
+
@param repo Path to the monorepo
328
+
@param prefix Subtree directory name (e.g., "ocaml-bytesrw") *)
329
+
330
+
val is_ancestor :
331
+
proc:_ Eio.Process.mgr ->
332
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
333
+
repo:Fpath.t ->
334
+
commit1:string ->
335
+
commit2:string ->
336
+
unit ->
337
+
bool
338
+
(** [is_ancestor ~proc ~fs ~repo ~commit1 ~commit2 ()] returns true if commit1
339
+
is an ancestor of commit2.
340
+
341
+
Uses [git merge-base --is-ancestor]. *)
342
+
343
+
val merge_base :
344
+
proc:_ Eio.Process.mgr ->
345
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
346
+
repo:Fpath.t ->
347
+
commit1:string ->
348
+
commit2:string ->
349
+
unit ->
350
+
(string, error) result
351
+
(** [merge_base ~proc ~fs ~repo ~commit1 ~commit2 ()] finds the common ancestor
352
+
of two commits. *)
353
+
354
+
val count_commits_between :
355
+
proc:_ Eio.Process.mgr ->
356
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
357
+
repo:Fpath.t ->
358
+
base:string ->
359
+
head:string ->
360
+
unit ->
361
+
int
362
+
(** [count_commits_between ~proc ~fs ~repo ~base ~head ()] counts the number of
363
+
commits between base and head (exclusive of base, inclusive of head). *)
+1
lib/monopam.ml
+1
lib/monopam.ml
+1
lib/monopam.mli
+1
lib/monopam.mli
+39
lib/verse.ml
+39
lib/verse.ml
···
391
391
| Ok _registry ->
392
392
(* Pull all tracked members *)
393
393
pull ~proc ~fs ~config ()
394
+
395
+
(** Scan a monorepo for subtree directories.
396
+
Returns a list of directory names that look like subtrees (have commits). *)
397
+
let scan_subtrees ~proc ~fs monorepo_path =
398
+
if not (Git.is_repo ~proc ~fs monorepo_path) then []
399
+
else
400
+
let eio_path = Eio.Path.(fs / Fpath.to_string monorepo_path) in
401
+
try
402
+
Eio.Path.read_dir eio_path
403
+
|> List.filter (fun name ->
404
+
(* Skip hidden dirs and common non-subtree dirs *)
405
+
not (String.starts_with ~prefix:"." name)
406
+
&& name <> "_build"
407
+
&& name <> "node_modules"
408
+
&& is_directory ~fs Fpath.(monorepo_path / name))
409
+
with Eio.Io _ -> []
410
+
411
+
(** Get subtrees from all tracked verse members.
412
+
Returns a map from subtree name to list of (handle, monorepo_path) pairs. *)
413
+
let get_verse_subtrees ~proc ~fs ~config () =
414
+
let verse_path = Verse_config.verse_path config in
415
+
let tracked_handles = get_tracked_handles ~fs config in
416
+
(* Build map: subtree_name -> [(handle, monorepo_path)] *)
417
+
let subtree_map = Hashtbl.create 64 in
418
+
List.iter
419
+
(fun handle ->
420
+
let member_mono = Fpath.(verse_path / handle) in
421
+
if Git.is_repo ~proc ~fs member_mono then begin
422
+
let subtrees = scan_subtrees ~proc ~fs member_mono in
423
+
List.iter
424
+
(fun subtree ->
425
+
let existing =
426
+
try Hashtbl.find subtree_map subtree with Not_found -> []
427
+
in
428
+
Hashtbl.replace subtree_map subtree ((handle, member_mono) :: existing))
429
+
subtrees
430
+
end)
431
+
tracked_handles;
432
+
subtree_map
+23
lib/verse.mli
+23
lib/verse.mli
···
158
158
(** [sync ~proc ~fs ~config ()] syncs the workspace.
159
159
160
160
Updates the registry and pulls updates for all tracked members. *)
161
+
162
+
(** {1 Subtree Discovery} *)
163
+
164
+
val scan_subtrees :
165
+
proc:_ Eio.Process.mgr ->
166
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
167
+
Fpath.t ->
168
+
string list
169
+
(** [scan_subtrees ~proc ~fs monorepo_path] returns a list of directory names
170
+
that look like subtrees in the given monorepo.
171
+
172
+
Filters out hidden directories, _build, node_modules, etc. *)
173
+
174
+
val get_verse_subtrees :
175
+
proc:_ Eio.Process.mgr ->
176
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
177
+
config:Verse_config.t ->
178
+
unit ->
179
+
(string, (string * Fpath.t) list) Hashtbl.t
180
+
(** [get_verse_subtrees ~proc ~fs ~config ()] scans all tracked verse members
181
+
and returns a map from subtree name to list of (handle, monorepo_path) pairs.
182
+
183
+
This allows finding which verse users have a particular repo. *)