Monorepo management for opam overlays
monopam: add --path for partial views of an upstream monorepo
Enable "one global library monorepo + many local product monorepos"
and "two developers sharing a subset of one upstream mono" workflows
by letting monopam add materialize just a subdirectory of a larger
source repo as a local subtree.
monopam add file://upstream.git --path eio
imports only the eio/ subtree of upstream.git into the local mono.
sources.toml gains a per-entry path field that records the split
location, so pull and push know which subdirectory to round-trip.
Implementation:
- Sources_registry.entry gets a new path: string option. TOML codec
reads/writes the field; legacy sources.toml without it loads with
path = None.
- Import.git_url, with a path argument, fetches the upstream full,
calls Git.Subtree.split at the path to get a standalone history,
then Git.Subtree.add that split at the local subtree name. Default
local name becomes the path basename.
- Push.one branches on the entry's path field. For path entries it
calls merge_split_into_path, which splits the local mono,
push_refspecs the split into the checkout (a full clone of the
source), Git.Subtree.merge-s at the path, then lets the existing
to_upstream step push the checkout back to the source. After the
merge it uses Git.Repository.checkout + add_all to sync the
worktree and index.
- Pull.subtree likewise branches on path: fetch the checkout,
Git.Subtree.split at the path, merge into the local mono at the
local prefix.
- Both sites look up sources.toml entries by package name OR repo
name. Previously the lookup used Package.subtree_prefix, which for
path entries is the source repo name ("global"), not the local
subtree name ("eio").
Side fix: Tty.Span.pp used to always emit ANSI even with NO_COLOR
set. vlog already runs Fmt_cli.style_renderer and
Fmt_tty.setup_std_outputs to honor --color; this patch adds a
--no-color cmdliner flag backed by a NO_COLOR Cmd.Env.info to vlog
and forces the style renderer to None when set. Span.render now
consults Fmt.style_renderer on the target formatter instead of a
separate global toggle — single source of truth for colour across
the tree.
Tests:
- monopam/test/subtree_path.t exercises the full path round-trip:
add --path eio, add --path cohttp, edit eio locally, push, verify
global.git received only the eio change, pull a third-party edit,
verify the local mono gets it with cohttp untouched.
+627
-100
+20
-8
bin/cmd_add.ml
+20
-8
bin/cmd_add.ml
···
5
5
package name to be resolved against the local overlay or [opam show]. *)
6
6
type parsed = Parsed of Monopam.Import.source | Opam_name of string
7
7
8
-
let parse_source source =
8
+
let parse_source ~path source =
9
9
if String.ends_with ~suffix:".lock" source then
10
10
Parsed (Monopam.Import.Lock_file (Fpath.v source))
11
11
else
···
20
20
in
21
21
if Monopam.Import.looks_like_url source then
22
22
let url, ref_ = split_at_hash source in
23
-
Parsed (Monopam.Import.Git_url { url; branch = None; ref_ })
23
+
Parsed (Monopam.Import.Git_url { url; branch = None; ref_; path })
24
24
else
25
25
(* Plain opam package name. Defer resolution to the main runner
26
26
where we have access to [fs] and a process manager. *)
···
36
36
| Ok config -> Some (Monopam.Config.Paths.opam_repo config)
37
37
| Error _ -> None
38
38
39
-
let resolve_if_name env proc fs source =
40
-
match parse_source source with
39
+
let resolve_if_name ~path env proc fs source =
40
+
match parse_source ~path source with
41
41
| Parsed s -> Ok s
42
42
| Opam_name name -> (
43
43
let opam_repo = local_opam_repo env in
···
45
45
match Monopam.Import.resolve_name ~proc ~fs ?opam_repo name with
46
46
| Ok url ->
47
47
Fmt.pr "[add] resolved %s to %s@." name url;
48
-
Ok (Monopam.Import.Git_url { url; branch = None; ref_ = None })
48
+
Ok (Monopam.Import.Git_url { url; branch = None; ref_ = None; path })
49
49
| Error msg -> Error msg)
50
50
51
-
let run source dir dry_run () =
51
+
let run source dir path dry_run () =
52
52
let t0 = Unix.gettimeofday () in
53
53
Eio_main.run @@ fun env ->
54
54
let fs = Eio.Stdenv.fs env in
55
55
let proc = Eio.Stdenv.process_mgr env in
56
56
let target = Fpath.v (Sys.getcwd ()) in
57
57
Eio.Switch.run @@ fun sw ->
58
-
match resolve_if_name env proc fs source with
58
+
match resolve_if_name ~path env proc fs source with
59
59
| Error msg ->
60
60
let hint =
61
61
"Pass a git URL (e.g. https://github.com/owner/repo.git) or install \
···
146
146
let doc = "Show what would be added without making changes." in
147
147
Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
148
148
in
149
+
let path_arg =
150
+
let doc =
151
+
"Treat SOURCE as a monorepo and materialize only the PATH subdirectory \
152
+
as a local subtree. Use this when one upstream monorepo hosts many \
153
+
libraries and you want only a subset. For example, $(b,monopam add \
154
+
git+file:///srv/global.git --path eio) imports only eio/ from \
155
+
global.git."
156
+
in
157
+
Arg.(value & opt (some string) None & info [ "path" ] ~docv:"PATH" ~doc)
158
+
in
149
159
Cmd.v info
150
160
Term.(
151
-
ret (const run $ source_arg $ dir_arg $ dry_run_arg $ Common.logging_term))
161
+
ret
162
+
(const run $ source_arg $ dir_arg $ path_arg $ dry_run_arg
163
+
$ Common.logging_term))
+1
bin/cmd_verse.ml
+1
bin/cmd_verse.ml
+1
bin/common.ml
+1
bin/common.ml
···
7
7
- [-v] / [-vv] / [-vvv]: increase verbosity
8
8
- [--log=SPEC]: RUST_LOG-style configuration (e.g., debug,http:warning)
9
9
- [--trace FILE]: write protocol traces to file
10
+
- [--color=WHEN] / [NO_COLOR]: ANSI colour control (handled by vlog)
10
11
11
12
Note: --json and --log-tag are disabled since monopam doesn't use JSON logs.
12
13
*)
+3
-2
lib/deps.ml
+3
-2
lib/deps.ml
···
22
22
let url = entry.source in
23
23
let branch = entry.branch in
24
24
let ref_ = entry.ref_ in
25
+
let path = entry.path in
25
26
Log.app (fun m -> m "[init] subtree %s: importing from %s" name url);
26
27
match
27
-
Import.git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ~name:(Some name)
28
-
~dry_run
28
+
Import.git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ?path
29
+
~name:(Some name) ~dry_run ()
29
30
with
30
31
| Ok _result -> Ok ()
31
32
| Error e ->
+4
lib/fork_join.ml
+4
lib/fork_join.ml
···
477
477
origin = Some Fork;
478
478
mono = false;
479
479
ref_ = None;
480
+
path = None;
480
481
};
481
482
};
482
483
]
···
597
598
origin = Some Join;
598
599
mono = false;
599
600
ref_ = None;
601
+
path = None;
600
602
};
601
603
};
602
604
]
···
936
938
origin = Some Fork;
937
939
mono = false;
938
940
ref_ = None;
941
+
path = None;
939
942
}
940
943
in
941
944
let sources = Sources_registry.add sources ~subtree:name entry in
···
1046
1049
origin = Some Join;
1047
1050
mono = false;
1048
1051
ref_ = None;
1052
+
path = None;
1049
1053
}
1050
1054
in
1051
1055
let sources = Sources_registry.add sources ~subtree:name entry in
+96
-28
lib/import.ml
+96
-28
lib/import.ml
···
20
20
(** {1 Types} *)
21
21
22
22
type source =
23
-
| Git_url of { url : string; branch : string option; ref_ : string option }
23
+
| Git_url of {
24
+
url : string;
25
+
branch : string option;
26
+
ref_ : string option;
27
+
path : string option;
28
+
}
24
29
| Lock_file of Fpath.t
25
30
26
31
type result = {
···
174
179
175
180
(** {1 Import Operations} *)
176
181
177
-
(** Import a single git URL as a subtree *)
178
-
let git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run =
179
-
let name = match name with Some n -> n | None -> repo_name_from_url url in
182
+
(** Derive the local subtree name when [?name] is not explicitly given.
183
+
184
+
- Without [path]: the basename of the URL ("eio" from "…/eio.git").
185
+
- With [path]: the basename of [path] ("eio" from "eio" or "libs/eio"), so
186
+
that a whole-repo import and a path import of the same subtree land at the
187
+
same local name. *)
188
+
let default_subtree_name ~url ~path =
189
+
match path with
190
+
| Some p ->
191
+
let p =
192
+
if String.length p > 0 && p.[String.length p - 1] = '/' then
193
+
String.sub p 0 (String.length p - 1)
194
+
else p
195
+
in
196
+
Filename.basename p
197
+
| None -> repo_name_from_url url
198
+
199
+
(** If the import is [--path]-based, split the fetched upstream commit at [path]
200
+
to get just that subtree's history. Returns the subtree head to feed into
201
+
[Git.Subtree.add]. [None] means the path doesn't exist in the upstream. *)
202
+
let split_at_path git_repo ~prefix ~head =
203
+
match Git.Subtree.split git_repo ~prefix ~head () with
204
+
| Error (`Msg msg) -> Error msg
205
+
| Ok None ->
206
+
Error (Fmt.str "No history at path %S in the source repository" prefix)
207
+
| Ok (Some split_head) -> Ok split_head
208
+
209
+
(** Import a single git URL as a subtree.
210
+
211
+
When [?path] is given, [url] points at a monorepo and we want only its
212
+
[path] subdirectory: fetch the full upstream, split at [path] to get a
213
+
standalone history, then add that history as a new subtree at [name] in the
214
+
local monorepo. *)
215
+
let git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ?path ~name ~dry_run () =
216
+
let name =
217
+
match name with Some n -> n | None -> default_subtree_name ~url ~path
218
+
in
180
219
let url = normalize_url url in
181
220
let prefix_path = Fpath.(target / name) in
182
221
(* Check if subtree already exists *)
···
188
227
| None -> Option.value ~default:"HEAD" branch
189
228
in
190
229
if dry_run then begin
191
-
Log.app (fun m ->
192
-
m "Would import %s from %s (ref: %s)" name url ref_to_use);
230
+
(match path with
231
+
| Some p ->
232
+
Log.app (fun m ->
233
+
m "Would import %s from %s (ref: %s, path: %s)" name url
234
+
ref_to_use p)
235
+
| None ->
236
+
Log.app (fun m ->
237
+
m "Would import %s from %s (ref: %s)" name url ref_to_use));
193
238
Ok { name; commit = "<dry-run>"; added = true }
194
239
end
195
240
else begin
···
201
246
| Error e -> err_git_fetch_failed e
202
247
| Ok hash_hex -> (
203
248
let git_repo = Git.Repository.open_repo ~sw ~fs target in
204
-
let commit = Git.Hash.of_hex hash_hex in
205
-
let user = git_user ~fs () in
206
-
let message =
207
-
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" name fetch_url
208
-
name
249
+
let fetched = Git.Hash.of_hex hash_hex in
250
+
(* When --path was used, reduce the fetched commit to just that
251
+
subtree's history via [Git.Subtree.split]. The resulting
252
+
[commit] is then treated exactly like a plain whole-repo
253
+
import: added at [name] in the local monorepo. *)
254
+
let commit_result =
255
+
match path with
256
+
| None -> Ok fetched
257
+
| Some p -> split_at_path git_repo ~prefix:p ~head:fetched
209
258
in
210
-
match
211
-
Git.Subtree.add git_repo ~prefix:name ~commit ~author:user
212
-
~committer:user ~message ()
213
-
with
214
-
| Ok new_head -> (
215
-
(* Checkout only the new subtree prefix to avoid touching other files *)
259
+
match commit_result with
260
+
| Error msg -> Error msg
261
+
| Ok commit -> (
262
+
let user = git_user ~fs () in
263
+
let message =
264
+
match path with
265
+
| None ->
266
+
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" name
267
+
fetch_url name
268
+
| Some p ->
269
+
Fmt.str
270
+
"Add '%s' from %s (path: %s)\n\ngit-subtree-dir: %s\n"
271
+
name fetch_url p name
272
+
in
216
273
match
217
-
Git.Repository.checkout_prefix git_repo new_head ~prefix:name
274
+
Git.Subtree.add git_repo ~prefix:name ~commit ~author:user
275
+
~committer:user ~message ()
218
276
with
219
-
| Ok () ->
220
-
Log.app (fun m ->
221
-
m "Imported %s at %s" name (String.sub hash_hex 0 7));
222
-
Ok { name; commit = hash_hex; added = true }
223
-
| Error (`Msg msg) -> err_checkout_failed msg)
224
-
| Error (`Msg msg) -> Error msg)
277
+
| Ok new_head -> (
278
+
(* Checkout only the new subtree prefix to avoid
279
+
touching other files. *)
280
+
match
281
+
Git.Repository.checkout_prefix git_repo new_head
282
+
~prefix:name
283
+
with
284
+
| Ok () ->
285
+
let short = String.sub hash_hex 0 7 in
286
+
Log.app (fun m -> m "Imported %s at %s" name short);
287
+
Ok { name; commit = Git.Hash.to_hex commit; added = true }
288
+
| Error (`Msg msg) -> err_checkout_failed msg)
289
+
| Error (`Msg msg) -> Error msg))
225
290
end
226
291
end
227
292
···
243
308
let result =
244
309
git_url ~sw ~proc ~fs ~target ~url:entry.Mono_lock.url
245
310
~branch:None ~ref_:(Some entry.Mono_lock.ref_)
246
-
~name:(Some name) ~dry_run
311
+
~name:(Some name) ~dry_run ()
247
312
in
248
313
(name, result))
249
314
imports
···
357
422
(** Main import function *)
358
423
let run ~sw ~proc ~fs ~target ~source ~name ~dry_run () =
359
424
match source with
360
-
| Git_url { url; branch; ref_ } -> (
361
-
match git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run with
425
+
| Git_url { url; branch; ref_; path } -> (
426
+
match
427
+
git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ?path ~name ~dry_run ()
428
+
with
362
429
| Error e -> Error e
363
430
| Ok result ->
364
-
(* Update sources.toml with source and pinned ref *)
431
+
(* Update sources.toml with source, pinned ref, and path if any. *)
365
432
if not dry_run then begin
366
433
let sources_path = Fpath.(target / "sources.toml") in
367
434
let sources =
···
379
446
origin = None;
380
447
mono = false;
381
448
ref_ = Some result.commit;
449
+
path;
382
450
}
383
451
in
384
452
let sources =
+16
-4
lib/import.mli
+16
-4
lib/import.mli
···
6
6
(** {1 Types} *)
7
7
8
8
type source =
9
-
| Git_url of { url : string; branch : string option; ref_ : string option }
9
+
| Git_url of {
10
+
url : string;
11
+
branch : string option;
12
+
ref_ : string option;
13
+
path : string option;
14
+
(** If [Some p], [url] is treated as a monorepo and only the
15
+
subdirectory [p] is materialized as a local subtree. See
16
+
{!Sources_registry.entry.path}. *)
17
+
}
10
18
| Lock_file of Fpath.t
11
19
12
20
type result = {
···
74
82
url:string ->
75
83
branch:string option ->
76
84
ref_:string option ->
85
+
?path:string ->
77
86
name:string option ->
78
87
dry_run:bool ->
88
+
unit ->
79
89
(result, string) Stdlib.result
80
-
(** [git_url ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run] imports a
81
-
single git URL as a subtree into [target]. Returns error if the subtree
82
-
directory already exists. *)
90
+
(** [git_url ~proc ~fs ~target ~url ~branch ~ref_ ?path ~name ~dry_run ()]
91
+
imports a single git URL as a subtree into [target]. When [path] is given,
92
+
[url] is treated as a monorepo and the subtree at [path] is extracted via
93
+
{!Git.Subtree.split} before being merged at [name]. Returns error if the
94
+
subtree directory already exists. *)
83
95
84
96
val update_root_deps : fs:Eio.Fs.dir_ty Eio.Path.t -> target:Fpath.t -> unit
85
97
(** [update_root_deps ~fs ~target] scans all subtree directories for .opam
+100
-24
lib/pull.ml
+100
-24
lib/pull.ml
···
47
47
(String.lowercase_ascii verb)
48
48
prefix msg))))
49
49
50
-
let subtree ~sw ~proc ~fs ~config pkg =
50
+
(** Look up the sources.toml entry for a package. See the identical helper in
51
+
[push.ml] for the rationale — sources.toml is keyed by the local subtree
52
+
name, which is not always [Package.repo_name] for [--path] imports. *)
53
+
let lookup_entry ~sources pkg =
54
+
match sources with
55
+
| None -> (None, Package.subtree_prefix pkg)
56
+
| Some s -> (
57
+
let try_key k =
58
+
Option.map
59
+
(fun entry -> (Some entry, k))
60
+
(Sources_registry.find s ~subtree:k)
61
+
in
62
+
match try_key (Package.name pkg) with
63
+
| Some r -> r
64
+
| None -> (
65
+
match try_key (Package.subtree_prefix pkg) with
66
+
| Some r -> r
67
+
| None -> (None, Package.subtree_prefix pkg)))
68
+
69
+
let subtree ~sw ~proc ~fs ~config ?sources pkg =
51
70
let fs = Ctx.fs_typed fs in
52
71
let monorepo = Config.Paths.monorepo config in
53
72
let checkouts_root = Config.Paths.checkouts config in
54
-
let prefix = Package.subtree_prefix pkg in
73
+
let entry, prefix = lookup_entry ~sources pkg in
55
74
let branch = Ctx.branch ~config pkg in
56
75
let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
57
76
let url = Fpath.to_string checkout_dir in
58
77
let subtree_exists = Ctx.is_directory ~fs Fpath.(monorepo / prefix) in
59
-
match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with
60
-
| Error e -> Error (Ctx.Git_error e)
61
-
| Ok hash_hex ->
62
-
let git_repo = Git.Repository.open_repo ~sw ~fs monorepo in
63
-
let commit = Git.Hash.of_hex hash_hex in
64
-
let user =
65
-
match Git_cli.global_git_user ~fs () with
66
-
| Some u -> u
67
-
| None ->
68
-
Git.User.v ~name:"monopam" ~email:"monopam@localhost"
69
-
~date:(Int64.of_float (Unix.time ()))
70
-
()
71
-
in
72
-
Log.info (fun m ->
73
-
m "%s subtree %s from %a"
74
-
(if subtree_exists then "Pulling" else "Adding")
75
-
prefix Fpath.pp checkout_dir);
76
-
subtree_merge_or_add ~git_repo ~prefix ~commit ~user ~url ~hash_hex
77
-
~subtree_exists
78
+
let path_override =
79
+
Option.bind entry (fun (e : Sources_registry.entry) -> e.path)
80
+
in
81
+
match path_override with
82
+
| Some path -> (
83
+
(* Fetch the checkout (which is a clone of the source monorepo)
84
+
by ref name so its objects are visible from the monorepo
85
+
repo, then split that ref at [path] to get the subtree
86
+
history and merge it in at [prefix]. *)
87
+
let checkout_repo = Git.Repository.open_repo ~sw ~fs checkout_dir in
88
+
let checkout_head = Git.Repository.head checkout_repo in
89
+
match checkout_head with
90
+
| None ->
91
+
Error
92
+
(Ctx.Git_error
93
+
(Git_cli.Io_error "checkout has no HEAD, cannot pull"))
94
+
| Some head -> (
95
+
(* Fetch the checkout into the monorepo's object db so
96
+
the split result's parents are reachable. *)
97
+
match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with
98
+
| Error e -> Error (Ctx.Git_error e)
99
+
| Ok _ -> (
100
+
let git_repo = Git.Repository.open_repo ~sw ~fs monorepo in
101
+
match Git.Subtree.split git_repo ~prefix:path ~head () with
102
+
| Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg))
103
+
| Ok None ->
104
+
Error (Ctx.Git_error (Git_cli.Subtree_prefix_missing path))
105
+
| Ok (Some split_hash) ->
106
+
let user =
107
+
match Git_cli.global_git_user ~fs () with
108
+
| Some u -> u
109
+
| None ->
110
+
Git.User.v ~name:"monopam" ~email:"monopam@localhost"
111
+
~date:(Int64.of_float (Unix.time ()))
112
+
()
113
+
in
114
+
Log.info (fun m ->
115
+
m "%s subtree %s from %a (path=%s)"
116
+
(if subtree_exists then "Pulling" else "Adding")
117
+
prefix Fpath.pp checkout_dir path);
118
+
subtree_merge_or_add ~git_repo ~prefix ~commit:split_hash
119
+
~user ~url
120
+
~hash_hex:(Git.Hash.to_hex split_hash)
121
+
~subtree_exists)))
122
+
| None -> (
123
+
match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with
124
+
| Error e -> Error (Ctx.Git_error e)
125
+
| Ok hash_hex ->
126
+
let git_repo = Git.Repository.open_repo ~sw ~fs monorepo in
127
+
let commit = Git.Hash.of_hex hash_hex in
128
+
let user =
129
+
match Git_cli.global_git_user ~fs () with
130
+
| Some u -> u
131
+
| None ->
132
+
Git.User.v ~name:"monopam" ~email:"monopam@localhost"
133
+
~date:(Int64.of_float (Unix.time ()))
134
+
()
135
+
in
136
+
Log.info (fun m ->
137
+
m "%s subtree %s from %a"
138
+
(if subtree_exists then "Pulling" else "Adding")
139
+
prefix Fpath.pp checkout_dir);
140
+
subtree_merge_or_add ~git_repo ~prefix ~commit ~user ~url ~hash_hex
141
+
~subtree_exists)
78
142
79
143
(** {1 Main Pull Operation} *)
80
144
···
169
233
in
170
234
loop [] repos
171
235
172
-
let process_subtrees ~sw ~proc ~fs ~config repos checkout_results =
236
+
let process_subtrees ~sw ~proc ~fs ~config ?sources repos checkout_results =
173
237
let total = List.length repos in
174
238
let progress = Tty.Progress.v ~total "Subtree" in
175
239
let rec loop results_acc repos_left checkout_results_left =
···
184
248
(List.length results_acc + 1)
185
249
total);
186
250
Log.info (fun m -> m "Subtree %s" name);
187
-
match subtree ~sw ~proc ~fs ~config pkg with
251
+
match subtree ~sw ~proc ~fs ~config ?sources pkg with
188
252
| Ok subtree_added ->
189
253
Tty.Progress.tick progress;
190
254
let result = { cr with subtree_added } in
···
362
426
else begin
363
427
(* Pull mono inner subtrees first (depth-first) *)
364
428
mono_entries ~sw ~proc ~fs ~config;
429
+
(* Load sources.toml so [subtree] can honor per-entry [path]
430
+
overrides. For legacy workspaces without sources.toml the
431
+
load returns an empty registry; the path field is always
432
+
[None] in that case, which matches today's whole-repo
433
+
behaviour. *)
434
+
let sources =
435
+
let monorepo = Config.Paths.monorepo config in
436
+
let sources_path = Fpath.(monorepo / "sources.toml") in
437
+
match Sources_registry.load ~fs:(fs_t :> _ Eio.Path.t) sources_path with
438
+
| Ok s -> Some s
439
+
| Error _ -> None
440
+
in
365
441
let repos = Ctx.unique_repos pkgs in
366
442
Log.info (fun m ->
367
443
m "Cloning/fetching %d unique repositories" (List.length repos));
368
444
let* checkout_results = clone_repos ~sw ~proc ~fs:fs_t ~config repos in
369
445
Log.info (fun m -> m "Processing %d unique subtrees" (List.length repos));
370
446
let* results =
371
-
process_subtrees ~sw ~proc ~fs ~config repos checkout_results
447
+
process_subtrees ~sw ~proc ~fs ~config ?sources repos checkout_results
372
448
in
373
449
log_pull_results results;
374
450
Init.write_readme ~proc ~fs:fs_t ~config all_pkgs;
+6
-2
lib/pull.mli
+6
-2
lib/pull.mli
···
13
13
proc:_ Eio.Process.mgr ->
14
14
fs:Eio.Fs.dir_ty Eio.Path.t ->
15
15
config:Config.t ->
16
+
?sources:Sources_registry.t ->
16
17
Package.t ->
17
18
(bool, Ctx.error) Stdlib.result
18
-
(** [subtree ~sw ~proc ~fs ~config pkg] merges or adds the subtree for [pkg].
19
-
Returns [true] if the subtree was newly added. *)
19
+
(** [subtree ~sw ~proc ~fs ~config ?sources pkg] merges or adds the subtree for
20
+
[pkg]. Returns [true] if the subtree was newly added. When [sources] carries
21
+
a [path] override for this subtree, the checkout is treated as a clone of an
22
+
upstream monorepo and the split at that path is merged instead of the whole
23
+
checkout. *)
20
24
21
25
val run :
22
26
sw:Eio.Switch.t ->
+155
-24
lib/push.ml
+155
-24
lib/push.ml
···
111
111
| Skipped (** Nothing to push (up-to-date or not in monorepo) *)
112
112
| Clone_failed of string (** Remote repo doesn't exist or is unreachable *)
113
113
114
+
(** Merge a monorepo's split subtree into a checkout that's a full clone of the
115
+
source monorepo, at the configured [path]. This is the push-side of the
116
+
[--path] feature: the split produced at [prefix] in the local monorepo
117
+
becomes a new commit in the source at [path].
118
+
119
+
The caller must have already ensured that [checkout_dir] is a fresh clone of
120
+
the source URL with [origin] set up. *)
121
+
let merge_split_into_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir
122
+
~prefix ~path ~branch =
123
+
let ( let* ) r f =
124
+
Result.bind (Result.map_error (fun e -> Ctx.Git_error e) r) f
125
+
in
126
+
match Git.Repository.read_ref git_repo "HEAD" with
127
+
| None -> Error (Ctx.Git_error (Git_cli.Io_error "no HEAD ref found"))
128
+
| Some head -> (
129
+
match Git.Subtree.split git_repo ~prefix ~head () with
130
+
| Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg))
131
+
| Ok None -> Error (Ctx.Git_error (Git_cli.Subtree_prefix_missing prefix))
132
+
| Ok (Some split_hash) -> (
133
+
(* Publish the split commit from the monorepo to the checkout
134
+
so the checkout's git objects include it. We push it to a
135
+
disposable ref (refs/monopam/path-push) — it's only used
136
+
transiently to feed [Subtree.merge] below. *)
137
+
let refspec =
138
+
Git.Hash.to_hex split_hash ^ ":refs/monopam/path-push"
139
+
in
140
+
let checkout_url = Fpath.to_string checkout_dir in
141
+
let* () =
142
+
Git_cli.push_refspec ~proc ~fs ~repo:monorepo ~url:checkout_url
143
+
~refspec ~force:true ()
144
+
in
145
+
(* In the checkout, merge the split at [path]. *)
146
+
let checkout_repo = Git.Repository.open_repo ~sw ~fs checkout_dir in
147
+
let user =
148
+
match Git_cli.global_git_user ~fs () with
149
+
| Some u -> u
150
+
| None ->
151
+
Git.User.v ~name:"monopam" ~email:"monopam@localhost"
152
+
~date:(Int64.of_float (Unix.time ()))
153
+
()
154
+
in
155
+
let message =
156
+
Fmt.str
157
+
"Merge '%s/' from monorepo split of '%s'\n\n\
158
+
git-subtree-dir: %s\n\
159
+
git-subtree-mainline: %s\n"
160
+
path prefix path
161
+
(Git.Hash.to_hex split_hash)
162
+
in
163
+
let merge_or_add () =
164
+
match
165
+
Git.Subtree.merge checkout_repo ~prefix:path ~commit:split_hash
166
+
~author:user ~committer:user ~message ()
167
+
with
168
+
| Ok h -> Ok h
169
+
| Error (`Msg msg)
170
+
when String.length msg >= 20
171
+
&& String.sub msg 0 20 = "Subtree not found at" ->
172
+
(* Fresh source that doesn't have this subtree yet.
173
+
Fall back to [Subtree.add] so the first push creates
174
+
the prefix in the source. *)
175
+
Git.Subtree.add checkout_repo ~prefix:path ~commit:split_hash
176
+
~author:user ~committer:user ~message ()
177
+
| Error (`Msg _) as e -> e
178
+
in
179
+
match merge_or_add () with
180
+
| Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg))
181
+
| Ok new_head ->
182
+
(* Subtree.merge advanced HEAD via git plumbing without
183
+
updating the working tree or the index. Sync both so
184
+
a subsequent [monopam pull] can fast-forward instead
185
+
of hitting "local changes would be overwritten". *)
186
+
(match Git.Repository.checkout checkout_repo new_head with
187
+
| Ok () -> ()
188
+
| Error (`Msg msg) ->
189
+
Log.warn (fun m ->
190
+
m "checkout after path merge of %s: %s" path msg));
191
+
(match Git.Repository.add_all checkout_repo with
192
+
| Ok () -> ()
193
+
| Error (`Msg msg) ->
194
+
Log.warn (fun m ->
195
+
m "rebuild index after path merge of %s: %s" path msg));
196
+
let _ = branch in
197
+
Ok ()))
198
+
199
+
(** Look up the sources.toml entry for a package.
200
+
201
+
sources.toml is keyed by the LOCAL subtree name, which is chosen at
202
+
[monopam add] time. For a plain whole-repo import this is the dev-repo
203
+
basename (= [Package.repo_name]). For a [--path] import, it's the path
204
+
basename (typically = [Package.name]). Check both keys and return the entry
205
+
\+ the matching key as the effective local prefix. *)
206
+
let lookup_entry ~sources pkg =
207
+
match sources with
208
+
| None -> (None, Package.subtree_prefix pkg)
209
+
| Some s -> (
210
+
let try_key k =
211
+
Option.map
212
+
(fun entry -> (Some entry, k))
213
+
(Sources_registry.find s ~subtree:k)
214
+
in
215
+
match try_key (Package.name pkg) with
216
+
| Some r -> r
217
+
| None -> (
218
+
match try_key (Package.subtree_prefix pkg) with
219
+
| Some r -> r
220
+
| None -> (None, Package.subtree_prefix pkg)))
221
+
114
222
let one ~sw ~proc ~fs ~config ~sources ~clean ~force pkg =
115
223
let ( let* ) r f =
116
224
Result.bind (Result.map_error (fun e -> Ctx.Git_error e) r) f
117
225
in
118
226
let fs = Ctx.fs_typed fs in
119
227
let monorepo = Config.Paths.monorepo config in
120
-
let prefix = Package.subtree_prefix pkg in
228
+
let entry, prefix = lookup_entry ~sources pkg in
121
229
let checkouts_root = Config.Paths.checkouts config in
122
230
let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
123
231
let branch = Ctx.branch ~config pkg in
124
232
let clone_url = resolve_fetch_url ~sources pkg in
233
+
(* If this subtree has a [path] override, the local checkout is a
234
+
clone of the SOURCE monorepo and we merge our split into it at
235
+
[path] rather than force-pushing the split as the checkout's
236
+
main branch. *)
237
+
let path_override =
238
+
Option.bind entry (fun (e : Sources_registry.entry) -> e.path)
239
+
in
125
240
if not (Ctx.is_directory ~fs Fpath.(monorepo / prefix)) then begin
126
241
Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix);
127
242
Ok Skipped
···
150
265
let* () = Ok () in
151
266
let checkout_url = Fpath.to_string checkout_dir in
152
267
let git_repo = Git.Repository.open_repo ~sw ~fs monorepo in
153
-
let mono_tree =
154
-
Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix
155
-
in
156
-
let checkout_tree = checkout_tree_hash ~sw ~fs checkout_dir in
157
-
if mono_tree = checkout_tree && mono_tree <> None then begin
158
-
Log.debug (fun m -> m "Skipping %s (trees match)" prefix);
159
-
Ok Skipped
160
-
end
161
-
else begin
162
-
Log.info (fun m ->
163
-
m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
164
-
let* () =
165
-
Git_cli.ensure_receive_config ~proc
166
-
~fs:(fs :> _ Eio.Path.t)
167
-
checkout_dir
168
-
in
169
-
let* () =
170
-
Git_cli.clean_untracked ~proc ~fs:(fs :> _ Eio.Path.t) checkout_dir
171
-
in
172
-
split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url
173
-
~checkout_tree ~clean ~force ~branch
174
-
|> Result.map (fun () -> Pushed)
175
-
end
268
+
match path_override with
269
+
| Some path ->
270
+
Log.info (fun m ->
271
+
m "Subtree push with path %s/%s -> %a" prefix path Fpath.pp
272
+
checkout_dir);
273
+
let* () =
274
+
Git_cli.ensure_receive_config ~proc
275
+
~fs:(fs :> _ Eio.Path.t)
276
+
checkout_dir
277
+
in
278
+
merge_split_into_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir
279
+
~prefix ~path ~branch
280
+
|> Result.map (fun () -> Pushed)
281
+
| None ->
282
+
let mono_tree =
283
+
Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix
284
+
in
285
+
let checkout_tree = checkout_tree_hash ~sw ~fs checkout_dir in
286
+
if mono_tree = checkout_tree && mono_tree <> None then begin
287
+
Log.debug (fun m -> m "Skipping %s (trees match)" prefix);
288
+
Ok Skipped
289
+
end
290
+
else begin
291
+
Log.info (fun m ->
292
+
m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
293
+
let* () =
294
+
Git_cli.ensure_receive_config ~proc
295
+
~fs:(fs :> _ Eio.Path.t)
296
+
checkout_dir
297
+
in
298
+
let* () =
299
+
Git_cli.clean_untracked ~proc
300
+
~fs:(fs :> _ Eio.Path.t)
301
+
checkout_dir
302
+
in
303
+
split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url
304
+
~checkout_tree ~clean ~force ~branch
305
+
|> Result.map (fun () -> Pushed)
306
+
end
176
307
end
177
308
178
309
(** {1 Workspace Repo Push} *)
+7
-2
lib/sources_registry.ml
+7
-2
lib/sources_registry.ml
···
15
15
origin : origin option;
16
16
mono : bool;
17
17
ref_ : string option;
18
+
path : string option;
18
19
}
19
20
20
21
type t = { origin : string option; entries : (string * entry) list }
···
97
98
let entry_codec : entry Tomlt.t =
98
99
Tomlt.(
99
100
Table.(
100
-
obj (fun source upstream branch reason entry_origin mono ref_ ->
101
+
obj (fun source upstream branch reason entry_origin mono ref_ path ->
101
102
{
102
103
source;
103
104
upstream;
···
106
107
origin = entry_origin;
107
108
mono;
108
109
ref_;
110
+
path;
109
111
})
110
112
|> mem "source" string ~enc:(fun (e : entry) -> e.source)
111
113
|> opt_mem "upstream" string ~enc:(fun (e : entry) -> e.upstream)
···
116
118
~enc:(fun (e : entry) -> e.mono)
117
119
~enc_omit:(fun b -> not b)
118
120
|> opt_mem "ref" string ~enc:(fun (e : entry) -> e.ref_)
121
+
|> opt_mem "path" string ~enc:(fun (e : entry) -> e.path)
119
122
|> finish))
120
123
121
124
(** Decode entry from a TOML table that uses old field names (backward compat).
122
-
Reads [url] as [source] and ignores [mono]/[ref]. *)
125
+
Reads [url] as [source] and ignores [mono]/[ref]/[path]. *)
123
126
let entry_codec_legacy : entry Tomlt.t =
124
127
Tomlt.(
125
128
Table.(
···
132
135
origin = entry_origin;
133
136
mono = false;
134
137
ref_ = None;
138
+
path = None;
135
139
})
136
140
|> mem "url" string ~enc:(fun (e : entry) -> e.source)
137
141
|> opt_mem "upstream" string ~enc:(fun (e : entry) -> e.upstream)
···
212
216
Option.iter (fun o -> Fmt.pf ppf "@ origin: %a" pp_origin o) e.origin;
213
217
if e.mono then Fmt.pf ppf "@ mono: true";
214
218
Option.iter (fun r -> Fmt.pf ppf "@ ref: %s" r) e.ref_;
219
+
Option.iter (fun p -> Fmt.pf ppf "@ path: %s" p) e.path;
215
220
Fmt.pf ppf "@]"
216
221
217
222
let pp ppf t =
+7
lib/sources_registry.mli
+7
lib/sources_registry.mli
···
34
34
ref_ : string option;
35
35
(** Pinned commit SHA. Replaces mono.lock — records the exact commit that
36
36
was imported/last synced. *)
37
+
path : string option;
38
+
(** If [Some p], the [source] URL points at a monorepo and this subtree
39
+
corresponds to the subdirectory [p] inside it. Add/pull/push run a
40
+
[Git.Subtree.split ~prefix:p] step so the local monorepo can host only
41
+
part of a larger upstream monorepo. This is how one global library
42
+
monorepo can be shared by multiple local product monorepos, each
43
+
materializing a different subset. *)
37
44
}
38
45
(** A source entry for a subtree. *)
39
46
+182
test/subtree_path.t/run.t
+182
test/subtree_path.t/run.t
···
1
+
monopam add --path: partial view of an upstream monorepo
2
+
===========================================================
3
+
4
+
A "library monorepo" hosts several libraries at its top level (eio/,
5
+
cohttp/). A local monopam workspace can materialize just one (or a
6
+
subset) of those libraries as a subtree via `monopam add --path`.
7
+
Pull and push honor the `path` field in sources.toml so the local
8
+
edit round-trips through the correct subdirectory of the source.
9
+
10
+
The feature enables two real workflows: (a) one global library
11
+
monorepo plus many local product monorepos, one per app, each
12
+
pulling only the libraries that app uses; (b) multiple developers
13
+
each cloning a different subset of the same upstream monorepo. This
14
+
test exercises a single workspace that imports both libraries from
15
+
one upstream, edits one, pushes it back, and verifies the source
16
+
received the change in the right subdirectory.
17
+
18
+
Setup
19
+
-----
20
+
21
+
$ export NO_COLOR=1
22
+
$ export GIT_AUTHOR_NAME="Alice"
23
+
$ export GIT_AUTHOR_EMAIL="alice@example.com"
24
+
$ export GIT_AUTHOR_DATE="2025-01-01T00:00:00+00:00"
25
+
$ export GIT_COMMITTER_NAME="Alice"
26
+
$ export GIT_COMMITTER_EMAIL="alice@example.com"
27
+
$ export GIT_COMMITTER_DATE="2025-01-01T00:00:00+00:00"
28
+
$ export HOME="$PWD/home"
29
+
$ mkdir -p "$HOME"
30
+
$ export GIT_CONFIG_GLOBAL="$HOME/.gitconfig"
31
+
$ printf '[init]\n\tdefaultBranch = main\n[user]\n\tname = Alice\n\temail = alice@example.com\n' > "$GIT_CONFIG_GLOBAL"
32
+
$ TROOT=$(pwd)
33
+
34
+
The global library monorepo: two libraries at its top level, hosted
35
+
in a bare repo that stands in for github/tangled.
36
+
37
+
$ git init -q --bare global.git
38
+
$ git clone -q global.git global-work 2>/dev/null
39
+
$ cd global-work
40
+
$ mkdir -p eio/lib cohttp/lib
41
+
$ cat > eio/eio.opam << OPAM
42
+
> opam-version: "2.0"
43
+
> name: "eio"
44
+
> version: "dev"
45
+
> synopsis: "Effects-based I/O"
46
+
> dev-repo: "git+file://$TROOT/global.git"
47
+
> OPAM
48
+
$ cat > cohttp/cohttp.opam << OPAM
49
+
> opam-version: "2.0"
50
+
> name: "cohttp"
51
+
> version: "dev"
52
+
> synopsis: "Cooperative HTTP"
53
+
> dev-repo: "git+file://$TROOT/global.git"
54
+
> OPAM
55
+
$ echo "let run () = ()" > eio/lib/main.ml
56
+
$ echo "let get () = ()" > cohttp/lib/main.ml
57
+
$ git add . && git commit -q -m "initial libraries"
58
+
$ git push -q origin main 2>/dev/null
59
+
$ cd "$TROOT"
60
+
61
+
Workspace with an opam-repo overlay registering eio and cohttp so
62
+
push/pull can discover them. The overlay's dev-repo points at the
63
+
global source, and sources.toml will add a `path` field per subtree.
64
+
65
+
$ mkdir -p opam-repo/packages/eio/eio.dev
66
+
$ cp global-work/eio/eio.opam opam-repo/packages/eio/eio.dev/opam
67
+
$ mkdir -p opam-repo/packages/cohttp/cohttp.dev
68
+
$ cp global-work/cohttp/cohttp.opam opam-repo/packages/cohttp/cohttp.dev/opam
69
+
$ cd opam-repo && git init -q && git add . && git commit -q -m "init" && cd "$TROOT"
70
+
71
+
$ mkdir -p "$HOME/.config/monopam"
72
+
$ cat > "$HOME/.config/monopam/opamverse.toml" << EOF
73
+
> [workspace]
74
+
> root = "$TROOT"
75
+
> [identity]
76
+
> handle = "alice.example.org"
77
+
> knot = "git.example.org"
78
+
> EOF
79
+
80
+
Stage 1: materialize just eio via --path
81
+
------------------------------------------
82
+
83
+
$ mkdir mono && cd mono && git init -q && git commit -q --allow-empty -m "init"
84
+
$ monopam add "file://$TROOT/global.git" --path eio > /tmp/add-out 2>&1
85
+
$ awk '{ gsub(/[0-9a-f]{7}/, "<SHA>"); gsub(/ \([0-9.]+s\)/, ""); print }' /tmp/add-out
86
+
Imported eio at <SHA>
87
+
Updated dune-project with 0 external dependencies
88
+
+ eio (<SHA>)
89
+
✓ Added 1 subtree.
90
+
Next: dune build && dune test
91
+
92
+
The working tree has eio/ but not cohttp/ — we only imported one path:
93
+
94
+
$ ls -1 | grep -v root.opam
95
+
dune-project
96
+
eio
97
+
sources.toml
98
+
99
+
sources.toml records the path override so subsequent pulls and pushes
100
+
know where to split from and merge into:
101
+
102
+
$ grep -E "source|path" sources.toml | sed "s|$TROOT|<TROOT>|"
103
+
source = "git+file://<TROOT>/global.git"
104
+
path = "eio"
105
+
106
+
The imported subtree has the expected content:
107
+
108
+
$ cat eio/lib/main.ml
109
+
let run () = ()
110
+
111
+
Stage 2: add cohttp too
112
+
-------------------------
113
+
114
+
A second `add --path` against the same source adds a second subtree.
115
+
116
+
$ monopam add "file://$TROOT/global.git" --path cohttp 2>&1 \
117
+
> | grep -E "^✓|^ Next" \
118
+
> | sed -e '/Added/ s/ ([0-9.]*s)//'
119
+
✓ Added 1 subtree.
120
+
Next: dune build && dune test
121
+
$ test -d cohttp && echo "cohttp present"
122
+
cohttp present
123
+
$ grep -c "^path =" sources.toml
124
+
2
125
+
126
+
Stage 3: edit eio locally and push back
127
+
-----------------------------------------
128
+
129
+
$ export GIT_AUTHOR_DATE="2025-02-01T00:00:00+00:00"
130
+
$ export GIT_COMMITTER_DATE="2025-02-01T00:00:00+00:00"
131
+
$ echo 'let run () = Printf.printf "ok"' > eio/lib/main.ml
132
+
$ git add -A && git commit -q -m "eio: print ok"
133
+
134
+
Push must split the local at eio, merge that split back into the
135
+
global source at the eio/ subdirectory, and push the source. It must
136
+
NOT touch cohttp/ — that's the whole point of the path filter.
137
+
138
+
$ monopam push eio 2>&1 \
139
+
> | grep -E "^ ✓|^✓" \
140
+
> | sed "s|$TROOT|<TROOT>|" \
141
+
> | sed -e '/Changes pushed/ s/ ([0-9.]*s)//'
142
+
✓ global → file://<TROOT>/global.git
143
+
✓ Changes pushed to your remotes.
144
+
145
+
Verify the global source received the eio edit, and that cohttp/ is
146
+
untouched:
147
+
148
+
$ rm -rf "$TROOT/verify"
149
+
$ git clone -q "$TROOT/global.git" "$TROOT/verify" 2>/dev/null
150
+
$ cd "$TROOT/verify"
151
+
$ grep "ok" eio/lib/main.ml
152
+
let run () = Printf.printf "ok"
153
+
$ cat cohttp/lib/main.ml
154
+
let get () = ()
155
+
156
+
Stage 4: pull brings in a third-party change to eio
157
+
-----------------------------------------------------
158
+
159
+
Simulate a collaborator editing eio in the global source:
160
+
161
+
$ export GIT_AUTHOR_DATE="2025-03-01T00:00:00+00:00"
162
+
$ export GIT_COMMITTER_DATE="2025-03-01T00:00:00+00:00"
163
+
$ echo 'let stop () = ()' >> eio/lib/main.ml
164
+
$ git add -A && git commit -q -m "eio: add stop"
165
+
$ git push -q origin main 2>/dev/null
166
+
$ cd "$TROOT/mono"
167
+
168
+
Pull eio: fetch the global source, split at eio, merge into the
169
+
local eio subtree. cohttp is untouched because we passed `eio` as a
170
+
filter.
171
+
172
+
$ monopam pull eio 2>&1 \
173
+
> | grep -E "^ ✓|^✓|^ Next" \
174
+
> | sed -e '/Monorepo/ s/ ([0-9.]*s)//'
175
+
✓ global (1 commits)
176
+
✓ Monorepo updated.
177
+
Next: dune build && dune test
178
+
179
+
$ grep "stop" eio/lib/main.ml
180
+
let stop () = ()
181
+
$ grep "get" cohttp/lib/main.ml
182
+
let get () = ()
+2
-1
test/test_deps.ml
+2
-1
test/test_deps.ml
···
13
13
in
14
14
rm path
15
15
16
-
let entry ?(branch = None) ?(ref_ = None) source =
16
+
let entry ?(branch = None) ?(ref_ = None) ?(path = None) source =
17
17
SR.
18
18
{
19
19
source;
···
23
23
origin = None;
24
24
mono = false;
25
25
ref_;
26
+
path;
26
27
}
27
28
28
29
let write_sources ~fs ~target entries =
+13
-2
test/test_pkg.ml
+13
-2
test/test_pkg.ml
···
33
33
34
34
(* Helper to build a sources_registry entry *)
35
35
let sr_entry ?(upstream = None) ?(branch = None) ?(reason = None)
36
-
?(entry_origin = None) ?(mono = false) ?(ref_ = None) source =
37
-
SR.{ source; upstream; branch; reason; origin = entry_origin; mono; ref_ }
36
+
?(entry_origin = None) ?(mono = false) ?(ref_ = None) ?(path = None) source
37
+
=
38
+
SR.
39
+
{
40
+
source;
41
+
upstream;
42
+
branch;
43
+
reason;
44
+
origin = entry_origin;
45
+
mono;
46
+
ref_;
47
+
path;
48
+
}
38
49
39
50
let check_dev_repo msg expected result =
40
51
Alcotest.(check (option (pair string string))) msg expected result
+14
-3
test/test_sources_registry.ml
+14
-3
test/test_sources_registry.ml
···
6
6
Alcotest.testable SR.pp_entry (fun a b ->
7
7
a.SR.source = b.SR.source && a.upstream = b.upstream
8
8
&& a.branch = b.branch && a.reason = b.reason && a.origin = b.origin
9
-
&& a.mono = b.mono && a.ref_ = b.ref_)
9
+
&& a.mono = b.mono && a.ref_ = b.ref_ && a.path = b.path)
10
10
11
11
let entry ?(upstream = None) ?(branch = None) ?(reason = None)
12
-
?(entry_origin = None) ?(mono = false) ?(ref_ = None) source =
13
-
SR.{ source; upstream; branch; reason; origin = entry_origin; mono; ref_ }
12
+
?(entry_origin = None) ?(mono = false) ?(ref_ = None) ?(path = None) source
13
+
=
14
+
SR.
15
+
{
16
+
source;
17
+
upstream;
18
+
branch;
19
+
reason;
20
+
origin = entry_origin;
21
+
mono;
22
+
ref_;
23
+
path;
24
+
}
14
25
15
26
(* Test basic operations *)
16
27