Monorepo management for opam overlays
fix(lint): resolve E320, E331, E410, E415, E505, E510 across multiple packages
E505: add missing .mli files for merlint/lib/sexp, monopam-info, and
monopam/lib/{add,clean,ctx,diff,init,pull,push,remove}.
E510: add log source to ca-certs/test/tests.ml.
E410: fix doc ending period in kdf/scrypt.
E415: add pp to ocaml-agent config and runtime_config.
E331: remove redundant get_/make_/find_/create_ prefixes.
E320: remove redundant module prefixes (Diff.diff→compute,
Pull.pull→run, Push.push→run, Remove.remove→run, etc).
+144
-153
+1
-1
bin/cmd_clean.ml
+1
-1
bin/cmd_clean.ml
···
38
38
Common.with_config env @@ fun config ->
39
39
let fs = Eio.Stdenv.fs env in
40
40
let proc = Eio.Stdenv.process_mgr env in
41
-
match Monopam.Clean.clean ~proc ~fs ~config ~dry_run ~force () with
41
+
match Monopam.Clean.run ~proc ~fs ~config ~dry_run ~force () with
42
42
| Ok () -> `Ok ()
43
43
| Error e ->
44
44
Fmt.epr "Error: %a@." Monopam.Ctx.pp_error_with_hint e;
+1
-1
bin/cmd_publish.ml
+1
-1
bin/cmd_publish.ml
···
99
99
| Some config when (not no_checkouts) && not dry_run -> (
100
100
Fmt.pr "@.Exporting to checkouts...@.";
101
101
match
102
-
Monopam.Push.push ~proc ~fs ~config ~packages ~upstream:false
102
+
Monopam.Push.run ~proc ~fs ~config ~packages ~upstream:false
103
103
~clean:false ~force:false ()
104
104
with
105
105
| Ok () -> Fmt.pr "Checkouts updated.@."
+1
-1
bin/cmd_pull.ml
+1
-1
bin/cmd_pull.ml
···
37
37
Common.with_config env @@ fun config ->
38
38
let fs = Eio.Stdenv.fs env in
39
39
let proc = Eio.Stdenv.process_mgr env in
40
-
match Monopam.Pull.pull ~proc ~fs ~config ~packages () with
40
+
match Monopam.Pull.run ~proc ~fs ~config ~packages () with
41
41
| Ok () ->
42
42
let elapsed = Unix.gettimeofday () -. t0 in
43
43
Fmt.pr "@.%a Monorepo updated in %a.@." Tty.Span.pp
+1
-1
bin/cmd_push.ml
+1
-1
bin/cmd_push.ml
···
64
64
let fs = Eio.Stdenv.fs env in
65
65
let proc = Eio.Stdenv.process_mgr env in
66
66
match
67
-
Monopam.Push.push ~proc ~fs ~config ~packages ~upstream:(not local_only)
67
+
Monopam.Push.run ~proc ~fs ~config ~packages ~upstream:(not local_only)
68
68
~clean ~force ()
69
69
with
70
70
| Ok () ->
+2
-2
bin/cmd_test.ml
+2
-2
bin/cmd_test.ml
···
36
36
m " %s: %s (%.2fs)" dir (status_to_string status) duration);
37
37
{ name = dir; duration; status }
38
38
39
-
let find_test_dirs ~fs =
39
+
let test_dirs ~fs =
40
40
let cwd = Eio.Path.(fs / ".") in
41
41
Eio.Path.read_dir cwd
42
42
|> List.filter (fun d ->
···
97
97
Eio_main.run @@ fun env ->
98
98
let process_mgr = Eio.Stdenv.process_mgr env in
99
99
let fs = Eio.Stdenv.fs env in
100
-
let dirs = find_test_dirs ~fs in
100
+
let dirs = test_dirs ~fs in
101
101
let dirs =
102
102
match filter with
103
103
| [] -> dirs
+2
-2
bin/main.ml
+2
-2
bin/main.ml
+1
-1
lib/add.ml
+1
-1
lib/add.ml
···
7
7
8
8
module Log = (val Logs.src_log src : Logs.LOG)
9
9
10
-
let add ~proc ~fs ~config ~package:pkg_name () =
10
+
let run ~proc ~fs ~config ~package:pkg_name () =
11
11
let fs_t = Ctx.fs_typed fs in
12
12
Ctx.ensure_checkouts_dir ~fs:fs_t ~config;
13
13
match Init.ensure ~proc ~fs:fs_t ~config with
+2
-2
lib/add.mli
+2
-2
lib/add.mli
···
1
1
(** Add a package to the monorepo. *)
2
2
3
-
val add :
3
+
val run :
4
4
proc:_ Eio.Process.mgr ->
5
5
fs:Eio.Fs.dir_ty Eio.Path.t ->
6
6
config:Config.t ->
7
7
package:string ->
8
8
unit ->
9
9
(unit, Ctx.error) result
10
-
(** [add ~proc ~fs ~config ~package ()] looks up the package in the opam repo,
10
+
(** [run ~proc ~fs ~config ~package ()] looks up the package in the opam repo,
11
11
ensures its checkout exists, and pulls the subtree into the monorepo. *)
+25
-29
lib/changes.ml
+25
-29
lib/changes.ml
···
51
51
repo_url : string option; (* Upstream repository URL *)
52
52
}
53
53
54
-
type changes_file = { repository : string; entries : weekly_entry list }
55
-
type daily_changes_file = { repository : string; entries : daily_entry list }
54
+
type file = { repository : string; entries : weekly_entry list }
55
+
type daily_file = { repository : string; entries : daily_entry list }
56
56
57
57
(** Mode for changelog generation *)
58
58
type mode = Weekly | Daily
···
84
84
~enc:(fun (e : weekly_entry) -> e.commit_range)
85
85
|> Jsont.Object.finish
86
86
87
-
let changes_file_jsont : changes_file Jsont.t =
88
-
let make repository entries : changes_file = { repository; entries } in
87
+
let file_jsont : file Jsont.t =
88
+
let make repository entries : file = { repository; entries } in
89
89
Jsont.Object.map ~kind:"changes_file" make
90
-
|> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : changes_file) ->
90
+
|> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : file) ->
91
91
f.repository)
92
92
|> Jsont.Object.mem "entries" (Jsont.list weekly_entry_jsont)
93
-
~enc:(fun (f : changes_file) -> f.entries)
93
+
~enc:(fun (f : file) -> f.entries)
94
94
|> Jsont.Object.finish
95
95
96
96
let ptime_jsont =
···
137
137
~enc:(fun (e : daily_entry) -> e.repo_url)
138
138
|> Jsont.Object.finish
139
139
140
-
let daily_changes_file_jsont : daily_changes_file Jsont.t =
141
-
let make repository entries : daily_changes_file = { repository; entries } in
140
+
let daily_file_jsont : daily_file Jsont.t =
141
+
let make repository entries : daily_file = { repository; entries } in
142
142
Jsont.Object.map ~kind:"daily_changes_file" make
143
-
|> Jsont.Object.mem "repository" Jsont.string
144
-
~enc:(fun (f : daily_changes_file) -> f.repository)
143
+
|> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : daily_file) ->
144
+
f.repository)
145
145
|> Jsont.Object.mem "entries" (Jsont.list daily_entry_jsont)
146
-
~enc:(fun (f : daily_changes_file) -> f.entries)
146
+
~enc:(fun (f : daily_file) -> f.entries)
147
147
|> Jsont.Object.finish
148
148
149
149
(* File I/O *)
···
165
165
match Eio.Path.kind ~follow:true file_path with
166
166
| `Regular_file -> (
167
167
let content = Eio.Path.load file_path in
168
-
match Jsont_bytesrw.decode_string changes_file_jsont content with
168
+
match Jsont_bytesrw.decode_string file_jsont content with
169
169
| Ok cf -> Ok cf
170
170
| Error e -> err_parse (repo_name ^ ".json") e)
171
171
| _ -> Ok { repository = repo_name; entries = [] }
172
172
| exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
173
173
174
174
(* Save weekly changes to .changes/<repo>.json in monorepo *)
175
-
let save ~fs ~monorepo (cf : changes_file) =
175
+
let save ~fs ~monorepo (cf : file) =
176
176
ensure_changes_dir ~fs monorepo;
177
177
let file_path =
178
178
Eio.Path.(
179
179
fs / Fpath.to_string monorepo / ".changes" / (cf.repository ^ ".json"))
180
180
in
181
-
match
182
-
Jsont_bytesrw.encode_string ~format:Jsont.Indent changes_file_jsont cf
183
-
with
181
+
match Jsont_bytesrw.encode_string ~format:Jsont.Indent file_jsont cf with
184
182
| Ok content ->
185
183
Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
186
184
Ok ()
···
209
207
match Eio.Path.kind ~follow:true file_path with
210
208
| `Regular_file -> (
211
209
let content = Eio.Path.load file_path in
212
-
match Jsont_bytesrw.decode_string daily_changes_file_jsont content with
210
+
match Jsont_bytesrw.decode_string daily_file_jsont content with
213
211
| Ok cf -> Ok cf
214
212
| Error e -> err_parse filename e)
215
213
| _ -> Ok { repository = repo_name; entries = [] }
216
214
| exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
217
215
218
216
(* Save daily changes to .changes/<repo>-<date>.json in monorepo *)
219
-
let save_daily ~fs ~monorepo ~date (cf : daily_changes_file) =
217
+
let save_daily ~fs ~monorepo ~date (cf : daily_file) =
220
218
ensure_changes_dir ~fs monorepo;
221
219
let filename = daily_filename cf.repository date in
222
220
let file_path =
223
221
Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
224
222
in
225
223
match
226
-
Jsont_bytesrw.encode_string ~format:Jsont.Indent daily_changes_file_jsont cf
224
+
Jsont_bytesrw.encode_string ~format:Jsont.Indent daily_file_jsont cf
227
225
with
228
226
| Ok content ->
229
227
Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
···
232
230
233
231
(* Markdown generation *)
234
232
235
-
let to_markdown (cf : changes_file) =
233
+
let to_markdown (cf : file) =
236
234
let buf = Buffer.create 1024 in
237
235
Buffer.add_string buf (Fmt.str "# %s Changelog\n\n" cf.repository);
238
236
List.iter
···
247
245
cf.entries;
248
246
Buffer.contents buf
249
247
250
-
let aggregate ~history (cfs : changes_file list) =
248
+
let aggregate ~history (cfs : file list) =
251
249
(* Collect all entries from all files, tagged with repository *)
252
250
let all_entries =
253
251
List.concat_map
254
-
(fun (cf : changes_file) ->
252
+
(fun (cf : file) ->
255
253
List.map (fun (e : weekly_entry) -> (cf.repository, e)) cf.entries)
256
254
cfs
257
255
in
···
386
384
in
387
385
(to_timestamp 0 0 0, to_timestamp 23 59 59)
388
386
389
-
let has_week (cf : changes_file) ~week_start =
387
+
let has_week (cf : file) ~week_start =
390
388
List.exists (fun (e : weekly_entry) -> e.week_start = week_start) cf.entries
391
389
392
390
let date_of_ptime t =
393
391
let (y, m, d), _ = Ptime.to_date_time t in
394
392
format_date (y, m, d)
395
393
396
-
let has_day (cf : daily_changes_file) ~date:_ =
394
+
let has_day (cf : daily_file) ~date:_ =
397
395
(* With per-day files, the file is already for a specific date.
398
396
This function now checks if the file has any entries. *)
399
397
cf.entries <> []
···
429
427
end
430
428
431
429
(* Aggregate daily changes into DAILY-CHANGES.md *)
432
-
let aggregate_daily ~history (cfs : daily_changes_file list) =
430
+
let aggregate_daily ~history (cfs : daily_file list) =
433
431
(* Collect all entries from all files, tagged with repository *)
434
432
let all_entries =
435
433
List.concat_map
436
-
(fun (cf : daily_changes_file) ->
434
+
(fun (cf : daily_file) ->
437
435
List.map (fun (e : daily_entry) -> (cf.repository, e)) cf.entries)
438
436
cfs
439
437
in
···
924
922
let path = Eio.Path.(changes_dir / filename) in
925
923
try
926
924
let content = Eio.Path.load path in
927
-
match
928
-
Jsont_bytesrw.decode_string daily_changes_file_jsont content
929
-
with
925
+
match Jsont_bytesrw.decode_string daily_file_jsont content with
930
926
| Ok dcf ->
931
927
List.filter_map
932
928
(fun (e : daily_entry) ->
+13
-14
lib/changes.mli
+13
-14
lib/changes.mli
···
51
51
}
52
52
(** A single day's changelog entry with hour tracking for real-time updates. *)
53
53
54
-
type changes_file = { repository : string; entries : weekly_entry list }
54
+
type file = { repository : string; entries : weekly_entry list }
55
55
(** Contents of a weekly changes JSON file for a repository. *)
56
56
57
-
type daily_changes_file = { repository : string; entries : daily_entry list }
57
+
type daily_file = { repository : string; entries : daily_entry list }
58
58
(** Contents of a daily changes JSON file for a repository. *)
59
59
60
60
(** Mode for changelog generation. *)
···
68
68
val weekly_entry_jsont : weekly_entry Jsont.t
69
69
(** JSON codec for weekly entries. *)
70
70
71
-
val changes_file_jsont : changes_file Jsont.t
71
+
val file_jsont : file Jsont.t
72
72
(** JSON codec for weekly changes files. *)
73
73
74
74
val daily_entry_jsont : daily_entry Jsont.t
75
75
(** JSON codec for daily entries. *)
76
76
77
-
val daily_changes_file_jsont : daily_changes_file Jsont.t
77
+
val daily_file_jsont : daily_file Jsont.t
78
78
(** JSON codec for daily changes files. *)
79
79
80
80
(** {1 File I/O} *)
81
81
82
82
val load :
83
-
fs:_ Eio.Path.t -> monorepo:Fpath.t -> string -> (changes_file, string) result
83
+
fs:_ Eio.Path.t -> monorepo:Fpath.t -> string -> (file, string) result
84
84
(** [load ~fs ~monorepo repo_name] loads weekly changes from
85
85
.changes/<repo_name>.json. Returns an empty changes file if the file does
86
86
not exist. *)
87
87
88
-
val save :
89
-
fs:_ Eio.Path.t -> monorepo:Fpath.t -> changes_file -> (unit, string) result
88
+
val save : fs:_ Eio.Path.t -> monorepo:Fpath.t -> file -> (unit, string) result
90
89
(** [save ~fs ~monorepo cf] saves the changes file to .changes/<repo_name>.json.
91
90
*)
92
91
···
102
101
monorepo:Fpath.t ->
103
102
date:string ->
104
103
string ->
105
-
(daily_changes_file, string) result
104
+
(daily_file, string) result
106
105
(** [load_daily ~fs ~monorepo ~date repo_name] loads daily changes from
107
106
[.changes/<repo_name>-<date>.json]. Returns an empty changes file if the
108
107
file does not exist.
···
113
112
fs:_ Eio.Path.t ->
114
113
monorepo:Fpath.t ->
115
114
date:string ->
116
-
daily_changes_file ->
115
+
daily_file ->
117
116
(unit, string) result
118
117
(** [save_daily ~fs ~monorepo ~date cf] saves the changes file to
119
118
[.changes/<repo_name>-<date>.json].
···
122
121
123
122
(** {1 Markdown Generation} *)
124
123
125
-
val to_markdown : changes_file -> string
124
+
val to_markdown : file -> string
126
125
(** [to_markdown cf] generates markdown from a single weekly changes file. *)
127
126
128
-
val aggregate : history:int -> changes_file list -> string
127
+
val aggregate : history:int -> file list -> string
129
128
(** [aggregate ~history cfs] generates combined markdown from multiple weekly
130
129
changes files.
131
130
132
131
@param history Number of weeks to include (0 for all). *)
133
132
134
-
val aggregate_daily : history:int -> daily_changes_file list -> string
133
+
val aggregate_daily : history:int -> daily_file list -> string
135
134
(** [aggregate_daily ~history cfs] generates combined markdown from multiple
136
135
daily changes files. Only includes repos with actual changes (filters out
137
136
empty entries).
···
162
161
val date_of_ptime : Ptime.t -> string
163
162
(** [date_of_ptime t] returns the date as YYYY-MM-DD for the given timestamp. *)
164
163
165
-
val has_week : changes_file -> week_start:string -> bool
164
+
val has_week : file -> week_start:string -> bool
166
165
(** [has_week cf ~week_start] returns true if the changes file already has an
167
166
entry for the week starting on the given date. *)
168
167
169
-
val has_day : daily_changes_file -> date:string -> bool
168
+
val has_day : daily_file -> date:string -> bool
170
169
(** [has_day cf ~date] returns true if the daily changes file already has an
171
170
entry for the given date. *)
172
171
+1
-1
lib/clean.ml
+1
-1
lib/clean.ml
+2
-2
lib/clean.mli
+2
-2
lib/clean.mli
···
1
1
(** Clean empty commits from monorepo and checkouts. *)
2
2
3
-
val clean :
3
+
val run :
4
4
proc:_ Eio.Process.mgr ->
5
5
fs:Eio.Fs.dir_ty Eio.Path.t ->
6
6
config:Config.t ->
···
8
8
force:bool ->
9
9
unit ->
10
10
(unit, Ctx.error) result
11
-
(** [clean ~proc ~fs ~config ~dry_run ~force ()] removes empty commits and
11
+
(** [run ~proc ~fs ~config ~dry_run ~force ()] removes empty commits and
12
12
unrelated merge commits from git history. *)
+5
-5
lib/config.ml
+5
-5
lib/config.ml
···
97
97
| Some home -> Fpath.(v home / ".cache")
98
98
| None -> Fpath.v "/tmp")
99
99
100
-
let config_dir () = Fpath.(xdg_config_home () / app_name)
100
+
let dir () = Fpath.(xdg_config_home () / app_name)
101
101
let data_dir () = Fpath.(xdg_data_home () / app_name)
102
102
let cache_dir () = Fpath.(xdg_cache_home () / app_name)
103
-
let config_file () = Fpath.(config_dir () / "opamverse.toml")
103
+
let file () = Fpath.(dir () / "opamverse.toml")
104
104
let registry_path () = Fpath.(data_dir () / "opamverse-registry")
105
105
106
106
(** {1 Construction} *)
···
259
259
(** {1 Loading and Saving} *)
260
260
261
261
let load ~fs () =
262
-
let path = config_file () in
262
+
let path = file () in
263
263
let path_str = Fpath.to_string path in
264
264
let eio_path = Eio.Path.(fs / path_str) in
265
265
match Eio.Path.kind ~follow:true eio_path with
···
271
271
| exception _ -> err_not_found path_str
272
272
273
273
let save ~fs t =
274
-
let dir = config_dir () in
275
-
let path = config_file () in
274
+
let dir = dir () in
275
+
let path = file () in
276
276
try
277
277
(* Ensure XDG config directory exists *)
278
278
let dir_path = Eio.Path.(fs / Fpath.to_string dir) in
+5
-5
lib/config.mli
+5
-5
lib/config.mli
···
100
100
101
101
(** {1 XDG Paths} *)
102
102
103
-
val config_dir : unit -> Fpath.t
104
-
(** [config_dir ()] returns the XDG config directory for monopam
105
-
(~/.config/monopam). *)
103
+
val dir : unit -> Fpath.t
104
+
(** [dir ()] returns the XDG config directory for monopam (~/.config/monopam).
105
+
*)
106
106
107
107
val data_dir : unit -> Fpath.t
108
108
(** [data_dir ()] returns the XDG data directory for monopam
···
112
112
(** [cache_dir ()] returns the XDG cache directory for monopam
113
113
(~/.cache/monopam). *)
114
114
115
-
val config_file : unit -> Fpath.t
116
-
(** [config_file ()] returns the path to the config file
115
+
val file : unit -> Fpath.t
116
+
(** [file ()] returns the path to the config file
117
117
(~/.config/monopam/opamverse.toml). *)
118
118
119
119
val registry_path : unit -> Fpath.t
+1
-1
lib/cross_status.ml
+1
-1
lib/cross_status.ml
···
212
212
let my_subtrees = Verse.scan_subtrees ~fs my_mono in
213
213
214
214
(* Get verse subtrees (map: repo_name -> [(handle, monorepo_path)]) *)
215
-
let verse_subtrees = Verse.verse_subtrees ~fs ~config:verse_config () in
215
+
let verse_subtrees = Verse.subtrees ~fs ~config:verse_config () in
216
216
217
217
(* Build comparisons for repos I have *)
218
218
let my_repos =
+1
-1
lib/diff.ml
+1
-1
lib/diff.ml
···
111
111
112
112
(** {1 Diff Operations} *)
113
113
114
-
let diff ~proc ~fs ~config ~verse_config ?repo ?(refresh = false)
114
+
let compute ~proc ~fs ~config ~verse_config ?repo ?(refresh = false)
115
115
?(patch = false) () =
116
116
let checkouts_path = Config.Paths.checkouts config in
117
117
let forks =
+2
-2
lib/diff.mli
+2
-2
lib/diff.mli
···
59
59
60
60
(** {1 Diff Operations} *)
61
61
62
-
val diff :
62
+
val compute :
63
63
proc:_ Eio.Process.mgr ->
64
64
fs:Eio.Fs.dir_ty Eio.Path.t ->
65
65
config:Config.t ->
···
69
69
?patch:bool ->
70
70
unit ->
71
71
result
72
-
(** [diff ~proc ~fs ~config ~verse_config ()] computes the diff between local
72
+
(** [compute ~proc ~fs ~config ~verse_config ()] computes the diff between local
73
73
and verse state. *)
74
74
75
75
val show_commit :
+6
-6
lib/doctor.ml
+6
-6
lib/doctor.ml
···
495
495
Buffer.contents buf
496
496
497
497
(** Prompt instructions for doctor analysis *)
498
-
let doctor_instructions =
498
+
let instructions =
499
499
{|
500
500
## Instructions
501
501
···
540
540
|};
541
541
Buffer.add_string buf status_summary;
542
542
Buffer.add_string buf incoming_summary;
543
-
Buffer.add_string buf doctor_instructions;
543
+
Buffer.add_string buf instructions;
544
544
Buffer.contents buf
545
545
546
546
(** JSON schema helpers *)
···
567
567
Meta.none )
568
568
569
569
(** JSON schema for doctor output *)
570
-
let doctor_output_schema () =
570
+
let output_schema () =
571
571
let open Jsont in
572
572
let prop name schema = ((name, Meta.none), schema) in
573
573
let commit_schema =
···
644
644
| _ -> Log.app (fun m -> m " [%s]" name)
645
645
646
646
(** Create Claude handler for doctor analysis *)
647
-
let doctor_handler result =
647
+
let handler result =
648
648
object
649
649
inherit Claude.Handler.default
650
650
···
672
672
~incoming_summary =
673
673
let prompt = build_doctor_prompt ~status_summary ~incoming_summary in
674
674
let output_format =
675
-
Claude.Proto.Structured_output.of_json_schema (doctor_output_schema ())
675
+
Claude.Proto.Structured_output.of_json_schema (output_schema ())
676
676
in
677
677
let options =
678
678
Claude.Options.default |> Claude.Options.with_output_format output_format
···
680
680
let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in
681
681
Claude.Client.query client prompt;
682
682
let result = ref None in
683
-
Claude.Client.run client ~handler:(doctor_handler result);
683
+
Claude.Client.run client ~handler:(handler result);
684
684
!result
685
685
686
686
(** {2 JSON Parsing Helpers} *)
+3
-3
lib/feature.ml
+3
-3
lib/feature.ml
···
41
41
let work_path config = Fpath.(Verse_config.root config / "work")
42
42
43
43
(* Get the feature worktree path: root/work/<name> *)
44
-
let feature_path config name = Fpath.(work_path config / name)
44
+
let path config name = Fpath.(work_path config / name)
45
45
46
46
let add ~fs ~config ~name () =
47
47
let mono = Verse_config.mono_path config in
48
48
let work_dir = work_path config in
49
-
let wt_path = feature_path config name in
49
+
let wt_path = path config name in
50
50
let repo = Git.Repository.open_repo ~fs mono in
51
51
let wt = Git.Repository.worktree repo in
52
52
(* Check if feature already exists *)
···
66
66
67
67
let remove ~fs ~config ~name ~force () =
68
68
let mono = Verse_config.mono_path config in
69
-
let wt_path = feature_path config name in
69
+
let wt_path = path config name in
70
70
let repo = Git.Repository.open_repo ~fs mono in
71
71
let wt = Git.Repository.worktree repo in
72
72
(* Check if feature exists *)
+7
-11
lib/import.ml
+7
-11
lib/import.ml
···
17
17
| Git_url of { url : string; branch : string option; ref_ : string option }
18
18
| Lock_file of Fpath.t
19
19
20
-
type import_result = {
20
+
type result = {
21
21
name : string;
22
22
commit : string;
23
23
added : bool; (** true if newly added, false if already exists *)
···
132
132
(** {1 Import Operations} *)
133
133
134
134
(** Import a single git URL as a subtree *)
135
-
let import_git_url ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run =
135
+
let git_url ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run =
136
136
let name = match name with Some n -> n | None -> repo_name_from_url url in
137
137
let url = normalize_url url in
138
138
let target_eio = Eio.Path.(fs / Fpath.to_string target) in
···
169
169
end
170
170
171
171
(** Import all entries from a lock file *)
172
-
let import_from_lock ~proc ~fs ~target ~lock_path ~dry_run =
172
+
let from_lock ~proc ~fs ~target ~lock_path ~dry_run =
173
173
let lock_dir = Fpath.parent lock_path in
174
174
match Mono_lock.load ~fs lock_dir with
175
175
| Error e -> Error e
···
184
184
List.map
185
185
(fun (name, entry) ->
186
186
let result =
187
-
import_git_url ~proc ~fs ~target ~url:entry.Mono_lock.url
188
-
~branch:None ~ref_:(Some entry.Mono_lock.ref_)
189
-
~name:(Some name) ~dry_run
187
+
git_url ~proc ~fs ~target ~url:entry.Mono_lock.url ~branch:None
188
+
~ref_:(Some entry.Mono_lock.ref_) ~name:(Some name) ~dry_run
190
189
in
191
190
(name, result))
192
191
imports
···
213
212
let run ~proc ~fs ~target ~source ~name ~dry_run () =
214
213
match source with
215
214
| Git_url { url; branch; ref_ } -> (
216
-
match
217
-
import_git_url ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run
218
-
with
215
+
match git_url ~proc ~fs ~target ~url ~branch ~ref_ ~name ~dry_run with
219
216
| Error e -> Error e
220
217
| Ok result ->
221
218
(* Update lock file *)
···
240
237
Log.warn (fun m -> m "Failed to update mono.lock: %s" e)
241
238
end;
242
239
Ok [ result ])
243
-
| Lock_file path ->
244
-
import_from_lock ~proc ~fs ~target ~lock_path:path ~dry_run
240
+
| Lock_file path -> from_lock ~proc ~fs ~target ~lock_path:path ~dry_run
+2
-2
lib/import.mli
+2
-2
lib/import.mli
···
9
9
| Git_url of { url : string; branch : string option; ref_ : string option }
10
10
| Lock_file of Fpath.t
11
11
12
-
type import_result = {
12
+
type result = {
13
13
name : string; (** Directory name of the imported subtree *)
14
14
commit : string; (** Full commit SHA that was imported *)
15
15
added : bool; (** true if newly added, false if already exists *)
···
34
34
name:string option ->
35
35
dry_run:bool ->
36
36
unit ->
37
-
(import_result list, string) result
37
+
(result list, string) Stdlib.result
38
38
(** [run ~proc ~fs ~target ~source ~name ~dry_run ()] imports a git repository
39
39
as a subtree into [target].
40
40
+1
-1
lib/monopam.ml
+1
-1
lib/monopam.ml
+1
-1
lib/pull.ml
+1
-1
lib/pull.ml
···
76
76
77
77
(** {1 Main Pull Operation} *)
78
78
79
-
let pull ~proc ~fs ~config ?(packages = []) ?opam_repo_url () =
79
+
let run ~proc ~fs ~config ?(packages = []) ?opam_repo_url () =
80
80
let fs_t = Ctx.fs_typed fs in
81
81
let opam_repo = Config.Paths.opam_repo config in
82
82
if Git.Repository.is_repo ~fs:fs_t opam_repo then begin
+2
-2
lib/pull.mli
+2
-2
lib/pull.mli
···
17
17
(** [subtree ~proc ~fs ~config pkg] merges or adds the subtree for [pkg].
18
18
Returns [true] if the subtree was newly added. *)
19
19
20
-
val pull :
20
+
val run :
21
21
proc:_ Eio.Process.mgr ->
22
22
fs:Eio.Fs.dir_ty Eio.Path.t ->
23
23
config:Config.t ->
···
25
25
?opam_repo_url:string ->
26
26
unit ->
27
27
(unit, Ctx.error) Stdlib.result
28
-
(** [pull ~proc ~fs ~config ()] fetches checkouts and merges subtrees. *)
28
+
(** [run ~proc ~fs ~config ()] fetches checkouts and merges subtrees. *)
+1
-1
lib/push.ml
+1
-1
lib/push.ml
···
127
127
128
128
(** {1 Main Push Operation} *)
129
129
130
-
let push ~proc ~fs ~config ?(packages = []) ?(upstream = false) ?(clean = false)
130
+
let run ~proc ~fs ~config ?(packages = []) ?(upstream = false) ?(clean = false)
131
131
?(force = false) () =
132
132
let fs_t = Ctx.fs_typed fs in
133
133
Ctx.ensure_checkouts_dir ~fs:fs_t ~config;
+2
-2
lib/push.mli
+2
-2
lib/push.mli
···
1
1
(** Push operations for exporting monorepo changes to checkouts and upstream. *)
2
2
3
-
val push :
3
+
val run :
4
4
proc:_ Eio.Process.mgr ->
5
5
fs:Eio.Fs.dir_ty Eio.Path.t ->
6
6
config:Config.t ->
···
10
10
?force:bool ->
11
11
unit ->
12
12
(unit, Ctx.error) result
13
-
(** [push ~proc ~fs ~config ()] exports changes via subtree split and pushes to
13
+
(** [run ~proc ~fs ~config ()] exports changes via subtree split and pushes to
14
14
local checkouts and optionally to remote upstreams. *)
+1
-1
lib/remote_cache.ml
+1
-1
lib/remote_cache.ml
+4
-4
lib/remote_cache.mli
+4
-4
lib/remote_cache.mli
···
29
29
Remote_cache.set cache ~url ~branch:"trunk" ~hash:"abc123";
30
30
31
31
(* Get it back immediately *)
32
-
assert (Remote_cache.get cache ~url ~branch:"trunk" = Some "abc123");
32
+
assert (Remote_cache.find cache ~url ~branch:"trunk" = Some "abc123");
33
33
34
34
(* Advance time past TTL *)
35
35
time := 61.0;
36
-
assert (Remote_cache.get cache ~url ~branch:"trunk" = None)
36
+
assert (Remote_cache.find cache ~url ~branch:"trunk" = None)
37
37
]} *)
38
38
39
39
type t
···
59
59
@param now Function to get current time in seconds.
60
60
@param content Serialized cache content from {!to_string}. *)
61
61
62
-
val get : t -> url:Uri.t -> branch:string -> string option
63
-
(** [get t ~url ~branch] returns the cached hash if present and not expired.
62
+
val find : t -> url:Uri.t -> branch:string -> string option
63
+
(** [find t ~url ~branch] returns the cached hash if present and not expired.
64
64
O(1) amortized time complexity. *)
65
65
66
66
val set : t -> url:Uri.t -> branch:string -> hash:string -> unit
+1
-1
lib/remove.ml
+1
-1
lib/remove.ml
+2
-2
lib/remove.mli
+2
-2
lib/remove.mli
···
1
1
(** Remove a package subtree from the monorepo. *)
2
2
3
-
val remove :
3
+
val run :
4
4
fs:Eio.Fs.dir_ty Eio.Path.t ->
5
5
config:Config.t ->
6
6
package:string ->
7
7
unit ->
8
8
(unit, Ctx.error) result
9
-
(** [remove ~fs ~config ~package ()] deletes the subtree directory from the
9
+
(** [run ~fs ~config ~package ()] deletes the subtree directory from the
10
10
monorepo. Does not affect the opam overlay or upstream repository. *)
+3
-3
lib/site.ml
+3
-3
lib/site.ml
···
32
32
}
33
33
(** Information about a verse member *)
34
34
35
-
type site_data = {
35
+
type data = {
36
36
local_handle : string;
37
37
registry_name : string;
38
38
registry_description : string option;
···
303
303
| Forks.Not_fetched -> "?"
304
304
305
305
(** CSS styles for the site *)
306
-
let site_css =
306
+
let css =
307
307
{|* { margin: 0; padding: 0; box-sizing: border-box; }
308
308
body { font: 10pt/1.4 -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; color: #333; max-width: 900px; margin: 0 auto; padding: 12px; }
309
309
h1 { font-size: 14pt; font-weight: 600; margin-bottom: 4px; }
···
495
495
"<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n";
496
496
add (Fmt.str "<title>%s</title>\n" (html_escape data.registry_name));
497
497
add "<style>\n";
498
-
add site_css;
498
+
add css;
499
499
add "\n</style>\n</head>\n<body>\n";
500
500
501
501
add (Fmt.str "<h1>%s</h1>\n" (html_escape data.registry_name));
+2
-2
lib/site.mli
+2
-2
lib/site.mli
···
39
39
}
40
40
(** Information about a verse member *)
41
41
42
-
type site_data = {
42
+
type data = {
43
43
local_handle : string;
44
44
registry_name : string;
45
45
registry_description : string option;
···
58
58
?forks:Forks.t ->
59
59
registry:Verse_registry.t ->
60
60
unit ->
61
-
site_data
61
+
data
62
62
(** [collect_data ~fs ~config ?forks ~registry ()] scans the workspace and verse
63
63
members to collect package information for the site. If [forks] is provided,
64
64
includes fork status information for each repository. *)
+2
-2
lib/verse.ml
+2
-2
lib/verse.ml
···
139
139
140
140
let init ~proc ~fs ~root ~handle () =
141
141
(* Check if config already exists in XDG *)
142
-
let config_file = Verse_config.config_file () in
142
+
let config_file = Verse_config.file () in
143
143
Logs.info (fun m -> m "Config file: %a" Fpath.pp config_file);
144
144
if is_file ~fs config_file then begin
145
145
Logs.err (fun m -> m "Config already exists at %a" Fpath.pp config_file);
···
420
420
421
421
(** Get subtrees from all tracked verse members. Returns a map from subtree name
422
422
to list of (handle, monorepo_path) pairs. *)
423
-
let verse_subtrees ~fs ~config () =
423
+
let subtrees ~fs ~config () =
424
424
let verse_path = Verse_config.verse_path config in
425
425
let tracked_handles = tracked_handles ~fs config in
426
426
let subtree_map = Hashtbl.create 64 in
+3
-3
lib/verse.mli
+3
-3
lib/verse.mli
···
133
133
134
134
Filters out hidden directories, _build, node_modules, etc. *)
135
135
136
-
val verse_subtrees :
136
+
val subtrees :
137
137
fs:Eio.Fs.dir_ty Eio.Path.t ->
138
138
config:Verse_config.t ->
139
139
unit ->
140
140
(string, (string * Fpath.t) list) Hashtbl.t
141
-
(** [verse_subtrees ~fs ~config ()] scans all tracked verse members and returns
142
-
a map from subtree name to list of (handle, monorepo_path) pairs.
141
+
(** [subtrees ~fs ~config ()] scans all tracked verse members and returns a map
142
+
from subtree name to list of (handle, monorepo_path) pairs.
143
143
144
144
This allows finding which verse users have a particular repo. *)
145
145
+33
-33
test/test_remote_cache.ml
+33
-33
test/test_remote_cache.ml
···
6
6
let test_url2 = Uri.of_string "https://github.com/mirage/mirage.git"
7
7
8
8
(* Mock clock for deterministic testing *)
9
-
let make_mock_clock () =
9
+
let mock_clock () =
10
10
let time = ref 0.0 in
11
11
let now () = !time in
12
12
let advance dt = time := !time +. dt in
···
14
14
(now, advance, set)
15
15
16
16
let test_empty_cache () =
17
-
let now, _, _ = make_mock_clock () in
17
+
let now, _, _ = mock_clock () in
18
18
let cache = Remote_cache.v ~now () in
19
19
Alcotest.(check int) "empty cache" 0 (Remote_cache.size cache);
20
20
Alcotest.(check (option string))
21
21
"get from empty" None
22
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
22
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
23
23
24
24
let test_set_get () =
25
-
let now, _, _ = make_mock_clock () in
25
+
let now, _, _ = mock_clock () in
26
26
let cache = Remote_cache.v ~now () in
27
27
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
28
28
Alcotest.(check int) "size after set" 1 (Remote_cache.size cache);
29
29
Alcotest.(check (option string))
30
30
"get after set" (Some "abc123")
31
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
31
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
32
32
33
33
let test_different_branches () =
34
-
let now, _, _ = make_mock_clock () in
34
+
let now, _, _ = mock_clock () in
35
35
let cache = Remote_cache.v ~now () in
36
36
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"main123";
37
37
Remote_cache.set cache ~url:test_url ~branch:"develop" ~hash:"dev456";
38
38
Alcotest.(check int) "size with two branches" 2 (Remote_cache.size cache);
39
39
Alcotest.(check (option string))
40
40
"get main" (Some "main123")
41
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
41
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
42
42
Alcotest.(check (option string))
43
43
"get develop" (Some "dev456")
44
-
(Remote_cache.get cache ~url:test_url ~branch:"develop")
44
+
(Remote_cache.find cache ~url:test_url ~branch:"develop")
45
45
46
46
let test_different_urls () =
47
-
let now, _, _ = make_mock_clock () in
47
+
let now, _, _ = mock_clock () in
48
48
let cache = Remote_cache.v ~now () in
49
49
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"ocaml123";
50
50
Remote_cache.set cache ~url:test_url2 ~branch:"main" ~hash:"mirage456";
51
51
Alcotest.(check int) "size with two urls" 2 (Remote_cache.size cache);
52
52
Alcotest.(check (option string))
53
53
"get ocaml" (Some "ocaml123")
54
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
54
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
55
55
Alcotest.(check (option string))
56
56
"get mirage" (Some "mirage456")
57
-
(Remote_cache.get cache ~url:test_url2 ~branch:"main")
57
+
(Remote_cache.find cache ~url:test_url2 ~branch:"main")
58
58
59
59
let test_update_existing () =
60
-
let now, _, _ = make_mock_clock () in
60
+
let now, _, _ = mock_clock () in
61
61
let cache = Remote_cache.v ~now () in
62
62
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"old123";
63
63
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"new456";
64
64
Alcotest.(check int) "size after update" 1 (Remote_cache.size cache);
65
65
Alcotest.(check (option string))
66
66
"get updated value" (Some "new456")
67
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
67
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
68
68
69
69
let test_expiration () =
70
-
let now, advance, _ = make_mock_clock () in
70
+
let now, advance, _ = mock_clock () in
71
71
let ttl = 60.0 in
72
72
let cache = Remote_cache.v ~ttl ~now () in
73
73
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
74
74
(* Still valid *)
75
75
Alcotest.(check (option string))
76
76
"before expiry" (Some "abc123")
77
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
77
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
78
78
(* Advance time but still within TTL *)
79
79
advance 30.0;
80
80
Alcotest.(check (option string))
81
81
"half way" (Some "abc123")
82
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
82
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
83
83
(* Advance past TTL *)
84
84
advance 31.0;
85
85
Alcotest.(check (option string))
86
86
"after expiry" None
87
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
87
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
88
88
89
89
let test_expiration_boundary () =
90
-
let now, advance, _ = make_mock_clock () in
90
+
let now, advance, _ = mock_clock () in
91
91
let ttl = 60.0 in
92
92
let cache = Remote_cache.v ~ttl ~now () in
93
93
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
···
95
95
advance 59.999;
96
96
Alcotest.(check (option string))
97
97
"just before expiry" (Some "abc123")
98
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
98
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
99
99
(* Exactly at TTL boundary - expired (uses strict > comparison) *)
100
100
advance 0.001;
101
101
Alcotest.(check (option string))
102
102
"at boundary" None
103
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
103
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
104
104
105
105
let test_refresh_extends_ttl () =
106
-
let now, advance, _ = make_mock_clock () in
106
+
let now, advance, _ = mock_clock () in
107
107
let ttl = 60.0 in
108
108
let cache = Remote_cache.v ~ttl ~now () in
109
109
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
···
111
111
advance 50.0;
112
112
Alcotest.(check (option string))
113
113
"still valid" (Some "abc123")
114
-
(Remote_cache.get cache ~url:test_url ~branch:"main");
114
+
(Remote_cache.find cache ~url:test_url ~branch:"main");
115
115
(* Refresh the entry *)
116
116
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
117
117
(* Advance another 50 seconds (would be expired without refresh) *)
118
118
advance 50.0;
119
119
Alcotest.(check (option string))
120
120
"valid after refresh" (Some "abc123")
121
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
121
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
122
122
123
123
let test_clear () =
124
-
let now, _, _ = make_mock_clock () in
124
+
let now, _, _ = mock_clock () in
125
125
let cache = Remote_cache.v ~now () in
126
126
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
127
127
Remote_cache.set cache ~url:test_url2 ~branch:"main" ~hash:"def456";
···
130
130
Alcotest.(check int) "after clear" 0 (Remote_cache.size cache);
131
131
Alcotest.(check (option string))
132
132
"get after clear" None
133
-
(Remote_cache.get cache ~url:test_url ~branch:"main")
133
+
(Remote_cache.find cache ~url:test_url ~branch:"main")
134
134
135
135
let test_serialization () =
136
-
let now, _, _ = make_mock_clock () in
136
+
let now, _, _ = mock_clock () in
137
137
let cache = Remote_cache.v ~now () in
138
138
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"abc123";
139
139
Remote_cache.set cache ~url:test_url ~branch:"develop" ~hash:"def456";
···
143
143
Alcotest.(check int) "size after reload" 2 (Remote_cache.size cache2);
144
144
Alcotest.(check (option string))
145
145
"main after reload" (Some "abc123")
146
-
(Remote_cache.get cache2 ~url:test_url ~branch:"main");
146
+
(Remote_cache.find cache2 ~url:test_url ~branch:"main");
147
147
Alcotest.(check (option string))
148
148
"develop after reload" (Some "def456")
149
-
(Remote_cache.get cache2 ~url:test_url ~branch:"develop")
149
+
(Remote_cache.find cache2 ~url:test_url ~branch:"develop")
150
150
151
151
let test_serialization_excludes_expired () =
152
-
let now, advance, set = make_mock_clock () in
152
+
let now, advance, set = mock_clock () in
153
153
let ttl = 60.0 in
154
154
let cache = Remote_cache.v ~ttl ~now () in
155
155
Remote_cache.set cache ~url:test_url ~branch:"main" ~hash:"fresh";
···
165
165
Alcotest.(check int) "only fresh entry" 1 (Remote_cache.size cache2);
166
166
Alcotest.(check (option string))
167
167
"expired not saved" None
168
-
(Remote_cache.get cache2 ~url:test_url ~branch:"main");
168
+
(Remote_cache.find cache2 ~url:test_url ~branch:"main");
169
169
Alcotest.(check (option string))
170
170
"fresh saved" (Some "newer")
171
-
(Remote_cache.get cache2 ~url:test_url ~branch:"develop")
171
+
(Remote_cache.find cache2 ~url:test_url ~branch:"develop")
172
172
173
173
let test_many_entries () =
174
-
let now, _, _ = make_mock_clock () in
174
+
let now, _, _ = mock_clock () in
175
175
let cache = Remote_cache.v ~now () in
176
176
for i = 0 to 999 do
177
177
let url =
···
184
184
let url = Uri.of_string "https://example.com/repo500.git" in
185
185
Alcotest.(check (option string))
186
186
"get entry 500" (Some "hash500")
187
-
(Remote_cache.get cache ~url ~branch:"main")
187
+
(Remote_cache.find cache ~url ~branch:"main")
188
188
189
189
let test_default_ttl () =
190
190
Alcotest.(check (float 0.1))
+2
-2
test/test_status.ml
+2
-2
test/test_status.ml
···
4
4
module Package = Monopam.Package
5
5
6
6
(* Helper to create a test package *)
7
-
let make_package name =
7
+
let package name =
8
8
let dev_repo = Uri.of_string ("https://github.com/test/" ^ name ^ ".git") in
9
9
Package.v ~name ~version:"dev" ~dev_repo ()
10
10
11
11
(* Helper to create a status with given parameters *)
12
12
let make_status ?(checkout = Status.Missing) ?(subtree = Status.Not_added)
13
13
?(subtree_sync = Status.Unknown) name =
14
-
let package = make_package name in
14
+
let package = package name in
15
15
{ Status.package; checkout; subtree; subtree_sync }
16
16
17
17
(* Test predicates *)