Monorepo management for opam overlays
monopam: drop git-subtree-dir trailers, surface untracked subdirs
The trailer was only written, never read back; its sole use was
compatibility with stock git-subtree, which nothing in this workspace
relies on. It mostly confused anyone reading import/merge messages.
monopam status now reports an 'Untracked:' block listing monorepo
subdirs that contain a dune-project but aren't covered by any known
package.
+78
-17
+22
bin/cmd_status.ml
+22
bin/cmd_status.ml
···
98
98
| Ok pkgs -> print_unregistered ~fs ~config pkgs
99
99
| Error _ -> ()
100
100
101
+
let print_untracked ~fs ~config pkgs =
102
+
let untracked = Monopam.untracked_subdirs ~fs ~config pkgs in
103
+
if untracked <> [] then begin
104
+
Fmt.pr "%a %a\n"
105
+
Fmt.(styled `Bold string)
106
+
"Untracked:"
107
+
Fmt.(styled `Faint int)
108
+
(List.length untracked);
109
+
List.iter
110
+
(fun name ->
111
+
Fmt.pr " %-22s %a\n" name
112
+
Fmt.(styled `Faint string)
113
+
"(not in sources.toml)")
114
+
untracked
115
+
end
116
+
117
+
let print_untracked_block ~fs ~config =
118
+
match Monopam.discover_packages ~fs ~config () with
119
+
| Ok pkgs -> print_untracked ~fs ~config pkgs
120
+
| Error _ -> ()
121
+
101
122
let print_unpublished_block ~fs ~config =
102
123
let pub = Monopam.Opam_sync.check_publish_status ~fs ~config () in
103
124
if pub.not_in_repo = [] && pub.unpublished = [] then ()
···
133
154
| Ok statuses ->
134
155
print_status_table ~fs ~config statuses;
135
156
print_unregistered_block ~fs ~config;
157
+
print_untracked_block ~fs ~config;
136
158
print_unpublished_block ~fs ~config;
137
159
if show_forks then print_forks ~sw ~proc ~fs ~config ~show_all;
138
160
`Ok ()
+30
lib/ctx.ml
+30
lib/ctx.ml
···
424
424
with Eio.Io _ -> [])
425
425
repos
426
426
427
+
let untracked_subdirs ~fs ~config pkgs =
428
+
let fs = fs_typed fs in
429
+
let monorepo = Config.Paths.monorepo config in
430
+
let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
431
+
let tracked = Hashtbl.create 256 in
432
+
List.iter
433
+
(fun pkg -> Hashtbl.replace tracked (Package.subtree_prefix pkg) ())
434
+
pkgs;
435
+
let is_candidate name =
436
+
if Hashtbl.mem tracked name then false
437
+
else if String.length name = 0 then false
438
+
else
439
+
match name.[0] with
440
+
| '.' | '_' -> false
441
+
| _ -> (
442
+
let dune_project = Eio.Path.(monorepo_eio / name / "dune-project") in
443
+
match Eio.Path.kind ~follow:false dune_project with
444
+
| `Regular_file -> true
445
+
| _ -> false)
446
+
in
447
+
try
448
+
Eio.Path.read_dir monorepo_eio
449
+
|> List.filter (fun name ->
450
+
let child = Eio.Path.(monorepo_eio / name) in
451
+
match Eio.Path.kind ~follow:false child with
452
+
| `Directory -> is_candidate name
453
+
| _ -> false)
454
+
|> List.sort String.compare
455
+
with Eio.Io _ -> []
456
+
427
457
(** {1 Status} *)
428
458
429
459
let status ~sw ~fs ~config () =
+10
lib/ctx.mli
+10
lib/ctx.mli
···
154
154
(** [unregistered_opam_files ~fs ~config pkgs] returns opam files not tracked by
155
155
any known package. *)
156
156
157
+
val untracked_subdirs :
158
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
159
+
config:Config.t ->
160
+
Package.t list ->
161
+
string list
162
+
(** [untracked_subdirs ~fs ~config pkgs] returns subdirectories at the monorepo
163
+
root that look like packages (contain a [dune-project]) but are not covered
164
+
by any package in [pkgs]. Hidden directories (names starting with [.] or
165
+
[_]) are skipped. *)
166
+
157
167
(** {1 Status} *)
158
168
159
169
val status :
+2
-6
lib/fork_join.ml
+2
-6
lib/fork_join.ml
···
791
791
~date:(Int64.of_float (Unix.time ()))
792
792
()
793
793
in
794
-
let message =
795
-
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" prefix url prefix
796
-
in
794
+
let message = Fmt.str "Add '%s' from %s\n" prefix url in
797
795
match
798
796
Git.Subtree.add git_repo ~prefix ~commit ~author:user ~committer:user
799
797
~message ()
···
1073
1071
~date:(Int64.of_float (Unix.time ()))
1074
1072
()
1075
1073
in
1076
-
let message =
1077
-
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" prefix url prefix
1078
-
in
1074
+
let message = Fmt.str "Add '%s' from %s\n" prefix url in
1079
1075
Git.Subtree.add git_repo ~prefix ~commit ~author:user ~committer:user
1080
1076
~message ()
1081
1077
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
+2
-5
lib/import.ml
+2
-5
lib/import.ml
···
225
225
226
226
let subtree_message ~name ~fetch_url ~path =
227
227
match path with
228
-
| None ->
229
-
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" name fetch_url name
230
-
| Some p ->
231
-
Fmt.str "Add '%s' from %s (path: %s)\n\ngit-subtree-dir: %s\n" name
232
-
fetch_url p name
228
+
| None -> Fmt.str "Add '%s' from %s\n" name fetch_url
229
+
| Some p -> Fmt.str "Add '%s' from %s (path: %s)\n" name fetch_url p
233
230
234
231
let resolve_commit git_repo ~fetched ~path =
235
232
match path with
+1
lib/monopam.ml
+1
lib/monopam.ml
+9
lib/monopam.mli
+9
lib/monopam.mli
···
86
86
(** [unregistered_opam_files ~fs ~config pkgs] returns opam files not tracked by
87
87
any known package. *)
88
88
89
+
val untracked_subdirs :
90
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
91
+
config:Config.t ->
92
+
Package.t list ->
93
+
string list
94
+
(** [untracked_subdirs ~fs ~config pkgs] returns subdirectories at the monorepo
95
+
root that contain a [dune-project] but are not covered by any package in
96
+
[pkgs]. Hidden directories (names starting with [.] or [_]) are skipped. *)
97
+
89
98
val status :
90
99
sw:Eio.Switch.t ->
91
100
fs:Eio.Fs.dir_ty Eio.Path.t ->
+1
-3
lib/pull.ml
+1
-3
lib/pull.ml
···
53
53
auto-create subtrees, that's [monopam add]'s job. Returns [Merged] on a
54
54
clean merge or [Conflict] when the merge produced markers. *)
55
55
let merge_subtree ~git_repo ~prefix ~commit ~user ~url =
56
-
let message =
57
-
Fmt.str "Merge '%s/' from %s\n\ngit-subtree-dir: %s\n" prefix url prefix
58
-
in
56
+
let message = Fmt.str "Merge '%s/' from %s\n" prefix url in
59
57
match
60
58
Git.Subtree.merge git_repo ~prefix ~commit ~author:user ~committer:user
61
59
~message ()
+1
-3
lib/push.ml
+1
-3
lib/push.ml
···
181
181
let checkout_repo = Git.Repository.open_repo ~sw ~fs checkout_dir in
182
182
let user = resolve_user ~fs in
183
183
let message =
184
-
Fmt.str
185
-
"Merge '%s/' from monorepo split of '%s'\n\ngit-subtree-dir: %s\n"
186
-
path prefix path
184
+
Fmt.str "Merge '%s/' from monorepo split of '%s'\n" path prefix
187
185
in
188
186
match
189
187
merge_or_add_subtree checkout_repo ~prefix:path ~commit:split_hash