anil.recoil.org
A monorepo management tool for the agentic ages
iint
+5
bin/dune
+5
bin/dune
+801
bin/main.ml
+801
bin/main.ml
···
···
1
+
open Cmdliner
2
+
3
+
(* Logging setup *)
4
+
5
+
let setup_logging style_renderer level =
6
+
Fmt_tty.setup_std_outputs ?style_renderer ();
7
+
Logs.set_level level;
8
+
Logs.set_reporter (Logs_fmt.reporter ());
9
+
()
10
+
11
+
let logging_term =
12
+
Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ())
13
+
14
+
(* Common options *)
15
+
16
+
let config_file =
17
+
let doc = "Path to unpac.toml config file." in
18
+
Arg.(value & opt file "unpac.toml" & info [ "c"; "config" ] ~doc ~docv:"FILE")
19
+
20
+
let cache_dir_term =
21
+
let app_env = "UNPAC_CACHE_DIR" in
22
+
let xdg_var = "XDG_CACHE_HOME" in
23
+
let home = Sys.getenv "HOME" in
24
+
let default_path = home ^ "/.cache/unpac" in
25
+
let doc =
26
+
Printf.sprintf
27
+
"Override cache directory. Can also be set with %s or %s. Default: %s"
28
+
app_env xdg_var default_path
29
+
in
30
+
let arg =
31
+
Arg.(value & opt string default_path & info [ "cache-dir" ] ~docv:"DIR" ~doc)
32
+
in
33
+
Term.(
34
+
const (fun cmdline_val ->
35
+
if cmdline_val <> default_path then cmdline_val
36
+
else
37
+
match Sys.getenv_opt app_env with
38
+
| Some v when v <> "" -> v
39
+
| _ -> (
40
+
match Sys.getenv_opt xdg_var with
41
+
| Some v when v <> "" -> v ^ "/unpac"
42
+
| _ -> default_path))
43
+
$ arg)
44
+
45
+
(* Output format selection *)
46
+
type output_format = Text | Json | Toml
47
+
48
+
let output_format_term =
49
+
let json =
50
+
let doc = "Output in JSON format." in
51
+
Arg.(value & flag & info [ "json" ] ~doc)
52
+
in
53
+
let toml =
54
+
let doc = "Output in TOML format." in
55
+
Arg.(value & flag & info [ "toml" ] ~doc)
56
+
in
57
+
let select json toml =
58
+
match (json, toml) with
59
+
| true, false -> Json
60
+
| false, true -> Toml
61
+
| false, false -> Text
62
+
| true, true ->
63
+
Format.eprintf "Cannot use both --json and --toml@.";
64
+
Text
65
+
in
66
+
Term.(const select $ json $ toml)
67
+
68
+
let get_format = function
69
+
| Text -> Unpac.Output.Text
70
+
| Json -> Unpac.Output.Json
71
+
| Toml -> Unpac.Output.Toml
72
+
73
+
(* Helper to load index from config with caching *)
74
+
75
+
let load_index ~fs ~cache_dir config_path =
76
+
let cache_path = Eio.Path.(fs / cache_dir) in
77
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 cache_path;
78
+
Unpac.Cache.load_index ~cache_dir:cache_path ~config_path
79
+
80
+
(* Get compiler spec from config *)
81
+
let get_compiler_spec config_path =
82
+
try
83
+
let config = Unpac.Config.load_exn config_path in
84
+
match config.opam.compiler with
85
+
| Some s -> Unpac.Solver.parse_compiler_spec s
86
+
| None -> None
87
+
with _ -> None
88
+
89
+
(* Source kind selection *)
90
+
let source_kind_term =
91
+
let git =
92
+
let doc = "Get git/dev-repo URLs instead of archive URLs." in
93
+
Arg.(value & flag & info [ "git" ] ~doc)
94
+
in
95
+
Term.(
96
+
const (fun git ->
97
+
if git then Unpac.Source.Git else Unpac.Source.Archive)
98
+
$ git)
99
+
100
+
(* Resolve dependencies flag *)
101
+
let resolve_deps_term =
102
+
let doc = "Resolve dependencies using the 0install solver." in
103
+
Arg.(value & flag & info [ "deps"; "with-deps" ] ~doc)
104
+
105
+
(* ============================================================================
106
+
INIT COMMAND
107
+
============================================================================ *)
108
+
109
+
let init_cmd =
110
+
let doc = "Initialize a new unpac repository." in
111
+
let man = [
112
+
`S Manpage.s_description;
113
+
`P "Initializes a new git repository with unpac project structure.";
114
+
`P "Creates the main branch with a project registry.";
115
+
] in
116
+
let run () =
117
+
Eio_main.run @@ fun env ->
118
+
let cwd = Eio.Stdenv.cwd env in
119
+
let proc_mgr = Eio.Stdenv.process_mgr env in
120
+
Unpac.Project.init ~proc_mgr ~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t);
121
+
Format.printf "Repository initialized.@.";
122
+
Format.printf "Create a project with: unpac project create <name>@."
123
+
in
124
+
let info = Cmd.info "init" ~doc ~man in
125
+
Cmd.v info Term.(const run $ logging_term)
126
+
127
+
(* ============================================================================
128
+
PROJECT COMMANDS
129
+
============================================================================ *)
130
+
131
+
let project_name_arg =
132
+
let doc = "Project name." in
133
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc)
134
+
135
+
let project_desc_opt =
136
+
let doc = "Project description." in
137
+
Arg.(value & opt (some string) None & info ["d"; "description"] ~docv:"DESC" ~doc)
138
+
139
+
let project_create_cmd =
140
+
let doc = "Create a new project." in
141
+
let man = [
142
+
`S Manpage.s_description;
143
+
`P "Creates a new project branch and switches to it.";
144
+
`P "The project is registered in the main branch's unpac.toml.";
145
+
] in
146
+
let run () name description =
147
+
Eio_main.run @@ fun env ->
148
+
let cwd = Eio.Stdenv.cwd env in
149
+
let proc_mgr = Eio.Stdenv.process_mgr env in
150
+
let description = match description with Some d -> d | None -> "" in
151
+
Unpac.Project.create ~proc_mgr ~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t)
152
+
~name ~description ()
153
+
in
154
+
let info = Cmd.info "create" ~doc ~man in
155
+
Cmd.v info Term.(const run $ logging_term $ project_name_arg $ project_desc_opt)
156
+
157
+
let project_list_cmd =
158
+
let doc = "List all projects." in
159
+
let man = [
160
+
`S Manpage.s_description;
161
+
`P "Lists all projects in the repository.";
162
+
] in
163
+
let run () =
164
+
Eio_main.run @@ fun env ->
165
+
let cwd = Eio.Stdenv.cwd env in
166
+
let proc_mgr = Eio.Stdenv.process_mgr env in
167
+
let projects = Unpac.Project.list_projects ~proc_mgr
168
+
~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t) in
169
+
let current = Unpac.Project.current_project ~proc_mgr
170
+
~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t) in
171
+
if projects = [] then
172
+
Format.printf "No projects. Create one with: unpac project create <name>@."
173
+
else begin
174
+
Format.printf "Projects:@.";
175
+
List.iter (fun (p : Unpac.Project.project_info) ->
176
+
let marker = if Some p.name = current then "* " else " " in
177
+
Format.printf "%s%s (%s)@." marker p.name p.branch
178
+
) projects
179
+
end
180
+
in
181
+
let info = Cmd.info "list" ~doc ~man in
182
+
Cmd.v info Term.(const run $ logging_term)
183
+
184
+
let project_switch_cmd =
185
+
let doc = "Switch to a project." in
186
+
let man = [
187
+
`S Manpage.s_description;
188
+
`P "Switches to the specified project's branch.";
189
+
] in
190
+
let run () name =
191
+
Eio_main.run @@ fun env ->
192
+
let cwd = Eio.Stdenv.cwd env in
193
+
let proc_mgr = Eio.Stdenv.process_mgr env in
194
+
Unpac.Project.switch ~proc_mgr ~cwd:(cwd :> Eio.Fs.dir_ty Eio.Path.t) name
195
+
in
196
+
let info = Cmd.info "switch" ~doc ~man in
197
+
Cmd.v info Term.(const run $ logging_term $ project_name_arg)
198
+
199
+
let project_cmd =
200
+
let doc = "Project management commands." in
201
+
let man = [
202
+
`S Manpage.s_description;
203
+
`P "Commands for managing projects (branches).";
204
+
] in
205
+
let info = Cmd.info "project" ~doc ~man in
206
+
Cmd.group info [project_create_cmd; project_list_cmd; project_switch_cmd]
207
+
208
+
(* ============================================================================
209
+
ADD COMMANDS
210
+
============================================================================ *)
211
+
212
+
let package_name_arg =
213
+
let doc = "Package name to add." in
214
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
215
+
216
+
let add_opam_cmd =
217
+
let doc = "Add a package from opam." in
218
+
let man = [
219
+
`S Manpage.s_description;
220
+
`P "Adds a package from opam, creating vendor branches and merging into the current project.";
221
+
`P "Must be on a project branch (not main).";
222
+
`P "Use --with-deps to include all transitive dependencies.";
223
+
`S Manpage.s_examples;
224
+
`P "Add a single package:";
225
+
`Pre " unpac add opam eio";
226
+
`P "Add a package with all dependencies:";
227
+
`Pre " unpac add opam lwt --with-deps";
228
+
] in
229
+
let run () config_path cache_dir resolve_deps pkg_name =
230
+
Eio_main.run @@ fun env ->
231
+
let fs = Eio.Stdenv.fs env in
232
+
let cwd = Eio.Stdenv.cwd env in
233
+
let proc_mgr = Eio.Stdenv.process_mgr env in
234
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
235
+
236
+
(* Check we're on a project branch *)
237
+
let _project = Unpac.Project.require_project_branch ~proc_mgr ~cwd:cwd_path in
238
+
239
+
(* Check for pending recovery *)
240
+
if Unpac.Recovery.has_recovery ~cwd:cwd_path then begin
241
+
Format.eprintf "There's a pending operation. Run 'unpac vendor continue' or 'unpac vendor abort'.@.";
242
+
exit 1
243
+
end;
244
+
245
+
(* Load opam index *)
246
+
let index = load_index ~fs ~cache_dir config_path in
247
+
let compiler = get_compiler_spec config_path in
248
+
249
+
(* Parse package spec *)
250
+
let spec = match Unpac.Solver.parse_package_spec pkg_name with
251
+
| Ok s -> s
252
+
| Error msg ->
253
+
Format.eprintf "Invalid package spec: %s@." msg;
254
+
exit 1
255
+
in
256
+
257
+
(* Get packages to add *)
258
+
let packages_to_add =
259
+
if resolve_deps then begin
260
+
match Unpac.Solver.select_with_deps ?compiler index [spec] with
261
+
| Ok selection -> selection.packages
262
+
| Error msg ->
263
+
Format.eprintf "Error resolving dependencies: %s@." msg;
264
+
exit 1
265
+
end else begin
266
+
match Unpac.Solver.select_packages index [spec] with
267
+
| Ok selection -> selection.packages
268
+
| Error msg ->
269
+
Format.eprintf "Error selecting package: %s@." msg;
270
+
exit 1
271
+
end
272
+
in
273
+
274
+
if packages_to_add = [] then begin
275
+
Format.eprintf "Package '%s' not found.@." pkg_name;
276
+
exit 1
277
+
end;
278
+
279
+
(* Group packages by dev-repo *)
280
+
let sources = Unpac.Source.extract_all Unpac.Source.Git packages_to_add in
281
+
let grouped = Unpac.Source.group_by_dev_repo sources in
282
+
283
+
Format.printf "Found %d package group(s) to vendor:@." (List.length grouped);
284
+
285
+
(* Add each group *)
286
+
List.iter (fun (group : Unpac.Source.grouped_sources) ->
287
+
match group.dev_repo with
288
+
| None ->
289
+
Format.printf " Skipping packages without dev-repo@."
290
+
| Some dev_repo ->
291
+
let url_str = Unpac.Dev_repo.to_string dev_repo in
292
+
let opam_packages = List.map (fun (p : Unpac.Source.package_source) -> p.name) group.packages in
293
+
294
+
(* Use first package name as canonical name, or extract from URL *)
295
+
let name =
296
+
match opam_packages with
297
+
| first :: _ -> first
298
+
| [] -> "unknown"
299
+
in
300
+
301
+
(* Reconstruct full URL for git clone *)
302
+
let url =
303
+
let first_pkg = List.hd group.packages in
304
+
match first_pkg.source with
305
+
| Unpac.Source.GitSource g -> g.url
306
+
| _ -> "https://" ^ url_str (* Fallback *)
307
+
in
308
+
309
+
Format.printf " Adding %s (%d packages: %s)@."
310
+
name (List.length opam_packages)
311
+
(String.concat ", " opam_packages);
312
+
313
+
(* Detect default branch *)
314
+
let branch = Unpac.Git.ls_remote_default_branch ~proc_mgr ~url in
315
+
316
+
match Unpac.Vendor.add_package ~proc_mgr ~cwd:cwd_path
317
+
~name ~url ~branch ~opam_packages with
318
+
| Unpac.Vendor.Success { canonical_name; opam_packages; _ } ->
319
+
Format.printf " [OK] Added %s (%d opam packages)@."
320
+
canonical_name (List.length opam_packages)
321
+
| Unpac.Vendor.Already_vendored name ->
322
+
Format.printf " [SKIP] %s already vendored@." name
323
+
| Unpac.Vendor.Failed { step; recovery_hint; error } ->
324
+
Format.eprintf " [FAIL] Failed at step '%s': %s@." step
325
+
(Printexc.to_string error);
326
+
Format.eprintf " %s@." recovery_hint;
327
+
exit 1
328
+
) grouped;
329
+
330
+
Format.printf "Done.@."
331
+
in
332
+
let info = Cmd.info "opam" ~doc ~man in
333
+
Cmd.v info Term.(const run $ logging_term $ config_file $ cache_dir_term
334
+
$ resolve_deps_term $ package_name_arg)
335
+
336
+
let add_cmd =
337
+
let doc = "Add packages to the project." in
338
+
let man = [
339
+
`S Manpage.s_description;
340
+
`P "Commands for adding packages from various sources.";
341
+
] in
342
+
let info = Cmd.info "add" ~doc ~man in
343
+
Cmd.group info [add_opam_cmd]
344
+
345
+
(* ============================================================================
346
+
VENDOR COMMANDS
347
+
============================================================================ *)
348
+
349
+
let vendor_package_arg =
350
+
let doc = "Package name." in
351
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
352
+
353
+
let vendor_status_cmd =
354
+
let doc = "Show status of vendored packages." in
355
+
let man = [
356
+
`S Manpage.s_description;
357
+
`P "Shows the status of all vendored packages including their SHAs and patch counts.";
358
+
] in
359
+
let run () =
360
+
Eio_main.run @@ fun env ->
361
+
let cwd = Eio.Stdenv.cwd env in
362
+
let proc_mgr = Eio.Stdenv.process_mgr env in
363
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
364
+
365
+
let statuses = Unpac.Vendor.all_status ~proc_mgr ~cwd:cwd_path in
366
+
367
+
if statuses = [] then begin
368
+
Format.printf "No vendored packages.@.";
369
+
Format.printf "Add packages with: unpac add opam <pkg>@."
370
+
end else begin
371
+
(* Print header *)
372
+
Format.printf "%-20s %-12s %-12s %-8s %-8s@."
373
+
"PACKAGE" "UPSTREAM" "VENDOR" "PATCHES" "MERGED";
374
+
Format.printf "%-20s %-12s %-12s %-8s %-8s@."
375
+
"-------" "--------" "------" "-------" "------";
376
+
377
+
List.iter (fun (s : Unpac.Vendor.package_status) ->
378
+
let upstream = match s.upstream_sha with Some x -> x | None -> "-" in
379
+
let vendor = match s.vendor_sha with Some x -> x | None -> "-" in
380
+
let patches = string_of_int s.patch_count in
381
+
let merged = if s.in_project then "yes" else "no" in
382
+
Format.printf "%-20s %-12s %-12s %-8s %-8s@."
383
+
s.name upstream vendor patches merged
384
+
) statuses
385
+
end
386
+
in
387
+
let info = Cmd.info "status" ~doc ~man in
388
+
Cmd.v info Term.(const run $ logging_term)
389
+
390
+
let vendor_update_cmd =
391
+
let doc = "Update a vendored package from upstream." in
392
+
let man = [
393
+
`S Manpage.s_description;
394
+
`P "Fetches the latest changes from upstream and updates the vendor branch.";
395
+
`P "After updating, use 'unpac vendor rebase <pkg>' to rebase your patches.";
396
+
] in
397
+
let run () name =
398
+
Eio_main.run @@ fun env ->
399
+
let cwd = Eio.Stdenv.cwd env in
400
+
let proc_mgr = Eio.Stdenv.process_mgr env in
401
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
402
+
403
+
match Unpac.Vendor.update_package ~proc_mgr ~cwd:cwd_path ~name with
404
+
| Unpac.Vendor.Updated { old_sha; new_sha; commit_count } ->
405
+
let old_short = String.sub old_sha 0 7 in
406
+
let new_short = String.sub new_sha 0 7 in
407
+
Format.printf "[OK] Updated %s: %s -> %s (%d commits)@."
408
+
name old_short new_short commit_count;
409
+
Format.printf "Next: unpac vendor rebase %s@." name
410
+
| Unpac.Vendor.No_changes ->
411
+
Format.printf "[OK] %s is up to date@." name
412
+
| Unpac.Vendor.Update_failed { step; error; recovery_hint } ->
413
+
Format.eprintf "[FAIL] Failed at step '%s': %s@." step
414
+
(Printexc.to_string error);
415
+
Format.eprintf "%s@." recovery_hint;
416
+
exit 1
417
+
in
418
+
let info = Cmd.info "update" ~doc ~man in
419
+
Cmd.v info Term.(const run $ logging_term $ vendor_package_arg)
420
+
421
+
let vendor_rebase_cmd =
422
+
let doc = "Rebase patches onto updated vendor branch." in
423
+
let man = [
424
+
`S Manpage.s_description;
425
+
`P "Rebases your patches on top of the updated vendor branch.";
426
+
`P "Run this after 'unpac vendor update <pkg>'.";
427
+
] in
428
+
let run () name =
429
+
Eio_main.run @@ fun env ->
430
+
let cwd = Eio.Stdenv.cwd env in
431
+
let proc_mgr = Eio.Stdenv.process_mgr env in
432
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
433
+
434
+
match Unpac.Vendor.rebase_patches ~proc_mgr ~cwd:cwd_path ~name with
435
+
| Ok () ->
436
+
Format.printf "[OK] Rebased %s@." name;
437
+
Format.printf "Next: unpac vendor merge %s@." name
438
+
| Error (`Conflict _hint) ->
439
+
Format.eprintf "[CONFLICT] Rebase has conflicts@.";
440
+
Format.eprintf "Resolve conflicts, then: git rebase --continue@.";
441
+
Format.eprintf "Or abort: git rebase --abort@.";
442
+
exit 1
443
+
in
444
+
let info = Cmd.info "rebase" ~doc ~man in
445
+
Cmd.v info Term.(const run $ logging_term $ vendor_package_arg)
446
+
447
+
let vendor_merge_cmd =
448
+
let doc = "Merge patches into current project branch." in
449
+
let man = [
450
+
`S Manpage.s_description;
451
+
`P "Merges the patches branch into the current project branch.";
452
+
] in
453
+
let run () name =
454
+
Eio_main.run @@ fun env ->
455
+
let cwd = Eio.Stdenv.cwd env in
456
+
let proc_mgr = Eio.Stdenv.process_mgr env in
457
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
458
+
459
+
match Unpac.Vendor.merge_to_project ~proc_mgr ~cwd:cwd_path ~name with
460
+
| Ok () ->
461
+
Format.printf "[OK] Merged %s into project@." name
462
+
| Error (`Conflict _files) ->
463
+
Format.eprintf "[CONFLICT] Merge has conflicts@.";
464
+
Format.eprintf "Resolve conflicts, then: git add <files> && git commit@.";
465
+
Format.eprintf "Or abort: git merge --abort@.";
466
+
exit 1
467
+
in
468
+
let info = Cmd.info "merge" ~doc ~man in
469
+
Cmd.v info Term.(const run $ logging_term $ vendor_package_arg)
470
+
471
+
let vendor_continue_cmd =
472
+
let doc = "Continue an interrupted operation." in
473
+
let man = [
474
+
`S Manpage.s_description;
475
+
`P "Continues an operation that was interrupted (e.g., by a conflict).";
476
+
`P "Run this after resolving conflicts.";
477
+
] in
478
+
let run () =
479
+
Eio_main.run @@ fun env ->
480
+
let cwd = Eio.Stdenv.cwd env in
481
+
let proc_mgr = Eio.Stdenv.process_mgr env in
482
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
483
+
484
+
match Unpac.Recovery.load ~cwd:cwd_path with
485
+
| None ->
486
+
Format.printf "No pending operation to continue.@."
487
+
| Some state ->
488
+
Format.printf "Continuing: %a@." Unpac.Recovery.pp_operation state.operation;
489
+
match Unpac.Vendor.continue ~proc_mgr ~cwd:cwd_path state with
490
+
| Unpac.Vendor.Success { canonical_name; _ } ->
491
+
Format.printf "[OK] Completed %s@." canonical_name
492
+
| Unpac.Vendor.Already_vendored name ->
493
+
Format.printf "[OK] %s already vendored@." name
494
+
| Unpac.Vendor.Failed { step; error; recovery_hint } ->
495
+
Format.eprintf "[FAIL] Failed at step '%s': %s@." step
496
+
(Printexc.to_string error);
497
+
Format.eprintf "%s@." recovery_hint;
498
+
exit 1
499
+
in
500
+
let info = Cmd.info "continue" ~doc ~man in
501
+
Cmd.v info Term.(const run $ logging_term)
502
+
503
+
let vendor_abort_cmd =
504
+
let doc = "Abort an interrupted operation." in
505
+
let man = [
506
+
`S Manpage.s_description;
507
+
`P "Aborts an operation and restores the repository to its previous state.";
508
+
] in
509
+
let run () =
510
+
Eio_main.run @@ fun env ->
511
+
let cwd = Eio.Stdenv.cwd env in
512
+
let proc_mgr = Eio.Stdenv.process_mgr env in
513
+
let cwd_path = (cwd :> Eio.Fs.dir_ty Eio.Path.t) in
514
+
515
+
match Unpac.Recovery.load ~cwd:cwd_path with
516
+
| None ->
517
+
Format.printf "No pending operation to abort.@."
518
+
| Some state ->
519
+
Format.printf "Aborting: %a@." Unpac.Recovery.pp_operation state.operation;
520
+
Unpac.Recovery.abort ~proc_mgr ~cwd:cwd_path state;
521
+
Format.printf "[OK] Aborted. Repository restored.@."
522
+
in
523
+
let info = Cmd.info "abort" ~doc ~man in
524
+
Cmd.v info Term.(const run $ logging_term)
525
+
526
+
let vendor_cmd =
527
+
let doc = "Vendor package management." in
528
+
let man = [
529
+
`S Manpage.s_description;
530
+
`P "Commands for managing vendored packages.";
531
+
] in
532
+
let info = Cmd.info "vendor" ~doc ~man in
533
+
Cmd.group info [
534
+
vendor_status_cmd;
535
+
vendor_update_cmd;
536
+
vendor_rebase_cmd;
537
+
vendor_merge_cmd;
538
+
vendor_continue_cmd;
539
+
vendor_abort_cmd;
540
+
]
541
+
542
+
(* ============================================================================
543
+
OPAM COMMANDS (existing)
544
+
============================================================================ *)
545
+
546
+
let opam_list_cmd =
547
+
let doc = "List packages in the merged repository." in
548
+
let man =
549
+
[
550
+
`S Manpage.s_description;
551
+
`P "Lists packages from all configured opam repositories.";
552
+
`P "If no packages are specified, lists all available packages.";
553
+
`P "Use --deps to include transitive dependencies.";
554
+
`S Manpage.s_examples;
555
+
`P "List all packages:";
556
+
`Pre " unpac opam list";
557
+
`P "List specific packages with dependencies:";
558
+
`Pre " unpac opam list --deps lwt cmdliner";
559
+
]
560
+
in
561
+
let run () config_path cache_dir format resolve_deps package_specs =
562
+
Eio_main.run @@ fun env ->
563
+
let fs = Eio.Stdenv.fs env in
564
+
let index = load_index ~fs ~cache_dir config_path in
565
+
let compiler = get_compiler_spec config_path in
566
+
let selection_result =
567
+
if package_specs = [] then Ok (Unpac.Solver.select_all index)
568
+
else if resolve_deps then Unpac.Solver.select_with_deps ?compiler index package_specs
569
+
else Unpac.Solver.select_packages index package_specs
570
+
in
571
+
match selection_result with
572
+
| Error msg ->
573
+
Format.eprintf "Error selecting packages: %s@." msg;
574
+
exit 1
575
+
| Ok selection ->
576
+
let packages =
577
+
List.sort
578
+
(fun (a : Unpac.Repo_index.package_info) b ->
579
+
let cmp = OpamPackage.Name.compare a.name b.name in
580
+
if cmp <> 0 then cmp
581
+
else OpamPackage.Version.compare a.version b.version)
582
+
selection.packages
583
+
in
584
+
Unpac.Output.output_package_list (get_format format) packages
585
+
in
586
+
let info = Cmd.info "list" ~doc ~man in
587
+
Cmd.v info
588
+
Term.(
589
+
const run $ logging_term $ config_file $ cache_dir_term $ output_format_term
590
+
$ resolve_deps_term $ Unpac.Solver.package_specs_term)
591
+
592
+
let opam_info_cmd =
593
+
let doc = "Show detailed information about packages." in
594
+
let man =
595
+
[
596
+
`S Manpage.s_description;
597
+
`P "Displays detailed information about the specified packages.";
598
+
`P "Use --deps to include transitive dependencies.";
599
+
`S Manpage.s_examples;
600
+
`P "Show info for a package:";
601
+
`Pre " unpac opam info lwt";
602
+
`P "Show info for packages and their dependencies:";
603
+
`Pre " unpac opam info --deps cmdliner";
604
+
]
605
+
in
606
+
let run () config_path cache_dir format resolve_deps package_specs =
607
+
Eio_main.run @@ fun env ->
608
+
let fs = Eio.Stdenv.fs env in
609
+
let index = load_index ~fs ~cache_dir config_path in
610
+
let compiler = get_compiler_spec config_path in
611
+
if package_specs = [] then begin
612
+
Format.eprintf "Please specify at least one package.@.";
613
+
exit 1
614
+
end;
615
+
let selection_result =
616
+
if resolve_deps then Unpac.Solver.select_with_deps ?compiler index package_specs
617
+
else Unpac.Solver.select_packages index package_specs
618
+
in
619
+
match selection_result with
620
+
| Error msg ->
621
+
Format.eprintf "Error selecting packages: %s@." msg;
622
+
exit 1
623
+
| Ok selection ->
624
+
if selection.packages = [] then
625
+
Format.eprintf "No packages found.@."
626
+
else Unpac.Output.output_package_info (get_format format) selection.packages
627
+
in
628
+
let info = Cmd.info "info" ~doc ~man in
629
+
Cmd.v info
630
+
Term.(
631
+
const run $ logging_term $ config_file $ cache_dir_term $ output_format_term
632
+
$ resolve_deps_term $ Unpac.Solver.package_specs_term)
633
+
634
+
let opam_related_cmd =
635
+
let doc = "Show packages sharing the same dev-repo." in
636
+
let man =
637
+
[
638
+
`S Manpage.s_description;
639
+
`P
640
+
"Lists all packages that share a development repository with the \
641
+
specified packages.";
642
+
`P "Use --deps to first resolve dependencies, then find related packages.";
643
+
`S Manpage.s_examples;
644
+
`P "Find related packages for a single package:";
645
+
`Pre " unpac opam related lwt";
646
+
`P "Find related packages including dependencies:";
647
+
`Pre " unpac opam related --deps cmdliner";
648
+
]
649
+
in
650
+
let run () config_path cache_dir format resolve_deps package_specs =
651
+
Eio_main.run @@ fun env ->
652
+
let fs = Eio.Stdenv.fs env in
653
+
let index = load_index ~fs ~cache_dir config_path in
654
+
let compiler = get_compiler_spec config_path in
655
+
if package_specs = [] then begin
656
+
Format.eprintf "Please specify at least one package.@.";
657
+
exit 1
658
+
end;
659
+
(* First, get the packages (with optional deps) *)
660
+
let selection_result =
661
+
if resolve_deps then Unpac.Solver.select_with_deps ?compiler index package_specs
662
+
else Unpac.Solver.select_packages index package_specs
663
+
in
664
+
match selection_result with
665
+
| Error msg ->
666
+
Format.eprintf "Error selecting packages: %s@." msg;
667
+
exit 1
668
+
| Ok selection ->
669
+
(* Find related packages for all selected packages *)
670
+
let all_related = List.concat_map (fun (info : Unpac.Repo_index.package_info) ->
671
+
Unpac.Repo_index.related_packages info.name index)
672
+
selection.packages
673
+
in
674
+
(* Deduplicate *)
675
+
let seen = Hashtbl.create 64 in
676
+
let unique = List.filter (fun (info : Unpac.Repo_index.package_info) ->
677
+
let key = OpamPackage.Name.to_string info.name in
678
+
if Hashtbl.mem seen key then false
679
+
else begin Hashtbl.add seen key (); true end)
680
+
all_related
681
+
in
682
+
let first_pkg = List.hd package_specs in
683
+
let pkg_name = OpamPackage.Name.to_string first_pkg.Unpac.Solver.name in
684
+
if unique = [] then
685
+
Format.eprintf "No related packages found.@."
686
+
else Unpac.Output.output_related (get_format format) pkg_name unique
687
+
in
688
+
let info = Cmd.info "related" ~doc ~man in
689
+
Cmd.v info
690
+
Term.(
691
+
const run $ logging_term $ config_file $ cache_dir_term $ output_format_term
692
+
$ resolve_deps_term $ Unpac.Solver.package_specs_term)
693
+
694
+
let opam_sources_cmd =
695
+
let doc = "Get source URLs for packages, grouped by dev-repo." in
696
+
let man =
697
+
[
698
+
`S Manpage.s_description;
699
+
`P
700
+
"Outputs source URLs (archive or git) for the specified packages, \
701
+
grouped by their development repository (dev-repo). Packages that \
702
+
share the same dev-repo are listed together since they typically \
703
+
need to be fetched from the same source.";
704
+
`P
705
+
"If no packages are specified, outputs sources for all packages \
706
+
(latest version of each).";
707
+
`P
708
+
"Use --git to get development repository URLs instead of archive URLs.";
709
+
`P
710
+
"Use --deps to include transitive dependencies using the 0install solver.";
711
+
`S Manpage.s_examples;
712
+
`P "Get archive URLs for all packages:";
713
+
`Pre " unpac opam sources";
714
+
`P "Get git URLs for specific packages:";
715
+
`Pre " unpac opam sources --git lwt dune";
716
+
`P "Get sources with version constraints:";
717
+
`Pre " unpac opam sources cmdliner>=1.0 lwt.5.6.0";
718
+
`P "Get sources with dependencies resolved:";
719
+
`Pre " unpac opam sources --deps lwt";
720
+
]
721
+
in
722
+
let run () config_path cache_dir format source_kind resolve_deps package_specs =
723
+
Eio_main.run @@ fun env ->
724
+
let fs = Eio.Stdenv.fs env in
725
+
let index = load_index ~fs ~cache_dir config_path in
726
+
let compiler = get_compiler_spec config_path in
727
+
(* Select packages based on specs *)
728
+
let selection_result =
729
+
if package_specs = [] then Ok (Unpac.Solver.select_all index)
730
+
else if resolve_deps then Unpac.Solver.select_with_deps ?compiler index package_specs
731
+
else Unpac.Solver.select_packages index package_specs
732
+
in
733
+
match selection_result with
734
+
| Error msg ->
735
+
Format.eprintf "Error selecting packages: %s@." msg;
736
+
exit 1
737
+
| Ok selection ->
738
+
let sources =
739
+
Unpac.Source.extract_all source_kind selection.packages
740
+
in
741
+
(* Filter out packages with no source *)
742
+
let sources =
743
+
List.filter
744
+
(fun (s : Unpac.Source.package_source) ->
745
+
s.source <> Unpac.Source.NoSource)
746
+
sources
747
+
in
748
+
Unpac.Output.output_sources (get_format format) sources
749
+
in
750
+
let info = Cmd.info "sources" ~doc ~man in
751
+
Cmd.v info
752
+
Term.(
753
+
const run $ logging_term $ config_file $ cache_dir_term $ output_format_term $ source_kind_term
754
+
$ resolve_deps_term $ Unpac.Solver.package_specs_term)
755
+
756
+
(* Opam subcommand group *)
757
+
758
+
let opam_cmd =
759
+
let doc = "Opam repository operations." in
760
+
let man =
761
+
[
762
+
`S Manpage.s_description;
763
+
`P
764
+
"Commands for querying and managing opam repositories defined in the \
765
+
configuration file.";
766
+
]
767
+
in
768
+
let info = Cmd.info "opam" ~doc ~man in
769
+
Cmd.group info [ opam_list_cmd; opam_info_cmd; opam_related_cmd; opam_sources_cmd ]
770
+
771
+
(* ============================================================================
772
+
MAIN COMMAND
773
+
============================================================================ *)
774
+
775
+
let main_cmd =
776
+
let doc = "Monorepo management tool." in
777
+
let man =
778
+
[
779
+
`S Manpage.s_description;
780
+
`P "unpac is a tool for managing OCaml monorepos with vendored packages.";
781
+
`P "It uses a project-based branch model:";
782
+
`P " - main branch holds the project registry";
783
+
`P " - project/<name> branches hold actual code and vendor packages";
784
+
`S "QUICK START";
785
+
`P "Initialize a new repository:";
786
+
`Pre " unpac init";
787
+
`P "Create a project:";
788
+
`Pre " unpac project create myapp";
789
+
`P "Add packages:";
790
+
`Pre " unpac add opam eio";
791
+
`Pre " unpac add opam lwt --with-deps";
792
+
`P "Check status:";
793
+
`Pre " unpac vendor status";
794
+
`S Manpage.s_bugs;
795
+
`P "Report bugs at https://github.com/avsm/unpac/issues";
796
+
]
797
+
in
798
+
let info = Cmd.info "unpac" ~version:"0.1.0" ~doc ~man in
799
+
Cmd.group info [ init_cmd; project_cmd; add_cmd; vendor_cmd; opam_cmd ]
800
+
801
+
let () = exit (Cmd.eval main_cmd)
+22
dune-project
+22
dune-project
···
···
1
+
(lang dune 3.20)
2
+
(name unpac)
3
+
(generate_opam_files true)
4
+
5
+
(package
6
+
(name unpac)
7
+
(synopsis "Monorepo management tool")
8
+
(description "A tool for managing OCaml monorepos with opam repository integration")
9
+
(authors "Anil Madhavapeddy")
10
+
(license ISC)
11
+
(depends
12
+
(ocaml (>= 5.1.0))
13
+
(cmdliner (>= 1.2.0))
14
+
(eio_main (>= 1.0))
15
+
(logs (>= 0.7.0))
16
+
(fmt (>= 0.9.0))
17
+
tomlt
18
+
jsont
19
+
xdge
20
+
opam-format
21
+
opam-core
22
+
opam-repository))
+138
lib/cache.ml
+138
lib/cache.ml
···
···
1
+
type cache_header = {
2
+
config_path : string;
3
+
config_mtime : float;
4
+
}
5
+
6
+
type cache_key = {
7
+
repos : (string * string) list; (* (name, path) pairs *)
8
+
repo_mtimes : float list; (* mtime of each repo's packages directory *)
9
+
}
10
+
11
+
let cache_filename = "repo_index.cache"
12
+
13
+
let get_file_mtime path =
14
+
try
15
+
let stat = Unix.stat path in
16
+
stat.Unix.st_mtime
17
+
with Unix.Unix_error _ -> 0.0
18
+
19
+
let get_repo_mtime path =
20
+
let packages_dir = Filename.concat path "packages" in
21
+
get_file_mtime packages_dir
22
+
23
+
let make_cache_key (repos : Config.repo_config list) =
24
+
let repo_list =
25
+
List.filter_map
26
+
(fun (r : Config.repo_config) ->
27
+
match r.source with
28
+
| Config.Local path -> Some (r.name, path)
29
+
| Config.Remote _ -> None)
30
+
repos
31
+
in
32
+
let repo_mtimes =
33
+
List.map (fun (_, path) -> get_repo_mtime path) repo_list
34
+
in
35
+
{ repos = repo_list; repo_mtimes }
36
+
37
+
let cache_path cache_dir =
38
+
Eio.Path.(cache_dir / cache_filename)
39
+
40
+
(* Read just the header to check if config has changed *)
41
+
let read_cache_header cache_dir =
42
+
let path = cache_path cache_dir in
43
+
try
44
+
let path_str = Eio.Path.native_exn path in
45
+
let ic = open_in_bin path_str in
46
+
Fun.protect
47
+
~finally:(fun () -> close_in ic)
48
+
(fun () ->
49
+
let header : cache_header = Marshal.from_channel ic in
50
+
Some header)
51
+
with
52
+
| Sys_error _ -> None
53
+
| End_of_file -> None
54
+
| Failure _ -> None
55
+
56
+
(* Load full cache if header and key match *)
57
+
let load_cached cache_dir expected_header expected_key =
58
+
let path = cache_path cache_dir in
59
+
try
60
+
let path_str = Eio.Path.native_exn path in
61
+
let ic = open_in_bin path_str in
62
+
Fun.protect
63
+
~finally:(fun () -> close_in ic)
64
+
(fun () ->
65
+
let header : cache_header = Marshal.from_channel ic in
66
+
if header <> expected_header then None
67
+
else
68
+
let key : cache_key = Marshal.from_channel ic in
69
+
if key <> expected_key then None
70
+
else
71
+
let index : Repo_index.t = Marshal.from_channel ic in
72
+
Some index)
73
+
with
74
+
| Sys_error _ -> None
75
+
| End_of_file -> None
76
+
| Failure _ -> None
77
+
78
+
let save_cache cache_dir header key (index : Repo_index.t) =
79
+
let path = cache_path cache_dir in
80
+
try
81
+
let path_str = Eio.Path.native_exn path in
82
+
let oc = open_out_bin path_str in
83
+
Fun.protect
84
+
~finally:(fun () -> close_out oc)
85
+
(fun () ->
86
+
Marshal.to_channel oc header [];
87
+
Marshal.to_channel oc key [];
88
+
Marshal.to_channel oc index [])
89
+
with
90
+
| Sys_error msg ->
91
+
Format.eprintf "Warning: Could not save cache: %s@." msg
92
+
| Failure msg ->
93
+
Format.eprintf "Warning: Could not serialize cache: %s@." msg
94
+
95
+
let rec load_index ~cache_dir ~config_path =
96
+
let config_mtime = get_file_mtime config_path in
97
+
let header = { config_path; config_mtime } in
98
+
99
+
(* Quick check: has config file changed? *)
100
+
let cached_header = read_cache_header cache_dir in
101
+
let config_unchanged =
102
+
match cached_header with
103
+
| Some h -> h = header
104
+
| None -> false
105
+
in
106
+
107
+
(* Load config *)
108
+
let config = Config.load_exn config_path in
109
+
let key = make_cache_key config.opam.repositories in
110
+
111
+
(* If config unchanged, try to load from cache *)
112
+
if config_unchanged then
113
+
match load_cached cache_dir header key with
114
+
| Some index -> index
115
+
| None ->
116
+
(* Cache invalid, rebuild *)
117
+
let index = build_index config in
118
+
save_cache cache_dir header key index;
119
+
index
120
+
else begin
121
+
(* Config changed, rebuild *)
122
+
let index = build_index config in
123
+
save_cache cache_dir header key index;
124
+
index
125
+
end
126
+
127
+
and build_index (config : Config.t) =
128
+
List.fold_left
129
+
(fun acc (repo : Config.repo_config) ->
130
+
match repo.source with
131
+
| Config.Local path ->
132
+
Repo_index.load_local_repo ~name:repo.name ~path acc
133
+
| Config.Remote _url ->
134
+
Format.eprintf
135
+
"Warning: Remote repositories not yet supported: %s@."
136
+
repo.name;
137
+
acc)
138
+
Repo_index.empty config.opam.repositories
+23
lib/cache.mli
+23
lib/cache.mli
···
···
1
+
(** Cache for repository index.
2
+
3
+
This module provides caching for the repository index using Marshal
4
+
serialization. The cache is stored in the XDG cache directory and
5
+
is invalidated when:
6
+
- The config file path or mtime changes
7
+
- Repository paths change
8
+
- Repository package directories' mtimes change *)
9
+
10
+
val load_index :
11
+
cache_dir:Eio.Fs.dir_ty Eio.Path.t ->
12
+
config_path:string ->
13
+
Repo_index.t
14
+
(** [load_index ~cache_dir ~config_path] loads the repository index,
15
+
using a cached version if available and valid.
16
+
17
+
The cache stores the config file path and mtime, along with repository
18
+
paths and their package directory mtimes. If any of these change, the
19
+
cache is invalidated and rebuilt.
20
+
21
+
@param cache_dir The XDG cache directory path
22
+
@param config_path Path to the unpac.toml config file
23
+
@return The repository index *)
+71
lib/config.ml
+71
lib/config.ml
···
···
1
+
type repo_source =
2
+
| Local of string
3
+
| Remote of string
4
+
5
+
type repo_config = {
6
+
name : string;
7
+
source : repo_source;
8
+
}
9
+
10
+
type opam_config = {
11
+
repositories : repo_config list;
12
+
compiler : string option; (* e.g., "ocaml.5.4.0" or "5.4.0" *)
13
+
}
14
+
15
+
type t = { opam : opam_config }
16
+
17
+
(* TOML Codecs *)
18
+
19
+
let repo_config_codec =
20
+
let open Tomlt in
21
+
let open Table in
22
+
let make name path url =
23
+
let source =
24
+
match (path, url) with
25
+
| Some p, None -> Local p
26
+
| None, Some u -> Remote u
27
+
| Some _, Some _ ->
28
+
failwith "Repository cannot have both 'path' and 'url'"
29
+
| None, None -> failwith "Repository must have either 'path' or 'url'"
30
+
in
31
+
{ name; source }
32
+
in
33
+
let enc_path r =
34
+
match r.source with Local p -> Some p | Remote _ -> None
35
+
in
36
+
let enc_url r =
37
+
match r.source with Remote u -> Some u | Local _ -> None
38
+
in
39
+
obj make
40
+
|> mem "name" string ~enc:(fun r -> r.name)
41
+
|> opt_mem "path" string ~enc:enc_path
42
+
|> opt_mem "url" string ~enc:enc_url
43
+
|> finish
44
+
45
+
let opam_config_codec =
46
+
let open Tomlt in
47
+
let open Table in
48
+
obj (fun repositories compiler -> { repositories; compiler })
49
+
|> mem "repositories" (list repo_config_codec)
50
+
~enc:(fun c -> c.repositories)
51
+
|> opt_mem "compiler" string ~enc:(fun c -> c.compiler)
52
+
|> finish
53
+
54
+
let codec =
55
+
let open Tomlt in
56
+
let open Table in
57
+
obj (fun opam -> { opam })
58
+
|> mem "opam" opam_config_codec ~enc:(fun c -> c.opam)
59
+
|> finish
60
+
61
+
let load path =
62
+
try
63
+
let content = In_channel.with_open_text path In_channel.input_all in
64
+
Tomlt_bytesrw.decode_string codec content
65
+
|> Result.map_error Tomlt.Toml.Error.to_string
66
+
with
67
+
| Sys_error msg -> Error msg
68
+
| Failure msg -> Error msg
69
+
70
+
let load_exn path =
71
+
match load path with Ok c -> c | Error msg -> failwith msg
+38
lib/config.mli
+38
lib/config.mli
···
···
1
+
(** Configuration file handling for unpac.
2
+
3
+
Loads and parses unpac.toml configuration files using tomlt. *)
4
+
5
+
(** {1 Types} *)
6
+
7
+
type repo_source =
8
+
| Local of string (** Local filesystem path *)
9
+
| Remote of string (** Remote URL (git+https://..., etc.) *)
10
+
(** Source location for an opam repository. *)
11
+
12
+
type repo_config = {
13
+
name : string;
14
+
source : repo_source;
15
+
}
16
+
(** Configuration for a single opam repository. *)
17
+
18
+
type opam_config = {
19
+
repositories : repo_config list;
20
+
compiler : string option; (** Target compiler version, e.g. "5.4.0" or "ocaml.5.4.0" *)
21
+
}
22
+
(** Opam-specific configuration. *)
23
+
24
+
type t = { opam : opam_config }
25
+
(** The complete unpac configuration. *)
26
+
27
+
(** {1 Loading} *)
28
+
29
+
val load : string -> (t, string) result
30
+
(** [load path] loads configuration from the TOML file at [path]. *)
31
+
32
+
val load_exn : string -> t
33
+
(** [load_exn path] is like {!load} but raises on error. *)
34
+
35
+
(** {1 Codecs} *)
36
+
37
+
val codec : t Tomlt.t
38
+
(** TOML codec for the configuration type. *)
+67
lib/dev_repo.ml
+67
lib/dev_repo.ml
···
···
1
+
type t = string
2
+
3
+
let normalize_url s =
4
+
let s = String.lowercase_ascii s in
5
+
(* Remove git+ prefix *)
6
+
let s =
7
+
if String.starts_with ~prefix:"git+" s then
8
+
String.sub s 4 (String.length s - 4)
9
+
else s
10
+
in
11
+
(* Remove .git suffix *)
12
+
let s =
13
+
if String.ends_with ~suffix:".git" s then
14
+
String.sub s 0 (String.length s - 4)
15
+
else s
16
+
in
17
+
(* Remove trailing slash *)
18
+
let s =
19
+
if String.ends_with ~suffix:"/" s then
20
+
String.sub s 0 (String.length s - 1)
21
+
else s
22
+
in
23
+
(* Strip #branch fragment *)
24
+
let s =
25
+
match String.index_opt s '#' with
26
+
| Some i -> String.sub s 0 i
27
+
| None -> s
28
+
in
29
+
(* Normalize ssh-style github.com:user/repo to github.com/user/repo *)
30
+
let s =
31
+
match String.index_opt s ':' with
32
+
| Some i when i > 0 ->
33
+
let before = String.sub s 0 i in
34
+
let after = String.sub s (i + 1) (String.length s - i - 1) in
35
+
(* Only convert if it looks like host:path (no // after) *)
36
+
if
37
+
(not (String.contains before '/'))
38
+
&& not (String.starts_with ~prefix:"/" after)
39
+
&& String.contains before '.'
40
+
then before ^ "/" ^ after
41
+
else s
42
+
| _ -> s
43
+
in
44
+
(* Remove protocol prefix for comparison *)
45
+
let s =
46
+
let protocols = [ "https://"; "http://"; "ssh://"; "git://"; "file://" ] in
47
+
List.fold_left
48
+
(fun s proto ->
49
+
if String.starts_with ~prefix:proto s then
50
+
String.sub s (String.length proto) (String.length s - String.length proto)
51
+
else s)
52
+
s protocols
53
+
in
54
+
s
55
+
56
+
let of_opam_url url = normalize_url (OpamUrl.to_string url)
57
+
58
+
let of_string s = normalize_url s
59
+
60
+
let equal = String.equal
61
+
let compare = String.compare
62
+
let to_string t = t
63
+
64
+
let pp fmt t = Format.pp_print_string fmt t
65
+
66
+
module Map = Map.Make (String)
67
+
module Set = Set.Make (String)
+47
lib/dev_repo.mli
+47
lib/dev_repo.mli
···
···
1
+
(** Normalized dev-repo URLs.
2
+
3
+
This module provides URL normalization for dev-repo fields to enable
4
+
matching packages that share the same source repository even when
5
+
the URLs are written differently.
6
+
7
+
Normalization rules:
8
+
- Strip [.git] suffix
9
+
- Normalize to lowercase
10
+
- Remove [git+] prefix from transport
11
+
- Normalize [github.com:user/repo] to [github.com/user/repo]
12
+
- Remove trailing slashes
13
+
- Strip [#branch] fragment *)
14
+
15
+
(** {1 Types} *)
16
+
17
+
type t
18
+
(** Normalized dev-repo URL. *)
19
+
20
+
(** {1 Creation} *)
21
+
22
+
val of_opam_url : OpamUrl.t -> t
23
+
(** [of_opam_url url] creates a normalized dev-repo from an opam URL. *)
24
+
25
+
val of_string : string -> t
26
+
(** [of_string s] parses and normalizes a URL string. *)
27
+
28
+
(** {1 Comparison} *)
29
+
30
+
val equal : t -> t -> bool
31
+
(** [equal a b] is [true] if [a] and [b] represent the same repository. *)
32
+
33
+
val compare : t -> t -> int
34
+
(** [compare a b] is a total ordering on normalized URLs. *)
35
+
36
+
(** {1 Conversion} *)
37
+
38
+
val to_string : t -> string
39
+
(** [to_string t] returns the normalized URL string. *)
40
+
41
+
val pp : Format.formatter -> t -> unit
42
+
(** [pp fmt t] pretty-prints the normalized URL. *)
43
+
44
+
(** {1 Collections} *)
45
+
46
+
module Map : Map.S with type key = t
47
+
module Set : Set.S with type elt = t
+23
lib/dune
+23
lib/dune
···
···
1
+
(library
2
+
(name unpac)
3
+
(public_name unpac)
4
+
(libraries
5
+
cmdliner
6
+
eio
7
+
logs
8
+
logs.fmt
9
+
logs.cli
10
+
fmt
11
+
fmt.cli
12
+
fmt.tty
13
+
tomlt
14
+
tomlt.bytesrw
15
+
jsont
16
+
jsont.bytesrw
17
+
xdge
18
+
opam-format
19
+
opam-core
20
+
opam-repository
21
+
opam-solver
22
+
opam-0install-cudf
23
+
cudf))
+396
lib/git.ml
+396
lib/git.ml
···
···
1
+
(** Git operations wrapped with Eio and robust error handling. *)
2
+
3
+
let src = Logs.Src.create "unpac.git" ~doc:"Git operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
(* Error types *)
7
+
8
+
type error =
9
+
| Command_failed of {
10
+
cmd : string list;
11
+
exit_code : int;
12
+
stdout : string;
13
+
stderr : string;
14
+
}
15
+
| Not_a_repository
16
+
| Remote_exists of string
17
+
| Remote_not_found of string
18
+
| Branch_exists of string
19
+
| Branch_not_found of string
20
+
| Merge_conflict of { branch : string; conflicting_files : string list }
21
+
| Rebase_conflict of { onto : string; hint : string }
22
+
| Uncommitted_changes
23
+
| Not_on_branch
24
+
| Detached_head
25
+
26
+
let pp_error fmt = function
27
+
| Command_failed { cmd; exit_code; stderr; _ } ->
28
+
Format.fprintf fmt "git %a failed (exit %d): %s"
29
+
Fmt.(list ~sep:sp string) cmd exit_code
30
+
(String.trim stderr)
31
+
| Not_a_repository ->
32
+
Format.fprintf fmt "not a git repository"
33
+
| Remote_exists name ->
34
+
Format.fprintf fmt "remote '%s' already exists" name
35
+
| Remote_not_found name ->
36
+
Format.fprintf fmt "remote '%s' not found" name
37
+
| Branch_exists name ->
38
+
Format.fprintf fmt "branch '%s' already exists" name
39
+
| Branch_not_found name ->
40
+
Format.fprintf fmt "branch '%s' not found" name
41
+
| Merge_conflict { branch; conflicting_files } ->
42
+
Format.fprintf fmt "merge conflict in '%s': %a" branch
43
+
Fmt.(list ~sep:comma string) conflicting_files
44
+
| Rebase_conflict { onto; hint } ->
45
+
Format.fprintf fmt "rebase conflict onto '%s': %s" onto hint
46
+
| Uncommitted_changes ->
47
+
Format.fprintf fmt "uncommitted changes in working directory"
48
+
| Not_on_branch ->
49
+
Format.fprintf fmt "not on any branch"
50
+
| Detached_head ->
51
+
Format.fprintf fmt "HEAD is detached"
52
+
53
+
type Eio.Exn.err += E of error
54
+
55
+
let () =
56
+
Eio.Exn.register_pp (fun fmt -> function
57
+
| E e -> Format.fprintf fmt "Git %a" pp_error e; true
58
+
| _ -> false)
59
+
60
+
let err e = Eio.Exn.create (E e)
61
+
62
+
(* Types *)
63
+
64
+
type proc_mgr = [ `Generic | `Unix ] Eio.Process.mgr_ty Eio.Resource.t
65
+
type path = Eio.Fs.dir_ty Eio.Path.t
66
+
67
+
(* Helpers *)
68
+
69
+
let string_trim s = String.trim s
70
+
71
+
let lines s =
72
+
String.split_on_char '\n' s
73
+
|> List.filter (fun s -> String.trim s <> "")
74
+
75
+
(* Low-level execution *)
76
+
77
+
let run ~proc_mgr ?cwd args =
78
+
let full_cmd = "git" :: args in
79
+
Log.debug (fun m -> m "Running: %a" Fmt.(list ~sep:sp string) full_cmd);
80
+
let stdout_buf = Buffer.create 256 in
81
+
let stderr_buf = Buffer.create 256 in
82
+
try
83
+
Eio.Switch.run @@ fun sw ->
84
+
let stdout_r, stdout_w = Eio.Process.pipe proc_mgr ~sw in
85
+
let stderr_r, stderr_w = Eio.Process.pipe proc_mgr ~sw in
86
+
let child = Eio.Process.spawn proc_mgr ~sw
87
+
?cwd:(Option.map (fun p -> (p :> Eio.Fs.dir_ty Eio.Path.t)) cwd)
88
+
~stdout:stdout_w ~stderr:stderr_w
89
+
full_cmd
90
+
in
91
+
Eio.Flow.close stdout_w;
92
+
Eio.Flow.close stderr_w;
93
+
(* Read stdout and stderr concurrently *)
94
+
Eio.Fiber.both
95
+
(fun () ->
96
+
let chunk = Cstruct.create 4096 in
97
+
let rec loop () =
98
+
match Eio.Flow.single_read stdout_r chunk with
99
+
| n ->
100
+
Buffer.add_string stdout_buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
101
+
loop ()
102
+
| exception End_of_file -> ()
103
+
in
104
+
loop ())
105
+
(fun () ->
106
+
let chunk = Cstruct.create 4096 in
107
+
let rec loop () =
108
+
match Eio.Flow.single_read stderr_r chunk with
109
+
| n ->
110
+
Buffer.add_string stderr_buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
111
+
loop ()
112
+
| exception End_of_file -> ()
113
+
in
114
+
loop ());
115
+
let status = Eio.Process.await child in
116
+
let stdout = Buffer.contents stdout_buf in
117
+
let stderr = Buffer.contents stderr_buf in
118
+
match status with
119
+
| `Exited 0 ->
120
+
Log.debug (fun m -> m "Output: %s" (string_trim stdout));
121
+
Ok stdout
122
+
| `Exited exit_code ->
123
+
Log.debug (fun m -> m "Failed (exit %d): %s" exit_code (string_trim stderr));
124
+
Error (Command_failed { cmd = args; exit_code; stdout; stderr })
125
+
| `Signaled signal ->
126
+
Log.debug (fun m -> m "Killed by signal %d" signal);
127
+
Error (Command_failed { cmd = args; exit_code = 128 + signal; stdout; stderr })
128
+
with exn ->
129
+
Log.err (fun m -> m "Exception running git: %a" Fmt.exn exn);
130
+
raise exn
131
+
132
+
let run_exn ~proc_mgr ?cwd args =
133
+
match run ~proc_mgr ?cwd args with
134
+
| Ok output -> output
135
+
| Error e ->
136
+
let ex = err e in
137
+
raise (Eio.Exn.add_context ex "running git %a" Fmt.(list ~sep:sp string) args)
138
+
139
+
let run_lines ~proc_mgr ?cwd args =
140
+
run_exn ~proc_mgr ?cwd args |> string_trim |> lines
141
+
142
+
(* Queries *)
143
+
144
+
let is_repository path =
145
+
let git_dir = Eio.Path.(path / ".git") in
146
+
match Eio.Path.kind ~follow:false git_dir with
147
+
| `Directory | `Regular_file -> true (* .git can be a file for worktrees *)
148
+
| _ -> false
149
+
| exception _ -> false
150
+
151
+
let current_branch ~proc_mgr ~cwd =
152
+
match run ~proc_mgr ~cwd ["symbolic-ref"; "--short"; "HEAD"] with
153
+
| Ok output -> Some (string_trim output)
154
+
| Error _ -> None
155
+
156
+
let current_branch_exn ~proc_mgr ~cwd =
157
+
match current_branch ~proc_mgr ~cwd with
158
+
| Some b -> b
159
+
| None -> raise (err Not_on_branch)
160
+
161
+
let current_head ~proc_mgr ~cwd =
162
+
run_exn ~proc_mgr ~cwd ["rev-parse"; "HEAD"] |> string_trim
163
+
164
+
let has_uncommitted_changes ~proc_mgr ~cwd =
165
+
let status = run_exn ~proc_mgr ~cwd ["status"; "--porcelain"] in
166
+
String.trim status <> ""
167
+
168
+
let remote_exists ~proc_mgr ~cwd name =
169
+
match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
170
+
| Ok _ -> true
171
+
| Error _ -> false
172
+
173
+
let branch_exists ~proc_mgr ~cwd name =
174
+
match run ~proc_mgr ~cwd ["show-ref"; "--verify"; "--quiet"; "refs/heads/" ^ name] with
175
+
| Ok _ -> true
176
+
| Error _ -> false
177
+
178
+
let rev_parse ~proc_mgr ~cwd ref_ =
179
+
match run ~proc_mgr ~cwd ["rev-parse"; "--verify"; "--quiet"; ref_] with
180
+
| Ok output -> Some (string_trim output)
181
+
| Error _ -> None
182
+
183
+
let rev_parse_exn ~proc_mgr ~cwd ref_ =
184
+
match rev_parse ~proc_mgr ~cwd ref_ with
185
+
| Some sha -> sha
186
+
| None -> raise (err (Branch_not_found ref_))
187
+
188
+
let rev_parse_short ~proc_mgr ~cwd ref_ =
189
+
run_exn ~proc_mgr ~cwd ["rev-parse"; "--short"; ref_] |> string_trim
190
+
191
+
let ls_remote_default_branch ~proc_mgr ~url =
192
+
Log.info (fun m -> m "Detecting default branch for %s..." url);
193
+
(* Try to get the default branch from the remote *)
194
+
let output = run_exn ~proc_mgr ["ls-remote"; "--symref"; url; "HEAD"] in
195
+
(* Parse output like: ref: refs/heads/main\tHEAD *)
196
+
let default =
197
+
let lines = String.split_on_char '\n' output in
198
+
List.find_map (fun line ->
199
+
if String.starts_with ~prefix:"ref:" line then
200
+
let parts = String.split_on_char '\t' line in
201
+
match parts with
202
+
| ref_part :: _ ->
203
+
let ref_part = String.trim ref_part in
204
+
if String.starts_with ~prefix:"ref: refs/heads/" ref_part then
205
+
Some (String.sub ref_part 16 (String.length ref_part - 16))
206
+
else None
207
+
| _ -> None
208
+
else None
209
+
) lines
210
+
in
211
+
match default with
212
+
| Some branch ->
213
+
Log.info (fun m -> m "Default branch: %s" branch);
214
+
branch
215
+
| None ->
216
+
(* Fallback: try common branch names *)
217
+
Log.debug (fun m -> m "Could not detect default branch, trying common names...");
218
+
let try_branch name =
219
+
match run ~proc_mgr ["ls-remote"; "--heads"; url; name] with
220
+
| Ok output when String.trim output <> "" -> true
221
+
| _ -> false
222
+
in
223
+
if try_branch "main" then "main"
224
+
else if try_branch "master" then "master"
225
+
else begin
226
+
Log.warn (fun m -> m "Could not detect default branch, assuming 'main'");
227
+
"main"
228
+
end
229
+
230
+
let list_remotes ~proc_mgr ~cwd =
231
+
run_lines ~proc_mgr ~cwd ["remote"]
232
+
233
+
let remote_url ~proc_mgr ~cwd name =
234
+
match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
235
+
| Ok output -> Some (string_trim output)
236
+
| Error _ -> None
237
+
238
+
let log_oneline ~proc_mgr ~cwd ?max_count from_ref to_ref =
239
+
let range = from_ref ^ ".." ^ to_ref in
240
+
let args = ["log"; "--oneline"; range] in
241
+
let args = match max_count with
242
+
| Some n -> args @ ["--max-count"; string_of_int n]
243
+
| None -> args
244
+
in
245
+
run_lines ~proc_mgr ~cwd args
246
+
247
+
let diff_stat ~proc_mgr ~cwd from_ref to_ref =
248
+
let range = from_ref ^ ".." ^ to_ref in
249
+
run_exn ~proc_mgr ~cwd ["diff"; "--stat"; range]
250
+
251
+
let ls_tree ~proc_mgr ~cwd ~tree ~path =
252
+
match run ~proc_mgr ~cwd ["ls-tree"; tree; path] with
253
+
| Ok output -> String.trim output <> ""
254
+
| Error _ -> false
255
+
256
+
let rev_list_count ~proc_mgr ~cwd from_ref to_ref =
257
+
let range = from_ref ^ ".." ^ to_ref in
258
+
let output = run_exn ~proc_mgr ~cwd ["rev-list"; "--count"; range] in
259
+
int_of_string (string_trim output)
260
+
261
+
(* Idempotent mutations *)
262
+
263
+
let ensure_remote ~proc_mgr ~cwd ~name ~url =
264
+
match remote_url ~proc_mgr ~cwd name with
265
+
| None ->
266
+
Log.info (fun m -> m "Adding remote %s -> %s" name url);
267
+
run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore;
268
+
`Created
269
+
| Some existing_url ->
270
+
if existing_url = url then begin
271
+
Log.debug (fun m -> m "Remote %s already exists with correct URL" name);
272
+
`Existed
273
+
end else begin
274
+
Log.info (fun m -> m "Updating remote %s URL: %s -> %s" name existing_url url);
275
+
run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore;
276
+
`Updated
277
+
end
278
+
279
+
let ensure_branch ~proc_mgr ~cwd ~name ~start_point =
280
+
if branch_exists ~proc_mgr ~cwd name then begin
281
+
Log.debug (fun m -> m "Branch %s already exists" name);
282
+
`Existed
283
+
end else begin
284
+
Log.info (fun m -> m "Creating branch %s at %s" name start_point);
285
+
run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore;
286
+
`Created
287
+
end
288
+
289
+
(* State-changing operations *)
290
+
291
+
let init ~proc_mgr ~cwd =
292
+
Log.info (fun m -> m "Initializing git repository...");
293
+
run_exn ~proc_mgr ~cwd ["init"] |> ignore
294
+
295
+
let fetch ~proc_mgr ~cwd ~remote =
296
+
Log.info (fun m -> m "Fetching from %s..." remote);
297
+
run_exn ~proc_mgr ~cwd ["fetch"; remote] |> ignore
298
+
299
+
let checkout ~proc_mgr ~cwd ref_ =
300
+
Log.debug (fun m -> m "Checking out %s" ref_);
301
+
run_exn ~proc_mgr ~cwd ["checkout"; ref_] |> ignore
302
+
303
+
let checkout_orphan ~proc_mgr ~cwd name =
304
+
Log.info (fun m -> m "Creating orphan branch %s" name);
305
+
run_exn ~proc_mgr ~cwd ["checkout"; "--orphan"; name] |> ignore
306
+
307
+
let read_tree_prefix ~proc_mgr ~cwd ~prefix ~tree =
308
+
Log.debug (fun m -> m "Reading tree %s with prefix %s" tree prefix);
309
+
run_exn ~proc_mgr ~cwd ["read-tree"; "--prefix=" ^ prefix; tree] |> ignore
310
+
311
+
let checkout_index ~proc_mgr ~cwd =
312
+
Log.debug (fun m -> m "Checking out index to working directory");
313
+
run_exn ~proc_mgr ~cwd ["checkout-index"; "-a"; "-f"] |> ignore
314
+
315
+
let rm_rf ~proc_mgr ~cwd ~target =
316
+
Log.debug (fun m -> m "Removing %s from git" target);
317
+
(* Ignore errors - target might not exist *)
318
+
ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; target])
319
+
320
+
let rm_cached_rf ~proc_mgr ~cwd =
321
+
Log.debug (fun m -> m "Removing all files from index");
322
+
(* Ignore errors - index might be empty *)
323
+
ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; "--cached"; "."])
324
+
325
+
let add_all ~proc_mgr ~cwd =
326
+
Log.debug (fun m -> m "Staging all changes");
327
+
run_exn ~proc_mgr ~cwd ["add"; "-A"] |> ignore
328
+
329
+
let commit ~proc_mgr ~cwd ~message =
330
+
Log.debug (fun m -> m "Committing: %s" (String.sub message 0 (min 50 (String.length message))));
331
+
run_exn ~proc_mgr ~cwd ["commit"; "-m"; message] |> ignore
332
+
333
+
let commit_allow_empty ~proc_mgr ~cwd ~message =
334
+
Log.debug (fun m -> m "Committing (allow empty): %s" (String.sub message 0 (min 50 (String.length message))));
335
+
run_exn ~proc_mgr ~cwd ["commit"; "--allow-empty"; "-m"; message] |> ignore
336
+
337
+
let branch_create ~proc_mgr ~cwd ~name ~start_point =
338
+
Log.info (fun m -> m "Creating branch %s at %s" name start_point);
339
+
run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore
340
+
341
+
let branch_force ~proc_mgr ~cwd ~name ~point =
342
+
Log.info (fun m -> m "Force-moving branch %s to %s" name point);
343
+
run_exn ~proc_mgr ~cwd ["branch"; "-f"; name; point] |> ignore
344
+
345
+
let remote_add ~proc_mgr ~cwd ~name ~url =
346
+
Log.info (fun m -> m "Adding remote %s -> %s" name url);
347
+
run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore
348
+
349
+
let remote_set_url ~proc_mgr ~cwd ~name ~url =
350
+
Log.info (fun m -> m "Setting remote %s URL to %s" name url);
351
+
run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore
352
+
353
+
let merge_allow_unrelated ~proc_mgr ~cwd ~branch ~message =
354
+
Log.info (fun m -> m "Merging %s (allow unrelated histories)..." branch);
355
+
match run ~proc_mgr ~cwd ["merge"; "--allow-unrelated-histories"; "-m"; message; branch] with
356
+
| Ok _ -> Ok ()
357
+
| Error (Command_failed { exit_code = 1; _ }) ->
358
+
(* Merge conflict - get list of conflicting files *)
359
+
let output = run_exn ~proc_mgr ~cwd ["diff"; "--name-only"; "--diff-filter=U"] in
360
+
let files = lines output in
361
+
Log.warn (fun m -> m "Merge conflict: %a" Fmt.(list ~sep:comma string) files);
362
+
Error (`Conflict files)
363
+
| Error e ->
364
+
raise (err e)
365
+
366
+
let rebase ~proc_mgr ~cwd ~onto =
367
+
Log.info (fun m -> m "Rebasing onto %s..." onto);
368
+
match run ~proc_mgr ~cwd ["rebase"; onto] with
369
+
| Ok _ -> Ok ()
370
+
| Error (Command_failed { stderr; _ }) ->
371
+
let hint =
372
+
if String.length stderr > 200 then
373
+
String.sub stderr 0 200 ^ "..."
374
+
else
375
+
stderr
376
+
in
377
+
Log.warn (fun m -> m "Rebase conflict onto %s" onto);
378
+
Error (`Conflict hint)
379
+
| Error e ->
380
+
raise (err e)
381
+
382
+
let rebase_abort ~proc_mgr ~cwd =
383
+
Log.info (fun m -> m "Aborting rebase...");
384
+
ignore (run ~proc_mgr ~cwd ["rebase"; "--abort"])
385
+
386
+
let merge_abort ~proc_mgr ~cwd =
387
+
Log.info (fun m -> m "Aborting merge...");
388
+
ignore (run ~proc_mgr ~cwd ["merge"; "--abort"])
389
+
390
+
let reset_hard ~proc_mgr ~cwd ref_ =
391
+
Log.info (fun m -> m "Hard reset to %s" ref_);
392
+
run_exn ~proc_mgr ~cwd ["reset"; "--hard"; ref_] |> ignore
393
+
394
+
let clean_fd ~proc_mgr ~cwd =
395
+
Log.debug (fun m -> m "Cleaning untracked files");
396
+
run_exn ~proc_mgr ~cwd ["clean"; "-fd"] |> ignore
+345
lib/git.mli
+345
lib/git.mli
···
···
1
+
(** Git operations wrapped with Eio and robust error handling.
2
+
3
+
All git commands are executed via [Eio.Process] with proper logging
4
+
and error context. Errors are wrapped in [Eio.Exn.Io] with context
5
+
chains for debugging. *)
6
+
7
+
(** {1 Error Types} *)
8
+
9
+
type error =
10
+
| Command_failed of {
11
+
cmd : string list;
12
+
exit_code : int;
13
+
stdout : string;
14
+
stderr : string;
15
+
}
16
+
| Not_a_repository
17
+
| Remote_exists of string
18
+
| Remote_not_found of string
19
+
| Branch_exists of string
20
+
| Branch_not_found of string
21
+
| Merge_conflict of { branch : string; conflicting_files : string list }
22
+
| Rebase_conflict of { onto : string; hint : string }
23
+
| Uncommitted_changes
24
+
| Not_on_branch
25
+
| Detached_head
26
+
27
+
val pp_error : Format.formatter -> error -> unit
28
+
29
+
type Eio.Exn.err += E of error
30
+
31
+
val err : error -> exn
32
+
(** [err e] creates an [Eio.Exn.Io] exception with the given error. *)
33
+
34
+
(** {1 Types} *)
35
+
36
+
type proc_mgr = [ `Generic | `Unix ] Eio.Process.mgr_ty Eio.Resource.t
37
+
type path = Eio.Fs.dir_ty Eio.Path.t
38
+
39
+
(** {1 Low-level execution} *)
40
+
41
+
val run :
42
+
proc_mgr:proc_mgr ->
43
+
?cwd:path ->
44
+
string list ->
45
+
(string, error) result
46
+
(** [run ~proc_mgr args] executes [git args] and returns stdout on success. *)
47
+
48
+
val run_exn :
49
+
proc_mgr:proc_mgr ->
50
+
?cwd:path ->
51
+
string list ->
52
+
string
53
+
(** [run_exn ~proc_mgr args] executes [git args] and returns stdout.
54
+
Raises on failure with context. *)
55
+
56
+
val run_lines :
57
+
proc_mgr:proc_mgr ->
58
+
?cwd:path ->
59
+
string list ->
60
+
string list
61
+
(** [run_lines ~proc_mgr args] executes and splits output by newlines. *)
62
+
63
+
(** {1 Queries - Safe read-only operations} *)
64
+
65
+
val is_repository : path -> bool
66
+
(** [is_repository path] checks if [path] contains a [.git] directory. *)
67
+
68
+
val current_branch :
69
+
proc_mgr:proc_mgr ->
70
+
cwd:path ->
71
+
string option
72
+
(** [current_branch] returns [Some branch] if on a branch, [None] if detached. *)
73
+
74
+
val current_branch_exn :
75
+
proc_mgr:proc_mgr ->
76
+
cwd:path ->
77
+
string
78
+
(** [current_branch_exn] returns current branch or raises [Not_on_branch]. *)
79
+
80
+
val current_head :
81
+
proc_mgr:proc_mgr ->
82
+
cwd:path ->
83
+
string
84
+
(** [current_head] returns the current HEAD SHA. *)
85
+
86
+
val has_uncommitted_changes :
87
+
proc_mgr:proc_mgr ->
88
+
cwd:path ->
89
+
bool
90
+
(** [has_uncommitted_changes] returns true if there are staged or unstaged changes. *)
91
+
92
+
val remote_exists :
93
+
proc_mgr:proc_mgr ->
94
+
cwd:path ->
95
+
string ->
96
+
bool
97
+
(** [remote_exists ~proc_mgr ~cwd name] checks if remote [name] exists. *)
98
+
99
+
val branch_exists :
100
+
proc_mgr:proc_mgr ->
101
+
cwd:path ->
102
+
string ->
103
+
bool
104
+
(** [branch_exists ~proc_mgr ~cwd name] checks if branch [name] exists. *)
105
+
106
+
val rev_parse :
107
+
proc_mgr:proc_mgr ->
108
+
cwd:path ->
109
+
string ->
110
+
string option
111
+
(** [rev_parse ~proc_mgr ~cwd ref] returns the SHA for [ref], or [None]. *)
112
+
113
+
val rev_parse_exn :
114
+
proc_mgr:proc_mgr ->
115
+
cwd:path ->
116
+
string ->
117
+
string
118
+
(** [rev_parse_exn] returns SHA or raises. *)
119
+
120
+
val rev_parse_short :
121
+
proc_mgr:proc_mgr ->
122
+
cwd:path ->
123
+
string ->
124
+
string
125
+
(** [rev_parse_short] returns abbreviated SHA. *)
126
+
127
+
val ls_remote_default_branch :
128
+
proc_mgr:proc_mgr ->
129
+
url:string ->
130
+
string
131
+
(** [ls_remote_default_branch ~proc_mgr ~url] detects the default branch of remote. *)
132
+
133
+
val list_remotes :
134
+
proc_mgr:proc_mgr ->
135
+
cwd:path ->
136
+
string list
137
+
(** [list_remotes] returns all remote names. *)
138
+
139
+
val remote_url :
140
+
proc_mgr:proc_mgr ->
141
+
cwd:path ->
142
+
string ->
143
+
string option
144
+
(** [remote_url ~proc_mgr ~cwd name] returns the URL for remote [name]. *)
145
+
146
+
val log_oneline :
147
+
proc_mgr:proc_mgr ->
148
+
cwd:path ->
149
+
?max_count:int ->
150
+
string ->
151
+
string ->
152
+
string list
153
+
(** [log_oneline ~proc_mgr ~cwd from_ref to_ref] returns commit summaries. *)
154
+
155
+
val diff_stat :
156
+
proc_mgr:proc_mgr ->
157
+
cwd:path ->
158
+
string ->
159
+
string ->
160
+
string
161
+
(** [diff_stat ~proc_mgr ~cwd from_ref to_ref] returns diff statistics. *)
162
+
163
+
val ls_tree :
164
+
proc_mgr:proc_mgr ->
165
+
cwd:path ->
166
+
tree:string ->
167
+
path:string ->
168
+
bool
169
+
(** [ls_tree ~proc_mgr ~cwd ~tree ~path] checks if [path] exists in [tree]. *)
170
+
171
+
val rev_list_count :
172
+
proc_mgr:proc_mgr ->
173
+
cwd:path ->
174
+
string ->
175
+
string ->
176
+
int
177
+
(** [rev_list_count ~proc_mgr ~cwd from_ref to_ref] counts commits between refs. *)
178
+
179
+
(** {1 Idempotent mutations - Safe to re-run} *)
180
+
181
+
val ensure_remote :
182
+
proc_mgr:proc_mgr ->
183
+
cwd:path ->
184
+
name:string ->
185
+
url:string ->
186
+
[ `Created | `Existed | `Updated ]
187
+
(** [ensure_remote] adds remote if missing, updates URL if different. *)
188
+
189
+
val ensure_branch :
190
+
proc_mgr:proc_mgr ->
191
+
cwd:path ->
192
+
name:string ->
193
+
start_point:string ->
194
+
[ `Created | `Existed ]
195
+
(** [ensure_branch] creates branch if it doesn't exist. *)
196
+
197
+
(** {1 State-changing operations} *)
198
+
199
+
val init :
200
+
proc_mgr:proc_mgr ->
201
+
cwd:path ->
202
+
unit
203
+
(** [init] initializes a new git repository. *)
204
+
205
+
val fetch :
206
+
proc_mgr:proc_mgr ->
207
+
cwd:path ->
208
+
remote:string ->
209
+
unit
210
+
(** [fetch] fetches from a remote. *)
211
+
212
+
val checkout :
213
+
proc_mgr:proc_mgr ->
214
+
cwd:path ->
215
+
string ->
216
+
unit
217
+
(** [checkout] switches to a branch or commit. *)
218
+
219
+
val checkout_orphan :
220
+
proc_mgr:proc_mgr ->
221
+
cwd:path ->
222
+
string ->
223
+
unit
224
+
(** [checkout_orphan] creates and switches to a new orphan branch. *)
225
+
226
+
val read_tree_prefix :
227
+
proc_mgr:proc_mgr ->
228
+
cwd:path ->
229
+
prefix:string ->
230
+
tree:string ->
231
+
unit
232
+
(** [read_tree_prefix] reads a tree into the index with a path prefix. *)
233
+
234
+
val checkout_index :
235
+
proc_mgr:proc_mgr ->
236
+
cwd:path ->
237
+
unit
238
+
(** [checkout_index] checks out files from the index to working directory. *)
239
+
240
+
val rm_rf :
241
+
proc_mgr:proc_mgr ->
242
+
cwd:path ->
243
+
target:string ->
244
+
unit
245
+
(** [rm_rf] removes files/directories from git tracking. *)
246
+
247
+
val rm_cached_rf :
248
+
proc_mgr:proc_mgr ->
249
+
cwd:path ->
250
+
unit
251
+
(** [rm_cached_rf] removes all files from index (for orphan branch setup). *)
252
+
253
+
val add_all :
254
+
proc_mgr:proc_mgr ->
255
+
cwd:path ->
256
+
unit
257
+
(** [add_all] stages all changes. *)
258
+
259
+
val commit :
260
+
proc_mgr:proc_mgr ->
261
+
cwd:path ->
262
+
message:string ->
263
+
unit
264
+
(** [commit] creates a commit with the given message. *)
265
+
266
+
val commit_allow_empty :
267
+
proc_mgr:proc_mgr ->
268
+
cwd:path ->
269
+
message:string ->
270
+
unit
271
+
(** [commit_allow_empty] creates a commit even if there are no changes. *)
272
+
273
+
val branch_create :
274
+
proc_mgr:proc_mgr ->
275
+
cwd:path ->
276
+
name:string ->
277
+
start_point:string ->
278
+
unit
279
+
(** [branch_create] creates a new branch at [start_point]. *)
280
+
281
+
val branch_force :
282
+
proc_mgr:proc_mgr ->
283
+
cwd:path ->
284
+
name:string ->
285
+
point:string ->
286
+
unit
287
+
(** [branch_force] moves branch to point (creates if needed). *)
288
+
289
+
val remote_add :
290
+
proc_mgr:proc_mgr ->
291
+
cwd:path ->
292
+
name:string ->
293
+
url:string ->
294
+
unit
295
+
(** [remote_add] adds a new remote. *)
296
+
297
+
val remote_set_url :
298
+
proc_mgr:proc_mgr ->
299
+
cwd:path ->
300
+
name:string ->
301
+
url:string ->
302
+
unit
303
+
(** [remote_set_url] updates the URL of an existing remote. *)
304
+
305
+
val merge_allow_unrelated :
306
+
proc_mgr:proc_mgr ->
307
+
cwd:path ->
308
+
branch:string ->
309
+
message:string ->
310
+
(unit, [ `Conflict of string list ]) result
311
+
(** [merge_allow_unrelated] merges with [--allow-unrelated-histories].
312
+
Returns [Error (`Conflict files)] if there are conflicts. *)
313
+
314
+
val rebase :
315
+
proc_mgr:proc_mgr ->
316
+
cwd:path ->
317
+
onto:string ->
318
+
(unit, [ `Conflict of string ]) result
319
+
(** [rebase] rebases current branch onto [onto].
320
+
Returns [Error (`Conflict hint)] if there are conflicts. *)
321
+
322
+
val rebase_abort :
323
+
proc_mgr:proc_mgr ->
324
+
cwd:path ->
325
+
unit
326
+
(** [rebase_abort] aborts an in-progress rebase. *)
327
+
328
+
val merge_abort :
329
+
proc_mgr:proc_mgr ->
330
+
cwd:path ->
331
+
unit
332
+
(** [merge_abort] aborts an in-progress merge. *)
333
+
334
+
val reset_hard :
335
+
proc_mgr:proc_mgr ->
336
+
cwd:path ->
337
+
string ->
338
+
unit
339
+
(** [reset_hard] does a hard reset to the given ref. *)
340
+
341
+
val clean_fd :
342
+
proc_mgr:proc_mgr ->
343
+
cwd:path ->
344
+
unit
345
+
(** [clean_fd] removes untracked files and directories. *)
+221
lib/output.ml
+221
lib/output.ml
···
···
1
+
type format = Text | Json | Toml
2
+
3
+
(* JSON Codecs *)
4
+
5
+
let dev_repo_jsont =
6
+
Jsont.(
7
+
map
8
+
~dec:(fun s -> Dev_repo.of_string s)
9
+
~enc:Dev_repo.to_string string)
10
+
11
+
let package_name_jsont =
12
+
Jsont.(
13
+
map
14
+
~dec:OpamPackage.Name.of_string
15
+
~enc:OpamPackage.Name.to_string
16
+
string)
17
+
18
+
let package_version_jsont =
19
+
Jsont.(
20
+
map
21
+
~dec:OpamPackage.Version.of_string
22
+
~enc:OpamPackage.Version.to_string
23
+
string)
24
+
25
+
let package_info_jsont : Repo_index.package_info Jsont.t =
26
+
let open Jsont in
27
+
let open Repo_index in
28
+
Object.map
29
+
~kind:"package_info"
30
+
(fun name version dev_repo source_repo ->
31
+
(* Create a minimal opam record - we don't encode the full opam file *)
32
+
let opam = OpamFile.OPAM.empty in
33
+
{ name; version; opam; dev_repo; source_repo })
34
+
|> Object.mem "name" package_name_jsont
35
+
~enc:(fun p -> p.name)
36
+
|> Object.mem "version" package_version_jsont
37
+
~enc:(fun p -> p.version)
38
+
|> Object.opt_mem "dev_repo" dev_repo_jsont
39
+
~enc:(fun p -> p.dev_repo)
40
+
|> Object.mem "source_repo" string
41
+
~enc:(fun p -> p.source_repo)
42
+
|> Object.finish
43
+
44
+
let package_list_jsont = Jsont.list package_info_jsont
45
+
46
+
(* Text Output *)
47
+
48
+
let pp_package_info fmt (info : Repo_index.package_info) =
49
+
Format.fprintf fmt "%s.%s"
50
+
(OpamPackage.Name.to_string info.name)
51
+
(OpamPackage.Version.to_string info.version)
52
+
53
+
let pp_package_info_detailed fmt (info : Repo_index.package_info) =
54
+
Format.fprintf fmt "@[<v>%s.%s@, repo: %s"
55
+
(OpamPackage.Name.to_string info.name)
56
+
(OpamPackage.Version.to_string info.version)
57
+
info.source_repo;
58
+
(match info.dev_repo with
59
+
| Some dr -> Format.fprintf fmt "@, dev-repo: %s" (Dev_repo.to_string dr)
60
+
| None -> ());
61
+
Format.fprintf fmt "@]"
62
+
63
+
(* JSON encoding helper *)
64
+
let encode_json codec value =
65
+
match Jsont_bytesrw.encode_string codec value with
66
+
| Ok s -> s
67
+
| Error e -> failwith e
68
+
69
+
(* Output functions *)
70
+
71
+
let output_package_list format packages =
72
+
match format with
73
+
| Text ->
74
+
List.iter
75
+
(fun info -> Format.printf "%a@." pp_package_info info)
76
+
packages
77
+
| Json ->
78
+
let json = encode_json package_list_jsont packages in
79
+
print_endline json
80
+
| Toml ->
81
+
(* For TOML, we output as array of inline tables *)
82
+
Format.printf "# Package list@.";
83
+
List.iter
84
+
(fun (info : Repo_index.package_info) ->
85
+
Format.printf "[[packages]]@.";
86
+
Format.printf "name = %S@." (OpamPackage.Name.to_string info.name);
87
+
Format.printf "version = %S@."
88
+
(OpamPackage.Version.to_string info.version);
89
+
Format.printf "@.")
90
+
packages
91
+
92
+
let output_package_info format packages =
93
+
match format with
94
+
| Text ->
95
+
List.iter
96
+
(fun info -> Format.printf "%a@.@." pp_package_info_detailed info)
97
+
packages
98
+
| Json ->
99
+
let json = encode_json package_list_jsont packages in
100
+
print_endline json
101
+
| Toml ->
102
+
List.iter
103
+
(fun (info : Repo_index.package_info) ->
104
+
Format.printf "[[packages]]@.";
105
+
Format.printf "name = %S@." (OpamPackage.Name.to_string info.name);
106
+
Format.printf "version = %S@."
107
+
(OpamPackage.Version.to_string info.version);
108
+
Format.printf "source_repo = %S@." info.source_repo;
109
+
(match info.dev_repo with
110
+
| Some dr -> Format.printf "dev_repo = %S@." (Dev_repo.to_string dr)
111
+
| None -> ());
112
+
Format.printf "@.")
113
+
packages
114
+
115
+
let output_related format pkg_name packages =
116
+
match format with
117
+
| Text ->
118
+
Format.printf "Packages related to %s:@." pkg_name;
119
+
List.iter
120
+
(fun info -> Format.printf " %a@." pp_package_info info)
121
+
packages
122
+
| Json ->
123
+
let json_obj =
124
+
let open Jsont in
125
+
Object.map ~kind:"related_packages" (fun pkg related ->
126
+
(pkg, related))
127
+
|> Object.mem "package" string ~enc:fst
128
+
|> Object.mem "related" package_list_jsont ~enc:snd
129
+
|> Object.finish
130
+
in
131
+
let json = encode_json json_obj (pkg_name, packages) in
132
+
print_endline json
133
+
| Toml ->
134
+
Format.printf "package = %S@." pkg_name;
135
+
Format.printf "@.";
136
+
List.iter
137
+
(fun (info : Repo_index.package_info) ->
138
+
Format.printf "[[related]]@.";
139
+
Format.printf "name = %S@." (OpamPackage.Name.to_string info.name);
140
+
Format.printf "version = %S@."
141
+
(OpamPackage.Version.to_string info.version);
142
+
Format.printf "@.")
143
+
packages
144
+
145
+
let pp_grouped_source fmt (group : Source.grouped_sources) =
146
+
(match group.dev_repo with
147
+
| Some dr ->
148
+
Format.fprintf fmt "@[<v>## %s@," (Dev_repo.to_string dr)
149
+
| None ->
150
+
Format.fprintf fmt "@[<v>## (no dev-repo)@,");
151
+
List.iter
152
+
(fun (src : Source.package_source) ->
153
+
Format.fprintf fmt " %s.%s" src.name src.version;
154
+
(match src.source with
155
+
| Source.ArchiveSource a ->
156
+
Format.fprintf fmt " [%s]" a.url
157
+
| Source.GitSource g ->
158
+
Format.fprintf fmt " [git: %s]" g.url
159
+
| Source.NoSource -> ());
160
+
Format.fprintf fmt "@,")
161
+
group.packages;
162
+
Format.fprintf fmt "@]"
163
+
164
+
let output_sources format sources =
165
+
let grouped = Source.group_by_dev_repo sources in
166
+
match format with
167
+
| Text ->
168
+
List.iter (fun g -> Format.printf "%a@." pp_grouped_source g) grouped
169
+
| Json ->
170
+
let json = encode_json Source.grouped_sources_list_jsont grouped in
171
+
print_endline json
172
+
| Toml ->
173
+
(* Format as array of tables with nested packages *)
174
+
List.iter
175
+
(fun (group : Source.grouped_sources) ->
176
+
Format.printf "[[repos]]@.";
177
+
(match group.dev_repo with
178
+
| Some dr -> Format.printf "dev_repo = %S@." (Dev_repo.to_string dr)
179
+
| None -> Format.printf "# no dev-repo@.");
180
+
Format.printf "@.";
181
+
List.iter
182
+
(fun (src : Source.package_source) ->
183
+
Format.printf "[[repos.packages]]@.";
184
+
Format.printf "name = %S@." src.name;
185
+
Format.printf "version = %S@." src.version;
186
+
(match src.source with
187
+
| Source.ArchiveSource a ->
188
+
Format.printf "[repos.packages.source]@.";
189
+
Format.printf "type = \"archive\"@.";
190
+
Format.printf "url = %S@." a.url;
191
+
if a.checksums <> [] then begin
192
+
Format.printf "checksums = [";
193
+
List.iteri
194
+
(fun i cs ->
195
+
if i > 0 then Format.printf ", ";
196
+
Format.printf "%S" cs)
197
+
a.checksums;
198
+
Format.printf "]@."
199
+
end;
200
+
if a.mirrors <> [] then begin
201
+
Format.printf "mirrors = [";
202
+
List.iteri
203
+
(fun i m ->
204
+
if i > 0 then Format.printf ", ";
205
+
Format.printf "%S" m)
206
+
a.mirrors;
207
+
Format.printf "]@."
208
+
end
209
+
| Source.GitSource g ->
210
+
Format.printf "[repos.packages.source]@.";
211
+
Format.printf "type = \"git\"@.";
212
+
Format.printf "url = %S@." g.url;
213
+
(match g.branch with
214
+
| Some b -> Format.printf "branch = %S@." b
215
+
| None -> ())
216
+
| Source.NoSource ->
217
+
Format.printf "[repos.packages.source]@.";
218
+
Format.printf "type = \"none\"@.");
219
+
Format.printf "@.")
220
+
group.packages)
221
+
grouped
+35
lib/output.mli
+35
lib/output.mli
···
···
1
+
(** Output formatting for unpac commands.
2
+
3
+
Provides plain text, JSON, and TOML output formats. *)
4
+
5
+
(** {1 Output Format} *)
6
+
7
+
type format =
8
+
| Text (** Human-readable text output *)
9
+
| Json (** Machine-readable JSON output *)
10
+
| Toml (** TOML output *)
11
+
(** Output format selection. *)
12
+
13
+
(** {1 Package Output} *)
14
+
15
+
val output_package_list : format -> Repo_index.package_info list -> unit
16
+
(** [output_package_list fmt packages] outputs a list of packages. *)
17
+
18
+
val output_package_info : format -> Repo_index.package_info list -> unit
19
+
(** [output_package_info fmt packages] outputs detailed package information. *)
20
+
21
+
val output_related : format -> string -> Repo_index.package_info list -> unit
22
+
(** [output_related fmt pkg_name packages] outputs related packages. *)
23
+
24
+
(** {1 Source Output} *)
25
+
26
+
val output_sources : format -> Source.package_source list -> unit
27
+
(** [output_sources fmt sources] outputs package sources. *)
28
+
29
+
(** {1 JSON Codecs} *)
30
+
31
+
val package_info_jsont : Repo_index.package_info Jsont.t
32
+
(** JSON codec for package info. *)
33
+
34
+
val package_list_jsont : Repo_index.package_info list Jsont.t
35
+
(** JSON codec for package list. *)
+323
lib/project.ml
+323
lib/project.ml
···
···
1
+
(** Project management - handling project branches. *)
2
+
3
+
let src = Logs.Src.create "unpac.project" ~doc:"Project operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
(* Option helper for compatibility *)
7
+
let option_value ~default = function
8
+
| Some x -> x
9
+
| None -> default
10
+
11
+
(* Types *)
12
+
13
+
type project_info = {
14
+
name : string;
15
+
branch : string;
16
+
description : string;
17
+
created : string;
18
+
}
19
+
20
+
type registry = {
21
+
version : string;
22
+
projects : project_info list;
23
+
}
24
+
25
+
(* Branch conventions *)
26
+
27
+
let project_prefix = "project/"
28
+
29
+
let project_branch name = project_prefix ^ name
30
+
31
+
let is_project_branch branch =
32
+
String.starts_with ~prefix:project_prefix branch
33
+
34
+
let project_name_of_branch branch =
35
+
if is_project_branch branch then
36
+
Some (String.sub branch (String.length project_prefix)
37
+
(String.length branch - String.length project_prefix))
38
+
else
39
+
None
40
+
41
+
(* Get current timestamp in ISO 8601 format *)
42
+
let iso_timestamp () =
43
+
let t = Unix.gettimeofday () in
44
+
let tm = Unix.gmtime t in
45
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
46
+
(tm.Unix.tm_year + 1900)
47
+
(tm.Unix.tm_mon + 1)
48
+
tm.Unix.tm_mday
49
+
tm.Unix.tm_hour
50
+
tm.Unix.tm_min
51
+
tm.Unix.tm_sec
52
+
53
+
(* TOML encoding for registry *)
54
+
55
+
let project_info_codec =
56
+
let open Tomlt in
57
+
let open Table in
58
+
obj (fun name branch description created ->
59
+
{ name; branch; description; created })
60
+
|> mem "name" string ~enc:(fun p -> p.name)
61
+
|> mem "branch" string ~enc:(fun p -> p.branch)
62
+
|> mem "description" string ~dec_absent:"" ~enc:(fun p -> p.description)
63
+
|> mem "created" string ~dec_absent:"" ~enc:(fun p -> p.created)
64
+
|> finish
65
+
66
+
let registry_codec =
67
+
let open Tomlt in
68
+
let open Table in
69
+
obj (fun version projects -> { version; projects })
70
+
|> mem "version" string ~dec_absent:"0.1.0" ~enc:(fun r -> r.version)
71
+
|> mem "projects" (list project_info_codec) ~dec_absent:[] ~enc:(fun r -> r.projects)
72
+
|> finish
73
+
74
+
let unpac_toml_codec =
75
+
let open Tomlt in
76
+
let open Table in
77
+
obj (fun unpac -> unpac)
78
+
|> mem "unpac" registry_codec ~enc:Fun.id
79
+
|> finish
80
+
81
+
(* Configuration *)
82
+
83
+
let config_file = "unpac.toml"
84
+
85
+
let load_registry ~cwd =
86
+
let path = Eio.Path.(cwd / config_file) in
87
+
match Eio.Path.load path with
88
+
| content ->
89
+
begin match Tomlt_bytesrw.decode_string unpac_toml_codec content with
90
+
| Ok registry -> Some registry
91
+
| Error e ->
92
+
Log.warn (fun m -> m "Failed to parse %s: %s" config_file
93
+
(Tomlt.Toml.Error.to_string e));
94
+
None
95
+
end
96
+
| exception Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) ->
97
+
None
98
+
| exception exn ->
99
+
Log.warn (fun m -> m "Failed to load %s: %a" config_file Fmt.exn exn);
100
+
None
101
+
102
+
let save_registry ~cwd registry =
103
+
let path = Eio.Path.(cwd / config_file) in
104
+
let content = Tomlt_bytesrw.encode_string unpac_toml_codec registry in
105
+
Eio.Path.save ~create:(`Or_truncate 0o644) path content;
106
+
Log.debug (fun m -> m "Saved registry to %s" config_file)
107
+
108
+
(* Queries *)
109
+
110
+
let current_project ~proc_mgr ~cwd =
111
+
match Git.current_branch ~proc_mgr ~cwd with
112
+
| None -> None
113
+
| Some branch -> project_name_of_branch branch
114
+
115
+
let require_project_branch ~proc_mgr ~cwd =
116
+
match Git.current_branch ~proc_mgr ~cwd with
117
+
| None ->
118
+
Log.err (fun m -> m "Not on any branch (detached HEAD)");
119
+
failwith "Not on any branch. Switch to a project branch first."
120
+
| Some branch ->
121
+
match project_name_of_branch branch with
122
+
| Some name -> name
123
+
| None ->
124
+
Log.err (fun m -> m "Not on a project branch. Current branch: %s" branch);
125
+
failwith (Printf.sprintf
126
+
"Not on a project branch (current: %s).\n\
127
+
Switch to a project: unpac project switch <name>\n\
128
+
Or create one: unpac project create <name>" branch)
129
+
130
+
let is_main_branch ~proc_mgr ~cwd =
131
+
match Git.current_branch ~proc_mgr ~cwd with
132
+
| Some "main" | Some "master" -> true
133
+
| _ -> false
134
+
135
+
let list_projects ~proc_mgr ~cwd =
136
+
(* First try to load from registry on current branch *)
137
+
match load_registry ~cwd with
138
+
| Some registry -> registry.projects
139
+
| None ->
140
+
(* Fallback: scan for project branches *)
141
+
let branches = Git.run_lines ~proc_mgr ~cwd
142
+
["for-each-ref"; "--format=%(refname:short)"; "refs/heads/project/"]
143
+
in
144
+
List.filter_map (fun branch ->
145
+
match project_name_of_branch branch with
146
+
| Some name -> Some { name; branch; description = ""; created = "" }
147
+
| None -> None
148
+
) branches
149
+
150
+
let project_exists ~proc_mgr ~cwd name =
151
+
Git.branch_exists ~proc_mgr ~cwd (project_branch name)
152
+
153
+
(* Operations *)
154
+
155
+
let init ~proc_mgr ~cwd =
156
+
if Git.is_repository cwd then begin
157
+
Log.warn (fun m -> m "Git repository already exists");
158
+
(* Check if we have a registry *)
159
+
if Option.is_some (load_registry ~cwd) then
160
+
Log.info (fun m -> m "Registry already exists")
161
+
else begin
162
+
(* Create registry on current branch *)
163
+
let registry = { version = "0.1.0"; projects = [] } in
164
+
save_registry ~cwd registry;
165
+
if Git.has_uncommitted_changes ~proc_mgr ~cwd then begin
166
+
Git.add_all ~proc_mgr ~cwd;
167
+
Git.commit ~proc_mgr ~cwd ~message:"unpac: initialize project registry"
168
+
end
169
+
end
170
+
end else begin
171
+
Log.info (fun m -> m "Initializing git repository...");
172
+
Git.init ~proc_mgr ~cwd;
173
+
174
+
(* Create README *)
175
+
let readme_path = Eio.Path.(cwd / "README.md") in
176
+
let readme_content = {|# Unpac Vendor Repository
177
+
178
+
This repository uses unpac's project-based branch model for vendoring OCaml packages.
179
+
180
+
## Branch Structure
181
+
182
+
- `main` - Project registry (metadata only)
183
+
- `project/<name>` - Individual project branches with vendored code
184
+
185
+
## Quick Start
186
+
187
+
```bash
188
+
# Create a new project
189
+
unpac project create myapp
190
+
191
+
# Add packages (must be on a project branch)
192
+
unpac add opam eio
193
+
unpac add opam lwt --with-deps
194
+
195
+
# Check status
196
+
unpac vendor status
197
+
```
198
+
199
+
## Commands
200
+
201
+
```bash
202
+
unpac init # Initialize repository
203
+
unpac project create <name> # Create new project
204
+
unpac project switch <name> # Switch to project
205
+
unpac add opam <pkg> # Add package from opam
206
+
unpac vendor status # Show vendored packages
207
+
unpac vendor update <pkg> # Update from upstream
208
+
```
209
+
|}
210
+
in
211
+
Eio.Path.save ~create:(`Or_truncate 0o644) readme_path readme_content;
212
+
213
+
(* Create .gitignore *)
214
+
let gitignore_path = Eio.Path.(cwd / ".gitignore") in
215
+
let gitignore_content = {|_build/
216
+
*.install
217
+
.merlin
218
+
*.byte
219
+
*.native
220
+
*.cmo
221
+
*.cmi
222
+
*.cma
223
+
*.cmx
224
+
*.cmxa
225
+
*.cmxs
226
+
*.o
227
+
*.a
228
+
.unpac/
229
+
|}
230
+
in
231
+
Eio.Path.save ~create:(`Or_truncate 0o644) gitignore_path gitignore_content;
232
+
233
+
(* Create registry *)
234
+
let registry = { version = "0.1.0"; projects = [] } in
235
+
save_registry ~cwd registry;
236
+
237
+
(* Initial commit *)
238
+
Git.add_all ~proc_mgr ~cwd;
239
+
Git.commit ~proc_mgr ~cwd ~message:"Initial unpac repository setup";
240
+
241
+
Log.info (fun m -> m "Repository initialized")
242
+
end
243
+
244
+
let create ~proc_mgr ~cwd ~name ?(description="") () =
245
+
if project_exists ~proc_mgr ~cwd name then begin
246
+
Log.err (fun m -> m "Project %s already exists" name);
247
+
failwith (Printf.sprintf "Project '%s' already exists" name)
248
+
end;
249
+
250
+
let branch = project_branch name in
251
+
let created = iso_timestamp () in
252
+
253
+
Log.info (fun m -> m "Creating project: %s" name);
254
+
255
+
(* Load current registry (might be on main or another branch) *)
256
+
let registry = load_registry ~cwd |> option_value
257
+
~default:{ version = "0.1.0"; projects = [] }
258
+
in
259
+
260
+
(* Add project to registry *)
261
+
let project = { name; branch; description; created } in
262
+
let registry = { registry with projects = project :: registry.projects } in
263
+
264
+
(* Create the project branch from current HEAD *)
265
+
let current = Git.current_branch ~proc_mgr ~cwd in
266
+
let start_point = Git.current_head ~proc_mgr ~cwd in
267
+
268
+
Git.branch_create ~proc_mgr ~cwd ~name:branch ~start_point;
269
+
Git.checkout ~proc_mgr ~cwd branch;
270
+
271
+
(* Create project-specific config *)
272
+
let project_config_path = Eio.Path.(cwd / config_file) in
273
+
let project_config = Printf.sprintf {|[project]
274
+
name = "%s"
275
+
description = "%s"
276
+
277
+
[opam]
278
+
repositories = []
279
+
# compiler = "ocaml.5.3.0"
280
+
281
+
[vendor]
282
+
# Vendored packages will be listed here
283
+
|} name description
284
+
in
285
+
Eio.Path.save ~create:(`Or_truncate 0o644) project_config_path project_config;
286
+
287
+
Git.add_all ~proc_mgr ~cwd;
288
+
Git.commit ~proc_mgr ~cwd ~message:(Printf.sprintf "project: create %s" name);
289
+
290
+
(* Update registry on main branch if it exists *)
291
+
begin match current with
292
+
| Some "main" | Some "master" as main_branch ->
293
+
let main = Option.get main_branch in
294
+
Git.checkout ~proc_mgr ~cwd main;
295
+
save_registry ~cwd registry;
296
+
if Git.has_uncommitted_changes ~proc_mgr ~cwd then begin
297
+
Git.add_all ~proc_mgr ~cwd;
298
+
Git.commit ~proc_mgr ~cwd ~message:(Printf.sprintf "registry: add project %s" name)
299
+
end;
300
+
(* Switch back to project branch *)
301
+
Git.checkout ~proc_mgr ~cwd branch
302
+
| _ ->
303
+
(* Not on main, just save registry to current project branch too *)
304
+
save_registry ~cwd registry
305
+
end;
306
+
307
+
Log.info (fun m -> m "Created project '%s' on branch '%s'" name branch);
308
+
Log.info (fun m -> m "Add packages with: unpac add opam <pkg>")
309
+
310
+
let switch ~proc_mgr ~cwd name =
311
+
let branch = project_branch name in
312
+
if not (Git.branch_exists ~proc_mgr ~cwd branch) then begin
313
+
Log.err (fun m -> m "Project %s does not exist" name);
314
+
failwith (Printf.sprintf "Project '%s' does not exist. Create it with: unpac project create %s" name name)
315
+
end;
316
+
317
+
if Git.has_uncommitted_changes ~proc_mgr ~cwd then begin
318
+
Log.warn (fun m -> m "You have uncommitted changes");
319
+
Log.warn (fun m -> m "Commit or stash them before switching projects")
320
+
end;
321
+
322
+
Log.info (fun m -> m "Switching to project: %s" name);
323
+
Git.checkout ~proc_mgr ~cwd branch
+100
lib/project.mli
+100
lib/project.mli
···
···
1
+
(** Project management - handling project branches.
2
+
3
+
The main branch serves as a registry of all projects.
4
+
Each project has its own branch [project/<name>] where actual work happens. *)
5
+
6
+
(** {1 Types} *)
7
+
8
+
type project_info = {
9
+
name : string;
10
+
branch : string;
11
+
description : string;
12
+
created : string; (** ISO 8601 timestamp *)
13
+
}
14
+
15
+
(** {1 Branch conventions} *)
16
+
17
+
val project_branch : string -> string
18
+
(** [project_branch name] returns ["project/<name>"] *)
19
+
20
+
val is_project_branch : string -> bool
21
+
(** [is_project_branch branch] checks if [branch] is a project branch. *)
22
+
23
+
val project_name_of_branch : string -> string option
24
+
(** [project_name_of_branch branch] extracts project name from branch. *)
25
+
26
+
(** {1 Queries} *)
27
+
28
+
val current_project :
29
+
proc_mgr:Git.proc_mgr ->
30
+
cwd:Git.path ->
31
+
string option
32
+
(** [current_project ~proc_mgr ~cwd] returns the current project name if on a project branch. *)
33
+
34
+
val require_project_branch :
35
+
proc_mgr:Git.proc_mgr ->
36
+
cwd:Git.path ->
37
+
string
38
+
(** [require_project_branch ~proc_mgr ~cwd] returns project name or raises error. *)
39
+
40
+
val is_main_branch :
41
+
proc_mgr:Git.proc_mgr ->
42
+
cwd:Git.path ->
43
+
bool
44
+
(** [is_main_branch ~proc_mgr ~cwd] checks if currently on main branch. *)
45
+
46
+
val list_projects :
47
+
proc_mgr:Git.proc_mgr ->
48
+
cwd:Git.path ->
49
+
project_info list
50
+
(** [list_projects ~proc_mgr ~cwd] returns all projects from the registry. *)
51
+
52
+
val project_exists :
53
+
proc_mgr:Git.proc_mgr ->
54
+
cwd:Git.path ->
55
+
string ->
56
+
bool
57
+
(** [project_exists ~proc_mgr ~cwd name] checks if project [name] exists. *)
58
+
59
+
(** {1 Operations} *)
60
+
61
+
val init :
62
+
proc_mgr:Git.proc_mgr ->
63
+
cwd:Git.path ->
64
+
unit
65
+
(** [init ~proc_mgr ~cwd] initializes the repository with main branch and registry. *)
66
+
67
+
val create :
68
+
proc_mgr:Git.proc_mgr ->
69
+
cwd:Git.path ->
70
+
name:string ->
71
+
?description:string ->
72
+
unit ->
73
+
unit
74
+
(** [create ~proc_mgr ~cwd ~name ()] creates a new project and switches to it.
75
+
The project is registered in main branch's unpac.toml. *)
76
+
77
+
val switch :
78
+
proc_mgr:Git.proc_mgr ->
79
+
cwd:Git.path ->
80
+
string ->
81
+
unit
82
+
(** [switch ~proc_mgr ~cwd name] switches to project [name]. *)
83
+
84
+
(** {1 Configuration} *)
85
+
86
+
type registry = {
87
+
version : string;
88
+
projects : project_info list;
89
+
}
90
+
91
+
val load_registry :
92
+
cwd:Git.path ->
93
+
registry option
94
+
(** [load_registry ~cwd] loads the project registry from main branch's unpac.toml. *)
95
+
96
+
val save_registry :
97
+
cwd:Git.path ->
98
+
registry ->
99
+
unit
100
+
(** [save_registry ~cwd registry] saves the project registry. *)
+315
lib/recovery.ml
+315
lib/recovery.ml
···
···
1
+
(** Recovery state for error recovery during multi-step operations. *)
2
+
3
+
let src = Logs.Src.create "unpac.recovery" ~doc:"Recovery operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
(* Step types *)
7
+
8
+
type step =
9
+
| Remote_add of { remote : string; url : string }
10
+
| Fetch of { remote : string }
11
+
| Create_upstream of { branch : string; start_point : string }
12
+
| Create_vendor of { name : string; upstream : string }
13
+
| Create_patches of { branch : string; vendor : string }
14
+
| Merge_to_project of { patches : string }
15
+
| Update_toml of { package_name : string }
16
+
| Commit of { message : string }
17
+
18
+
let step_name = function
19
+
| Remote_add _ -> "remote_add"
20
+
| Fetch _ -> "fetch"
21
+
| Create_upstream _ -> "create_upstream"
22
+
| Create_vendor _ -> "create_vendor"
23
+
| Create_patches _ -> "create_patches"
24
+
| Merge_to_project _ -> "merge_to_project"
25
+
| Update_toml _ -> "update_toml"
26
+
| Commit _ -> "commit"
27
+
28
+
let pp_step fmt = function
29
+
| Remote_add { remote; url } ->
30
+
Format.fprintf fmt "remote_add(%s -> %s)" remote url
31
+
| Fetch { remote } ->
32
+
Format.fprintf fmt "fetch(%s)" remote
33
+
| Create_upstream { branch; start_point } ->
34
+
Format.fprintf fmt "create_upstream(%s from %s)" branch start_point
35
+
| Create_vendor { name; upstream } ->
36
+
Format.fprintf fmt "create_vendor(%s from %s)" name upstream
37
+
| Create_patches { branch; vendor } ->
38
+
Format.fprintf fmt "create_patches(%s from %s)" branch vendor
39
+
| Merge_to_project { patches } ->
40
+
Format.fprintf fmt "merge_to_project(%s)" patches
41
+
| Update_toml { package_name } ->
42
+
Format.fprintf fmt "update_toml(%s)" package_name
43
+
| Commit { message } ->
44
+
let msg = if String.length message > 30 then String.sub message 0 30 ^ "..." else message in
45
+
Format.fprintf fmt "commit(%s)" msg
46
+
47
+
(* Operation types *)
48
+
49
+
type operation =
50
+
| Add_package of {
51
+
name : string;
52
+
url : string;
53
+
branch : string;
54
+
opam_packages : string list
55
+
}
56
+
| Update_package of { name : string }
57
+
| Rebase_patches of { name : string }
58
+
59
+
let pp_operation fmt = function
60
+
| Add_package { name; _ } ->
61
+
Format.fprintf fmt "add_package(%s)" name
62
+
| Update_package { name } ->
63
+
Format.fprintf fmt "update_package(%s)" name
64
+
| Rebase_patches { name } ->
65
+
Format.fprintf fmt "rebase_patches(%s)" name
66
+
67
+
(* State *)
68
+
69
+
type state = {
70
+
operation : operation;
71
+
original_branch : string;
72
+
original_head : string;
73
+
started : string;
74
+
completed : step list;
75
+
pending : step list;
76
+
}
77
+
78
+
let pp_state fmt state =
79
+
Format.fprintf fmt "@[<v>Operation: %a@,Original: %s @ %s@,Started: %s@,Completed: %d steps@,Pending: %d steps@]"
80
+
pp_operation state.operation
81
+
state.original_branch state.original_head
82
+
state.started
83
+
(List.length state.completed)
84
+
(List.length state.pending)
85
+
86
+
(* Persistence *)
87
+
88
+
let recovery_dir = ".unpac"
89
+
let recovery_file = ".unpac/recovery.toml"
90
+
91
+
(* TOML encoding for steps - uses Tomlt.Toml for raw value construction *)
92
+
module T = Tomlt.Toml
93
+
94
+
let step_to_toml step =
95
+
let typ = step_name step in
96
+
let data = match step with
97
+
| Remote_add { remote; url } ->
98
+
[("remote", T.string remote); ("url", T.string url)]
99
+
| Fetch { remote } ->
100
+
[("remote", T.string remote)]
101
+
| Create_upstream { branch; start_point } ->
102
+
[("branch", T.string branch); ("start_point", T.string start_point)]
103
+
| Create_vendor { name; upstream } ->
104
+
[("name", T.string name); ("upstream", T.string upstream)]
105
+
| Create_patches { branch; vendor } ->
106
+
[("branch", T.string branch); ("vendor", T.string vendor)]
107
+
| Merge_to_project { patches } ->
108
+
[("patches", T.string patches)]
109
+
| Update_toml { package_name } ->
110
+
[("package_name", T.string package_name)]
111
+
| Commit { message } ->
112
+
[("message", T.string message)]
113
+
in
114
+
T.table (("type", T.string typ) :: data)
115
+
116
+
let step_of_toml toml =
117
+
let get_string key =
118
+
match T.find_opt key toml with
119
+
| Some (T.String s) -> s
120
+
| _ -> failwith ("missing key: " ^ key)
121
+
in
122
+
match get_string "type" with
123
+
| "remote_add" ->
124
+
Remote_add { remote = get_string "remote"; url = get_string "url" }
125
+
| "fetch" ->
126
+
Fetch { remote = get_string "remote" }
127
+
| "create_upstream" ->
128
+
Create_upstream { branch = get_string "branch"; start_point = get_string "start_point" }
129
+
| "create_vendor" ->
130
+
Create_vendor { name = get_string "name"; upstream = get_string "upstream" }
131
+
| "create_patches" ->
132
+
Create_patches { branch = get_string "branch"; vendor = get_string "vendor" }
133
+
| "merge_to_project" ->
134
+
Merge_to_project { patches = get_string "patches" }
135
+
| "update_toml" ->
136
+
Update_toml { package_name = get_string "package_name" }
137
+
| "commit" ->
138
+
Commit { message = get_string "message" }
139
+
| typ ->
140
+
failwith ("unknown step type: " ^ typ)
141
+
142
+
let operation_to_toml op =
143
+
match op with
144
+
| Add_package { name; url; branch; opam_packages } ->
145
+
T.table [
146
+
("type", T.string "add_package");
147
+
("name", T.string name);
148
+
("url", T.string url);
149
+
("branch", T.string branch);
150
+
("opam_packages", T.array (List.map T.string opam_packages));
151
+
]
152
+
| Update_package { name } ->
153
+
T.table [
154
+
("type", T.string "update_package");
155
+
("name", T.string name);
156
+
]
157
+
| Rebase_patches { name } ->
158
+
T.table [
159
+
("type", T.string "rebase_patches");
160
+
("name", T.string name);
161
+
]
162
+
163
+
let operation_of_toml toml =
164
+
let get_string key =
165
+
match T.find_opt key toml with
166
+
| Some (T.String s) -> s
167
+
| _ -> failwith ("missing key: " ^ key)
168
+
in
169
+
let get_string_list key =
170
+
match T.find_opt key toml with
171
+
| Some (T.Array arr) ->
172
+
List.filter_map (function T.String s -> Some s | _ -> None) arr
173
+
| _ -> []
174
+
in
175
+
match get_string "type" with
176
+
| "add_package" ->
177
+
Add_package {
178
+
name = get_string "name";
179
+
url = get_string "url";
180
+
branch = get_string "branch";
181
+
opam_packages = get_string_list "opam_packages";
182
+
}
183
+
| "update_package" ->
184
+
Update_package { name = get_string "name" }
185
+
| "rebase_patches" ->
186
+
Rebase_patches { name = get_string "name" }
187
+
| typ ->
188
+
failwith ("unknown operation type: " ^ typ)
189
+
190
+
let state_to_toml state =
191
+
T.table [
192
+
("operation", operation_to_toml state.operation);
193
+
("original_branch", T.string state.original_branch);
194
+
("original_head", T.string state.original_head);
195
+
("started", T.string state.started);
196
+
("completed", T.array (List.map step_to_toml state.completed));
197
+
("pending", T.array (List.map step_to_toml state.pending));
198
+
]
199
+
200
+
let state_of_toml toml =
201
+
let get_string key =
202
+
match T.find_opt key toml with
203
+
| Some (T.String s) -> s
204
+
| _ -> failwith ("missing key: " ^ key)
205
+
in
206
+
let get_table key =
207
+
match T.find_opt key toml with
208
+
| Some (T.Table t) -> T.table t
209
+
| _ -> failwith ("missing table: " ^ key)
210
+
in
211
+
let get_step_list key =
212
+
match T.find_opt key toml with
213
+
| Some (T.Array arr) ->
214
+
List.filter_map (function
215
+
| T.Table t -> Some (step_of_toml (T.table t))
216
+
| _ -> None
217
+
) arr
218
+
| _ -> []
219
+
in
220
+
{
221
+
operation = operation_of_toml (get_table "operation");
222
+
original_branch = get_string "original_branch";
223
+
original_head = get_string "original_head";
224
+
started = get_string "started";
225
+
completed = get_step_list "completed";
226
+
pending = get_step_list "pending";
227
+
}
228
+
229
+
let save ~cwd state =
230
+
let dir_path = Eio.Path.(cwd / recovery_dir) in
231
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dir_path;
232
+
let file_path = Eio.Path.(cwd / recovery_file) in
233
+
let toml = state_to_toml state in
234
+
let content = Tomlt_bytesrw.to_string toml in
235
+
Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
236
+
Log.debug (fun m -> m "Saved recovery state to %s" recovery_file)
237
+
238
+
let load ~cwd =
239
+
let file_path = Eio.Path.(cwd / recovery_file) in
240
+
match Eio.Path.load file_path with
241
+
| content ->
242
+
begin match Tomlt_bytesrw.of_string content with
243
+
| Ok toml ->
244
+
let state = state_of_toml toml in
245
+
Log.debug (fun m -> m "Loaded recovery state: %a" pp_state state);
246
+
Some state
247
+
| Error e ->
248
+
Log.warn (fun m -> m "Failed to parse recovery file: %s"
249
+
(Tomlt.Toml.Error.to_string e));
250
+
None
251
+
end
252
+
| exception Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) ->
253
+
None
254
+
| exception exn ->
255
+
Log.warn (fun m -> m "Failed to load recovery file: %a" Fmt.exn exn);
256
+
None
257
+
258
+
let clear ~cwd =
259
+
let file_path = Eio.Path.(cwd / recovery_file) in
260
+
begin try Eio.Path.unlink file_path
261
+
with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> ()
262
+
end;
263
+
Log.debug (fun m -> m "Cleared recovery state")
264
+
265
+
let has_recovery ~cwd =
266
+
let file_path = Eio.Path.(cwd / recovery_file) in
267
+
match Eio.Path.kind ~follow:false file_path with
268
+
| `Regular_file -> true
269
+
| _ -> false
270
+
| exception _ -> false
271
+
272
+
(* State transitions *)
273
+
274
+
let mark_step_complete state =
275
+
match state.pending with
276
+
| [] -> state
277
+
| step :: rest ->
278
+
{ state with
279
+
completed = step :: state.completed;
280
+
pending = rest;
281
+
}
282
+
283
+
let current_step state =
284
+
match state.pending with
285
+
| [] -> None
286
+
| step :: _ -> Some step
287
+
288
+
(* Abort and resume *)
289
+
290
+
let abort ~proc_mgr ~cwd state =
291
+
Log.info (fun m -> m "Aborting operation: %a" pp_operation state.operation);
292
+
Log.info (fun m -> m "Restoring to: %s @ %s" state.original_branch state.original_head);
293
+
294
+
(* Abort any in-progress operations *)
295
+
Git.rebase_abort ~proc_mgr ~cwd;
296
+
Git.merge_abort ~proc_mgr ~cwd;
297
+
298
+
(* Reset to original state *)
299
+
Git.reset_hard ~proc_mgr ~cwd state.original_head;
300
+
Git.clean_fd ~proc_mgr ~cwd;
301
+
302
+
(* Switch back to original branch if possible *)
303
+
begin try
304
+
Git.checkout ~proc_mgr ~cwd state.original_branch
305
+
with _ ->
306
+
Log.warn (fun m -> m "Could not switch back to %s" state.original_branch)
307
+
end;
308
+
309
+
(* Clear recovery state *)
310
+
clear ~cwd;
311
+
312
+
Log.info (fun m -> m "Aborted. Repository restored to previous state.")
313
+
314
+
let can_resume state =
315
+
state.pending <> []
+93
lib/recovery.mli
+93
lib/recovery.mli
···
···
1
+
(** Recovery state for error recovery during multi-step operations.
2
+
3
+
When a multi-step operation (like adding a package) fails partway through,
4
+
the recovery state allows us to either:
5
+
- Resume from where we left off
6
+
- Abort and rollback to the original state *)
7
+
8
+
(** {1 Step Types} *)
9
+
10
+
type step =
11
+
| Remote_add of { remote : string; url : string }
12
+
| Fetch of { remote : string }
13
+
| Create_upstream of { branch : string; start_point : string }
14
+
| Create_vendor of { name : string; upstream : string }
15
+
| Create_patches of { branch : string; vendor : string }
16
+
| Merge_to_project of { patches : string }
17
+
| Update_toml of { package_name : string }
18
+
| Commit of { message : string }
19
+
20
+
val pp_step : Format.formatter -> step -> unit
21
+
val step_name : step -> string
22
+
23
+
(** {1 Operation Types} *)
24
+
25
+
type operation =
26
+
| Add_package of {
27
+
name : string;
28
+
url : string;
29
+
branch : string;
30
+
opam_packages : string list
31
+
}
32
+
| Update_package of { name : string }
33
+
| Rebase_patches of { name : string }
34
+
35
+
val pp_operation : Format.formatter -> operation -> unit
36
+
37
+
(** {1 State} *)
38
+
39
+
type state = {
40
+
operation : operation;
41
+
original_branch : string;
42
+
original_head : string;
43
+
started : string; (** ISO 8601 timestamp *)
44
+
completed : step list;
45
+
pending : step list;
46
+
}
47
+
48
+
val pp_state : Format.formatter -> state -> unit
49
+
50
+
(** {1 Persistence} *)
51
+
52
+
val recovery_dir : string
53
+
(** [".unpac"] - directory for recovery state *)
54
+
55
+
val recovery_file : string
56
+
(** [".unpac/recovery.toml"] - recovery state file *)
57
+
58
+
val save : cwd:Git.path -> state -> unit
59
+
(** [save ~cwd state] persists recovery state to disk. *)
60
+
61
+
val load : cwd:Git.path -> state option
62
+
(** [load ~cwd] loads recovery state if it exists. *)
63
+
64
+
val clear : cwd:Git.path -> unit
65
+
(** [clear ~cwd] removes recovery state file. *)
66
+
67
+
val has_recovery : cwd:Git.path -> bool
68
+
(** [has_recovery ~cwd] checks if there's pending recovery state. *)
69
+
70
+
(** {1 State Transitions} *)
71
+
72
+
val mark_step_complete : state -> state
73
+
(** [mark_step_complete state] moves the first pending step to completed. *)
74
+
75
+
val current_step : state -> step option
76
+
(** [current_step state] returns the next step to execute. *)
77
+
78
+
(** {1 Abort and Resume} *)
79
+
80
+
val abort :
81
+
proc_mgr:Git.proc_mgr ->
82
+
cwd:Git.path ->
83
+
state ->
84
+
unit
85
+
(** [abort ~proc_mgr ~cwd state] aborts the operation and restores original state.
86
+
This will:
87
+
- Abort any in-progress merge or rebase
88
+
- Reset to original HEAD
89
+
- Clean up partial state
90
+
- Remove recovery file *)
91
+
92
+
val can_resume : state -> bool
93
+
(** [can_resume state] returns true if the operation can be resumed. *)
+120
lib/repo_index.ml
+120
lib/repo_index.ml
···
···
1
+
type package_info = {
2
+
name : OpamPackage.Name.t;
3
+
version : OpamPackage.Version.t;
4
+
opam : OpamFile.OPAM.t;
5
+
dev_repo : Dev_repo.t option;
6
+
source_repo : string;
7
+
}
8
+
9
+
type t = {
10
+
packages : package_info OpamPackage.Map.t;
11
+
by_name : OpamPackage.Set.t OpamPackage.Name.Map.t;
12
+
by_dev_repo : OpamPackage.Set.t Dev_repo.Map.t;
13
+
repos : string list;
14
+
}
15
+
16
+
let empty =
17
+
{
18
+
packages = OpamPackage.Map.empty;
19
+
by_name = OpamPackage.Name.Map.empty;
20
+
by_dev_repo = Dev_repo.Map.empty;
21
+
repos = [];
22
+
}
23
+
24
+
let add_package nv info t =
25
+
let packages = OpamPackage.Map.add nv info t.packages in
26
+
let by_name =
27
+
let name = OpamPackage.name nv in
28
+
let existing =
29
+
match OpamPackage.Name.Map.find_opt name t.by_name with
30
+
| Some s -> s
31
+
| None -> OpamPackage.Set.empty
32
+
in
33
+
OpamPackage.Name.Map.add name (OpamPackage.Set.add nv existing) t.by_name
34
+
in
35
+
let by_dev_repo =
36
+
match info.dev_repo with
37
+
| Some dev_repo ->
38
+
let existing =
39
+
match Dev_repo.Map.find_opt dev_repo t.by_dev_repo with
40
+
| Some s -> s
41
+
| None -> OpamPackage.Set.empty
42
+
in
43
+
Dev_repo.Map.add dev_repo (OpamPackage.Set.add nv existing) t.by_dev_repo
44
+
| None -> t.by_dev_repo
45
+
in
46
+
{ t with packages; by_name; by_dev_repo }
47
+
48
+
let load_local_repo ~name ~path t =
49
+
let repo_root = OpamFilename.Dir.of_string path in
50
+
let pkg_prefixes = OpamRepository.packages_with_prefixes repo_root in
51
+
let t =
52
+
if List.mem name t.repos then t else { t with repos = name :: t.repos }
53
+
in
54
+
OpamPackage.Map.fold
55
+
(fun nv prefix acc ->
56
+
let opam_file = OpamRepositoryPath.opam repo_root prefix nv in
57
+
match OpamFile.OPAM.read_opt opam_file with
58
+
| Some opam ->
59
+
let dev_repo =
60
+
OpamFile.OPAM.dev_repo opam |> Option.map Dev_repo.of_opam_url
61
+
in
62
+
let info =
63
+
{
64
+
name = OpamPackage.name nv;
65
+
version = OpamPackage.version nv;
66
+
opam;
67
+
dev_repo;
68
+
source_repo = name;
69
+
}
70
+
in
71
+
add_package nv info acc
72
+
| None -> acc)
73
+
pkg_prefixes t
74
+
75
+
let all_packages t =
76
+
OpamPackage.Map.fold (fun _ info acc -> info :: acc) t.packages []
77
+
78
+
let find_package name t =
79
+
match OpamPackage.Name.Map.find_opt name t.by_name with
80
+
| None -> []
81
+
| Some nvs ->
82
+
OpamPackage.Set.fold
83
+
(fun nv acc ->
84
+
match OpamPackage.Map.find_opt nv t.packages with
85
+
| Some info -> info :: acc
86
+
| None -> acc)
87
+
nvs []
88
+
89
+
let find_package_version name version t =
90
+
let nv = OpamPackage.create name version in
91
+
OpamPackage.Map.find_opt nv t.packages
92
+
93
+
let packages_by_dev_repo dev_repo t =
94
+
match Dev_repo.Map.find_opt dev_repo t.by_dev_repo with
95
+
| None -> []
96
+
| Some nvs ->
97
+
OpamPackage.Set.fold
98
+
(fun nv acc ->
99
+
match OpamPackage.Map.find_opt nv t.packages with
100
+
| Some info -> info :: acc
101
+
| None -> acc)
102
+
nvs []
103
+
104
+
let related_packages name t =
105
+
let versions = find_package name t in
106
+
let dev_repos =
107
+
List.filter_map (fun info -> info.dev_repo) versions
108
+
|> List.sort_uniq Dev_repo.compare
109
+
in
110
+
List.concat_map (fun dr -> packages_by_dev_repo dr t) dev_repos
111
+
|> List.sort_uniq (fun a b ->
112
+
let cmp = OpamPackage.Name.compare a.name b.name in
113
+
if cmp <> 0 then cmp
114
+
else OpamPackage.Version.compare a.version b.version)
115
+
116
+
let package_names t =
117
+
OpamPackage.Name.Map.fold (fun name _ acc -> name :: acc) t.by_name []
118
+
119
+
let package_count t = OpamPackage.Map.cardinal t.packages
120
+
let repo_count t = List.length t.repos
+59
lib/repo_index.mli
+59
lib/repo_index.mli
···
···
1
+
(** Repository index for opam packages.
2
+
3
+
This module provides functionality to load and query packages from
4
+
multiple opam repositories, with support for merging with configurable
5
+
priority. *)
6
+
7
+
(** {1 Types} *)
8
+
9
+
type package_info = {
10
+
name : OpamPackage.Name.t;
11
+
version : OpamPackage.Version.t;
12
+
opam : OpamFile.OPAM.t;
13
+
dev_repo : Dev_repo.t option;
14
+
source_repo : string; (** Name of the repository this package came from *)
15
+
}
16
+
(** Information about a single package version. *)
17
+
18
+
type t
19
+
(** The repository index containing all loaded packages. *)
20
+
21
+
(** {1 Creation} *)
22
+
23
+
val empty : t
24
+
(** [empty] is an empty repository index. *)
25
+
26
+
val load_local_repo : name:string -> path:string -> t -> t
27
+
(** [load_local_repo ~name ~path index] loads all packages from the local
28
+
opam repository at [path] and adds them to [index]. Packages from this
29
+
load will take priority over existing packages with the same name/version. *)
30
+
31
+
(** {1 Queries} *)
32
+
33
+
val all_packages : t -> package_info list
34
+
(** [all_packages t] returns all packages in the index. *)
35
+
36
+
val find_package : OpamPackage.Name.t -> t -> package_info list
37
+
(** [find_package name t] returns all versions of package [name]. *)
38
+
39
+
val find_package_version :
40
+
OpamPackage.Name.t -> OpamPackage.Version.t -> t -> package_info option
41
+
(** [find_package_version name version t] returns the specific package version. *)
42
+
43
+
val packages_by_dev_repo : Dev_repo.t -> t -> package_info list
44
+
(** [packages_by_dev_repo dev_repo t] returns all packages with the given dev-repo. *)
45
+
46
+
val related_packages : OpamPackage.Name.t -> t -> package_info list
47
+
(** [related_packages name t] returns all packages that share a dev-repo with
48
+
any version of package [name]. *)
49
+
50
+
val package_names : t -> OpamPackage.Name.t list
51
+
(** [package_names t] returns all unique package names. *)
52
+
53
+
(** {1 Statistics} *)
54
+
55
+
val package_count : t -> int
56
+
(** [package_count t] returns the total number of package versions. *)
57
+
58
+
val repo_count : t -> int
59
+
(** [repo_count t] returns the number of source repositories loaded. *)
+431
lib/solver.ml
+431
lib/solver.ml
···
···
1
+
open Cmdliner
2
+
3
+
type version_constraint = OpamFormula.relop * OpamPackage.Version.t
4
+
5
+
type package_spec = {
6
+
name : OpamPackage.Name.t;
7
+
constraint_ : version_constraint option;
8
+
}
9
+
10
+
(* Target platform configuration *)
11
+
type platform = {
12
+
os : string;
13
+
os_family : string;
14
+
os_distribution : string;
15
+
arch : string;
16
+
}
17
+
18
+
let debian_x86_64 = {
19
+
os = "linux";
20
+
os_family = "debian";
21
+
os_distribution = "debian";
22
+
arch = "x86_64";
23
+
}
24
+
25
+
(* Create a filter environment for the target platform *)
26
+
let make_filter_env platform : OpamFilter.env =
27
+
fun var ->
28
+
let open OpamVariable in
29
+
let s = to_string (Full.variable var) in
30
+
match s with
31
+
| "os" -> Some (S platform.os)
32
+
| "os-family" -> Some (S platform.os_family)
33
+
| "os-distribution" -> Some (S platform.os_distribution)
34
+
| "arch" -> Some (S platform.arch)
35
+
| "opam-version" -> Some (S "2.1.0")
36
+
| "make" -> Some (S "make")
37
+
| "jobs" -> Some (S "4")
38
+
| "pinned" -> Some (B false)
39
+
| "build" -> Some (B true)
40
+
| "post" -> Some (B false)
41
+
| "dev" -> Some (B false)
42
+
| "with-test" -> Some (B false)
43
+
| "with-doc" -> Some (B false)
44
+
| "with-dev-setup" -> Some (B false)
45
+
| _ -> None
46
+
47
+
(* Check if a package is available on the target platform *)
48
+
let is_available_on_platform env (opam : OpamFile.OPAM.t) : bool =
49
+
let available = OpamFile.OPAM.available opam in
50
+
OpamFilter.opt_eval_to_bool env (Some available)
51
+
52
+
(* Check if a package has the compiler flag or is a compiler-related package *)
53
+
let is_compiler_package (opam : OpamFile.OPAM.t) (name : OpamPackage.Name.t) : bool =
54
+
let name_s = OpamPackage.Name.to_string name in
55
+
(* Check for flags:compiler *)
56
+
let has_compiler_flag =
57
+
List.mem OpamTypes.Pkgflag_Compiler (OpamFile.OPAM.flags opam)
58
+
in
59
+
(* Also filter out known compiler-related packages by name pattern *)
60
+
let is_compiler_name =
61
+
name_s = "ocaml" ||
62
+
String.starts_with ~prefix:"ocaml-base-compiler" name_s ||
63
+
String.starts_with ~prefix:"ocaml-variants" name_s ||
64
+
String.starts_with ~prefix:"ocaml-system" name_s ||
65
+
String.starts_with ~prefix:"ocaml-option-" name_s ||
66
+
String.starts_with ~prefix:"ocaml-config" name_s ||
67
+
String.starts_with ~prefix:"ocaml-compiler" name_s ||
68
+
String.starts_with ~prefix:"base-" name_s || (* base-threads, base-unix, etc. *)
69
+
String.starts_with ~prefix:"dkml-base-compiler" name_s ||
70
+
String.starts_with ~prefix:"dkml-runtime" name_s
71
+
in
72
+
has_compiler_flag || is_compiler_name
73
+
74
+
(* Filter dependencies to remove platform-filtered ones.
75
+
Uses OpamFilter.filter_formula which evaluates filters and simplifies. *)
76
+
let filter_depends env (formula : OpamTypes.filtered_formula) : OpamTypes.formula =
77
+
OpamFilter.filter_formula ~default:false env formula
78
+
79
+
(* Parse version constraint from string like ">=1.0.0" *)
80
+
let parse_constraint s =
81
+
let s = String.trim s in
82
+
if String.length s = 0 then None
83
+
else
84
+
let try_parse prefix relop =
85
+
if String.starts_with ~prefix s then
86
+
let v = String.sub s (String.length prefix) (String.length s - String.length prefix) in
87
+
Some (relop, OpamPackage.Version.of_string v)
88
+
else None
89
+
in
90
+
match try_parse ">=" `Geq with
91
+
| Some c -> Some c
92
+
| None -> (
93
+
match try_parse "<=" `Leq with
94
+
| Some c -> Some c
95
+
| None -> (
96
+
match try_parse ">" `Gt with
97
+
| Some c -> Some c
98
+
| None -> (
99
+
match try_parse "<" `Lt with
100
+
| Some c -> Some c
101
+
| None -> (
102
+
match try_parse "!=" `Neq with
103
+
| Some c -> Some c
104
+
| None -> (
105
+
match try_parse "=" `Eq with
106
+
| Some c -> Some c
107
+
| None ->
108
+
(* Treat bare version as exact match *)
109
+
Some (`Eq, OpamPackage.Version.of_string s))))))
110
+
111
+
let parse_package_spec s =
112
+
try
113
+
let s = String.trim s in
114
+
(* Check for constraint operators *)
115
+
let has_constraint =
116
+
String.contains s '>' || String.contains s '<'
117
+
|| String.contains s '=' || String.contains s '!'
118
+
in
119
+
if has_constraint then
120
+
(* Find where constraint starts *)
121
+
let constraint_start =
122
+
let find_op c = try Some (String.index s c) with Not_found -> None in
123
+
[ find_op '>'; find_op '<'; find_op '='; find_op '!' ]
124
+
|> List.filter_map Fun.id
125
+
|> List.fold_left min (String.length s)
126
+
in
127
+
let name_part = String.sub s 0 constraint_start in
128
+
let constraint_part =
129
+
String.sub s constraint_start (String.length s - constraint_start)
130
+
in
131
+
let name = OpamPackage.Name.of_string name_part in
132
+
let constraint_ = parse_constraint constraint_part in
133
+
Ok { name; constraint_ }
134
+
else
135
+
(* Check for pkg.version format *)
136
+
match String.rindex_opt s '.' with
137
+
| Some i when i > 0 ->
138
+
let name_part = String.sub s 0 i in
139
+
let version_part = String.sub s (i + 1) (String.length s - i - 1) in
140
+
(* Validate that version_part looks like a version *)
141
+
if String.length version_part > 0
142
+
&& (version_part.[0] >= '0' && version_part.[0] <= '9' || version_part.[0] = 'v')
143
+
then
144
+
let name = OpamPackage.Name.of_string name_part in
145
+
let version = OpamPackage.Version.of_string version_part in
146
+
Ok { name; constraint_ = Some (`Eq, version) }
147
+
else
148
+
(* Treat as package name without constraint *)
149
+
let name = OpamPackage.Name.of_string s in
150
+
Ok { name; constraint_ = None }
151
+
| _ ->
152
+
let name = OpamPackage.Name.of_string s in
153
+
Ok { name; constraint_ = None }
154
+
with e -> Error (Printexc.to_string e)
155
+
156
+
let package_spec_to_string spec =
157
+
let name = OpamPackage.Name.to_string spec.name in
158
+
match spec.constraint_ with
159
+
| None -> name
160
+
| Some (op, v) ->
161
+
let op_s =
162
+
match op with
163
+
| `Eq -> "="
164
+
| `Neq -> "!="
165
+
| `Geq -> ">="
166
+
| `Gt -> ">"
167
+
| `Leq -> "<="
168
+
| `Lt -> "<"
169
+
in
170
+
name ^ op_s ^ OpamPackage.Version.to_string v
171
+
172
+
(* Parse compiler spec string like "ocaml.5.4.0" or "5.4.0" *)
173
+
let parse_compiler_spec (s : string) : package_spec option =
174
+
let s = String.trim s in
175
+
if s = "" then None
176
+
else
177
+
(* Handle formats: "ocaml.5.4.0", "5.4.0", "ocaml>=5.0" *)
178
+
let spec_str =
179
+
if String.starts_with ~prefix:"ocaml" s then s
180
+
else if s.[0] >= '0' && s.[0] <= '9' then "ocaml." ^ s
181
+
else s
182
+
in
183
+
match parse_package_spec spec_str with
184
+
| Ok spec -> Some spec
185
+
| Error _ -> None
186
+
187
+
(* Selection results *)
188
+
type selection_result = { packages : Repo_index.package_info list }
189
+
190
+
(* Get latest version of each package that is available on the platform *)
191
+
let latest_versions ?(platform=debian_x86_64) (index : Repo_index.t) : Repo_index.package_info list =
192
+
let env = make_filter_env platform in
193
+
let names = Repo_index.package_names index in
194
+
List.filter_map
195
+
(fun name ->
196
+
let versions = Repo_index.find_package name index in
197
+
(* Filter by availability and sort by version descending *)
198
+
let available_versions =
199
+
List.filter (fun (info : Repo_index.package_info) ->
200
+
is_available_on_platform env info.opam) versions
201
+
in
202
+
match
203
+
List.sort
204
+
(fun (a : Repo_index.package_info) b ->
205
+
OpamPackage.Version.compare b.version a.version)
206
+
available_versions
207
+
with
208
+
| latest :: _ -> Some latest
209
+
| [] -> None)
210
+
names
211
+
212
+
let select_all index = { packages = latest_versions index }
213
+
214
+
(* Check if a package version satisfies a constraint *)
215
+
let satisfies_constraint version = function
216
+
| None -> true
217
+
| Some (op, cv) -> (
218
+
let cmp = OpamPackage.Version.compare version cv in
219
+
match op with
220
+
| `Eq -> cmp = 0
221
+
| `Neq -> cmp <> 0
222
+
| `Geq -> cmp >= 0
223
+
| `Gt -> cmp > 0
224
+
| `Leq -> cmp <= 0
225
+
| `Lt -> cmp < 0)
226
+
227
+
let select_packages ?(platform=debian_x86_64) index specs =
228
+
if specs = [] then Ok (select_all index)
229
+
else
230
+
let env = make_filter_env platform in
231
+
let selected =
232
+
List.filter_map
233
+
(fun spec ->
234
+
let versions = Repo_index.find_package spec.name index in
235
+
(* Filter by constraint, availability, and get latest matching *)
236
+
let matching =
237
+
List.filter
238
+
(fun (info : Repo_index.package_info) ->
239
+
satisfies_constraint info.version spec.constraint_
240
+
&& is_available_on_platform env info.opam)
241
+
versions
242
+
in
243
+
match
244
+
List.sort
245
+
(fun (a : Repo_index.package_info) b ->
246
+
OpamPackage.Version.compare b.version a.version)
247
+
matching
248
+
with
249
+
| latest :: _ -> Some latest
250
+
| [] -> None)
251
+
specs
252
+
in
253
+
Ok { packages = selected }
254
+
255
+
(* Build a version map for CUDF conversion *)
256
+
let build_version_map (packages : Repo_index.package_info list) : int OpamPackage.Map.t =
257
+
(* Group by name and sort versions *)
258
+
let by_name = Hashtbl.create 256 in
259
+
List.iter (fun (info : Repo_index.package_info) ->
260
+
let name = info.name in
261
+
let versions = try Hashtbl.find by_name name with Not_found -> [] in
262
+
Hashtbl.replace by_name name (info.version :: versions))
263
+
packages;
264
+
(* Assign version numbers *)
265
+
let version_map = ref OpamPackage.Map.empty in
266
+
Hashtbl.iter (fun name versions ->
267
+
let sorted = List.sort OpamPackage.Version.compare versions in
268
+
List.iteri (fun i v ->
269
+
let nv = OpamPackage.create name v in
270
+
version_map := OpamPackage.Map.add nv (i + 1) !version_map)
271
+
sorted)
272
+
by_name;
273
+
!version_map
274
+
275
+
(* Convert opam formula to CUDF vpkgformula (list of disjunctions for AND semantics)
276
+
Simplified: we ignore version constraints and just require the package exists.
277
+
This allows the 0install solver to pick the best version. *)
278
+
let formula_to_vpkgformula available_names (formula : OpamTypes.formula) : Cudf_types.vpkgformula =
279
+
let atoms = OpamFormula.atoms formula in
280
+
List.filter_map (fun (name, _version_constraint) ->
281
+
let name_s = OpamPackage.Name.to_string name in
282
+
(* Only include dependency if package exists in our available set *)
283
+
if not (Hashtbl.mem available_names name_s) then None
284
+
else Some [(name_s, None)]) (* No version constraint - solver picks best *)
285
+
atoms
286
+
287
+
(* For conflicts, we ignore them in CUDF since proper conflict handling requires
288
+
complex version mapping. The 0install solver will still produce valid results
289
+
since we filter packages by platform availability. *)
290
+
let formula_to_vpkglist (_formula : OpamTypes.formula) : Cudf_types.vpkglist =
291
+
[] (* Ignore conflicts for simplicity *)
292
+
293
+
(* Build CUDF universe from packages *)
294
+
let build_cudf_universe ?(platform=debian_x86_64) (packages : Repo_index.package_info list) =
295
+
let env = make_filter_env platform in
296
+
let version_map = build_version_map packages in
297
+
298
+
(* First, collect all available package names *)
299
+
let available_names = Hashtbl.create 256 in
300
+
List.iter (fun (info : Repo_index.package_info) ->
301
+
Hashtbl.replace available_names (OpamPackage.Name.to_string info.name) ())
302
+
packages;
303
+
304
+
let cudf_packages = List.filter_map (fun (info : Repo_index.package_info) ->
305
+
let nv = OpamPackage.create info.name info.version in
306
+
match OpamPackage.Map.find_opt nv version_map with
307
+
| None -> None
308
+
| Some cudf_version ->
309
+
(* Get and filter dependencies *)
310
+
let depends_formula = OpamFile.OPAM.depends info.opam in
311
+
let filtered_depends = filter_depends env depends_formula in
312
+
let depends = formula_to_vpkgformula available_names filtered_depends in
313
+
314
+
(* Get conflicts - simplified to empty for now *)
315
+
let conflicts_formula = OpamFile.OPAM.conflicts info.opam in
316
+
let filtered_conflicts = filter_depends env conflicts_formula in
317
+
let conflicts = formula_to_vpkglist filtered_conflicts in
318
+
319
+
Some {
320
+
Cudf.default_package with
321
+
package = OpamPackage.Name.to_string info.name;
322
+
version = cudf_version;
323
+
depends = depends;
324
+
conflicts = conflicts;
325
+
installed = false;
326
+
pkg_extra = [
327
+
(OpamCudf.s_source, `String (OpamPackage.Name.to_string info.name));
328
+
(OpamCudf.s_source_number, `String (OpamPackage.Version.to_string info.version));
329
+
];
330
+
})
331
+
packages
332
+
in
333
+
334
+
let universe = Cudf.load_universe cudf_packages in
335
+
(universe, version_map)
336
+
337
+
(* Resolve dependencies using 0install solver *)
338
+
let resolve_deps ?(platform=debian_x86_64) ?compiler index (root_specs : package_spec list) =
339
+
let env = make_filter_env platform in
340
+
341
+
(* Get all available packages *)
342
+
let all_packages =
343
+
List.filter (fun (info : Repo_index.package_info) ->
344
+
is_available_on_platform env info.opam)
345
+
(Repo_index.all_packages index)
346
+
in
347
+
348
+
(* Build CUDF universe *)
349
+
let universe, version_map = build_cudf_universe ~platform all_packages in
350
+
351
+
(* Build request - add compiler if specified *)
352
+
let all_specs = match compiler with
353
+
| Some compiler_spec -> compiler_spec :: root_specs
354
+
| None -> root_specs
355
+
in
356
+
357
+
let requested = List.filter_map (fun spec ->
358
+
let name_s = OpamPackage.Name.to_string spec.name in
359
+
(* Check if package exists in universe *)
360
+
if Cudf.mem_package universe (name_s, 1) ||
361
+
List.exists (fun p -> p.Cudf.package = name_s) (Cudf.get_packages universe)
362
+
then Some (name_s, `Essential)
363
+
else begin
364
+
Format.eprintf "Warning: Package %s not found in universe@." name_s;
365
+
None
366
+
end)
367
+
all_specs
368
+
in
369
+
370
+
if requested = [] then
371
+
Error "No valid packages to resolve"
372
+
else
373
+
(* Create solver and solve *)
374
+
let solver = Opam_0install_cudf.create ~constraints:[] universe in
375
+
match Opam_0install_cudf.solve solver requested with
376
+
| Error diag ->
377
+
Error (Opam_0install_cudf.diagnostics diag)
378
+
| Ok selections ->
379
+
(* Convert results back to package info *)
380
+
let selected_cudf = Opam_0install_cudf.packages_of_result selections in
381
+
let selected_packages = List.filter_map (fun (name, cudf_version) ->
382
+
(* Find the opam package *)
383
+
let opam_name = OpamPackage.Name.of_string name in
384
+
let versions = Repo_index.find_package opam_name index in
385
+
(* Get the version that matches *)
386
+
List.find_opt (fun (info : Repo_index.package_info) ->
387
+
let nv = OpamPackage.create info.name info.version in
388
+
match OpamPackage.Map.find_opt nv version_map with
389
+
| Some v -> v = cudf_version
390
+
| None -> false)
391
+
versions)
392
+
selected_cudf
393
+
in
394
+
(* Deduplicate by package name+version *)
395
+
let seen = Hashtbl.create 64 in
396
+
let unique_packages = List.filter (fun (info : Repo_index.package_info) ->
397
+
let key = OpamPackage.to_string (OpamPackage.create info.name info.version) in
398
+
if Hashtbl.mem seen key then false
399
+
else begin Hashtbl.add seen key (); true end)
400
+
selected_packages
401
+
in
402
+
(* Filter out compiler packages from results *)
403
+
let non_compiler_packages = List.filter (fun (info : Repo_index.package_info) ->
404
+
not (is_compiler_package info.opam info.name))
405
+
unique_packages
406
+
in
407
+
Ok { packages = non_compiler_packages }
408
+
409
+
let select_with_deps ?(platform=debian_x86_64) ?compiler index specs =
410
+
if specs = [] then Ok (select_all index)
411
+
else
412
+
resolve_deps ~platform ?compiler index specs
413
+
414
+
(* Cmdliner integration *)
415
+
416
+
let package_specs_conv : package_spec Arg.conv =
417
+
let parse s =
418
+
match parse_package_spec s with
419
+
| Ok spec -> Ok spec
420
+
| Error msg -> Error (`Msg msg)
421
+
in
422
+
let print fmt spec = Format.pp_print_string fmt (package_spec_to_string spec) in
423
+
Arg.conv (parse, print)
424
+
425
+
let package_specs_term : package_spec list Term.t =
426
+
let doc =
427
+
"Package specification. Can be a package name (any version), \
428
+
name.version (exact version), or name>=version (constraint). \
429
+
Examples: cmdliner, lwt.5.6.0, dune>=3.0"
430
+
in
431
+
Arg.(value & pos_all package_specs_conv [] & info [] ~docv:"PACKAGE" ~doc)
+88
lib/solver.mli
+88
lib/solver.mli
···
···
1
+
(** Package selection with constraint solving.
2
+
3
+
Uses the 0install solver (via opam-0install-cudf) to select
4
+
a consistent set of packages based on constraints, filtered
5
+
for Debian x86_64 platform. *)
6
+
7
+
(** {1 Platform Configuration} *)
8
+
9
+
type platform = {
10
+
os : string;
11
+
os_family : string;
12
+
os_distribution : string;
13
+
arch : string;
14
+
}
15
+
(** Target platform for filtering packages. *)
16
+
17
+
val debian_x86_64 : platform
18
+
(** Default platform: Debian Linux on x86_64. *)
19
+
20
+
(** {1 Package Specifications} *)
21
+
22
+
type version_constraint = OpamFormula.relop * OpamPackage.Version.t
23
+
(** A version constraint like [>=, 1.0.0]. *)
24
+
25
+
type package_spec = {
26
+
name : OpamPackage.Name.t;
27
+
constraint_ : version_constraint option;
28
+
}
29
+
(** A package specification with optional version constraint. *)
30
+
31
+
val parse_package_spec : string -> (package_spec, string) result
32
+
(** [parse_package_spec s] parses a package spec string like:
33
+
- "pkg" (any version)
34
+
- "pkg.1.0.0" (exact version)
35
+
- "pkg>=1.0.0" (version constraint)
36
+
- "pkg<2.0" (version constraint) *)
37
+
38
+
val package_spec_to_string : package_spec -> string
39
+
(** [package_spec_to_string spec] converts a spec back to string form. *)
40
+
41
+
val parse_compiler_spec : string -> package_spec option
42
+
(** [parse_compiler_spec s] parses a compiler version string like:
43
+
- "5.4.0" (parsed as ocaml.5.4.0)
44
+
- "ocaml.5.4.0" (exact version)
45
+
- "ocaml>=5.0" (version constraint)
46
+
Returns None if the string is empty or invalid. *)
47
+
48
+
(** {1 Selection} *)
49
+
50
+
type selection_result = {
51
+
packages : Repo_index.package_info list;
52
+
(** Selected packages that satisfy all constraints. *)
53
+
}
54
+
(** Result of package selection. *)
55
+
56
+
val select_all : Repo_index.t -> selection_result
57
+
(** [select_all index] returns all packages (latest version of each)
58
+
that are available on the target platform (Debian x86_64). *)
59
+
60
+
val select_packages :
61
+
?platform:platform ->
62
+
Repo_index.t -> package_spec list -> (selection_result, string) result
63
+
(** [select_packages index specs] finds packages matching the given
64
+
specifications, filtered by platform availability. Returns the
65
+
latest compatible version of each package. *)
66
+
67
+
val select_with_deps :
68
+
?platform:platform ->
69
+
?compiler:package_spec ->
70
+
Repo_index.t -> package_spec list -> (selection_result, string) result
71
+
(** [select_with_deps ?platform ?compiler index specs] selects packages and
72
+
their transitive dependencies using the 0install solver.
73
+
74
+
- Dependencies are filtered by platform (Debian x86_64 by default)
75
+
- If [compiler] is specified, it is added as a constraint and all
76
+
compiler-related packages (those with flags:compiler or matching
77
+
known compiler package patterns) are filtered from the results
78
+
- The solver finds a consistent installation set *)
79
+
80
+
(** {1 Cmdliner Integration} *)
81
+
82
+
val package_specs_term : package_spec list Cmdliner.Term.t
83
+
(** Cmdliner term for parsing package specifications from command line.
84
+
Accepts zero or more package specs as positional arguments.
85
+
If no packages specified, returns empty list (meaning "all packages"). *)
86
+
87
+
val package_specs_conv : package_spec Cmdliner.Arg.conv
88
+
(** Cmdliner converter for a single package spec. *)
+237
lib/source.ml
+237
lib/source.ml
···
···
1
+
type source_kind = Archive | Git
2
+
3
+
type archive_source = {
4
+
url : string;
5
+
checksums : string list;
6
+
mirrors : string list;
7
+
}
8
+
9
+
type git_source = {
10
+
url : string;
11
+
branch : string option;
12
+
}
13
+
14
+
type source = ArchiveSource of archive_source | GitSource of git_source | NoSource
15
+
16
+
type package_source = {
17
+
name : string;
18
+
version : string;
19
+
source : source;
20
+
dev_repo : Dev_repo.t option;
21
+
}
22
+
23
+
type grouped_sources = {
24
+
dev_repo : Dev_repo.t option;
25
+
packages : package_source list;
26
+
}
27
+
28
+
(* Helper to check if URL is git-like *)
29
+
let is_git_url url =
30
+
let s = OpamUrl.to_string url in
31
+
String.starts_with ~prefix:"git" s
32
+
|| String.ends_with ~suffix:".git" s
33
+
|| url.OpamUrl.backend = `git
34
+
35
+
(* Extract archive source from opam URL.t *)
36
+
let extract_archive_from_url (url_t : OpamFile.URL.t) : archive_source =
37
+
let main_url = OpamFile.URL.url url_t in
38
+
let checksums =
39
+
OpamFile.URL.checksum url_t
40
+
|> List.map OpamHash.to_string
41
+
in
42
+
let mirrors =
43
+
OpamFile.URL.mirrors url_t
44
+
|> List.map OpamUrl.to_string
45
+
in
46
+
{ url = OpamUrl.to_string main_url; checksums; mirrors }
47
+
48
+
(* Extract git source from OpamUrl.t *)
49
+
let normalize_git_url s =
50
+
(* Strip git+ prefix so URLs work directly with git clone *)
51
+
if String.starts_with ~prefix:"git+" s then
52
+
String.sub s 4 (String.length s - 4)
53
+
else s
54
+
55
+
let extract_git_from_url (url : OpamUrl.t) : git_source =
56
+
{ url = normalize_git_url (OpamUrl.to_string url); branch = url.OpamUrl.hash }
57
+
58
+
let extract kind (info : Repo_index.package_info) : package_source =
59
+
let name = OpamPackage.Name.to_string info.name in
60
+
let version = OpamPackage.Version.to_string info.version in
61
+
let dev_repo = info.dev_repo in
62
+
let source =
63
+
match kind with
64
+
| Archive -> (
65
+
match OpamFile.OPAM.url info.opam with
66
+
| Some url_t -> ArchiveSource (extract_archive_from_url url_t)
67
+
| None -> NoSource)
68
+
| Git -> (
69
+
(* Prefer dev-repo for git, fall back to url if it's a git URL *)
70
+
match OpamFile.OPAM.dev_repo info.opam with
71
+
| Some url -> GitSource (extract_git_from_url url)
72
+
| None -> (
73
+
match OpamFile.OPAM.url info.opam with
74
+
| Some url_t ->
75
+
let main_url = OpamFile.URL.url url_t in
76
+
if is_git_url main_url then
77
+
GitSource (extract_git_from_url main_url)
78
+
else NoSource
79
+
| None -> NoSource))
80
+
in
81
+
{ name; version; source; dev_repo }
82
+
83
+
let extract_all kind packages = List.map (extract kind) packages
84
+
85
+
let group_by_dev_repo (sources : package_source list) : grouped_sources list =
86
+
(* Build separate lists: one map for packages with dev_repo, one list for those without *)
87
+
let with_repo, without_repo =
88
+
List.partition (fun (src : package_source) -> Option.is_some src.dev_repo) sources
89
+
in
90
+
(* Group packages with dev_repo *)
91
+
let add_to_map map (src : package_source) =
92
+
match src.dev_repo with
93
+
| Some dr ->
94
+
let existing =
95
+
match Dev_repo.Map.find_opt dr map with
96
+
| Some l -> l
97
+
| None -> []
98
+
in
99
+
Dev_repo.Map.add dr (src :: existing) map
100
+
| None -> map
101
+
in
102
+
let map = List.fold_left add_to_map Dev_repo.Map.empty with_repo in
103
+
(* Convert map to list of grouped_sources *)
104
+
let grouped_with_repo =
105
+
Dev_repo.Map.fold
106
+
(fun dr pkgs acc ->
107
+
let packages = List.rev pkgs in (* Preserve original order *)
108
+
{ dev_repo = Some dr; packages } :: acc)
109
+
map []
110
+
|> List.sort (fun a b ->
111
+
match (a.dev_repo, b.dev_repo) with
112
+
| Some a, Some b -> Dev_repo.compare a b
113
+
| _ -> 0)
114
+
in
115
+
(* Add packages without dev_repo at the end *)
116
+
if without_repo = [] then grouped_with_repo
117
+
else grouped_with_repo @ [{ dev_repo = None; packages = without_repo }]
118
+
119
+
(* JSON Codecs - simplified with tagged object *)
120
+
121
+
let source_jsont : source Jsont.t =
122
+
let open Jsont in
123
+
Object.map ~kind:"source"
124
+
(fun source_type url checksums mirrors branch ->
125
+
match source_type with
126
+
| "archive" ->
127
+
let checksums = match checksums with Some cs -> cs | None -> [] in
128
+
ArchiveSource { url; checksums; mirrors }
129
+
| "git" -> GitSource { url; branch }
130
+
| _ -> NoSource)
131
+
|> Object.mem "type" string ~enc:(function
132
+
| ArchiveSource _ -> "archive"
133
+
| GitSource _ -> "git"
134
+
| NoSource -> "none")
135
+
|> Object.mem "url" string ~dec_absent:"" ~enc:(function
136
+
| ArchiveSource a -> a.url
137
+
| GitSource g -> g.url
138
+
| NoSource -> "")
139
+
|> Object.opt_mem "checksums" (list string) ~enc:(function
140
+
| ArchiveSource a -> Some a.checksums
141
+
| _ -> None)
142
+
|> Object.mem "mirrors" (list string) ~dec_absent:[] ~enc:(function
143
+
| ArchiveSource a -> a.mirrors
144
+
| _ -> [])
145
+
|> Object.opt_mem "branch" string ~enc:(function
146
+
| GitSource g -> g.branch
147
+
| _ -> None)
148
+
|> Object.finish
149
+
150
+
let dev_repo_jsont =
151
+
Jsont.(
152
+
map
153
+
~dec:(fun s -> Dev_repo.of_string s)
154
+
~enc:Dev_repo.to_string string)
155
+
156
+
let package_source_jsont : package_source Jsont.t =
157
+
let open Jsont in
158
+
Object.map ~kind:"package_source"
159
+
(fun name version source dev_repo ->
160
+
({ name; version; source; dev_repo } : package_source))
161
+
|> Object.mem "name" string ~enc:(fun (p : package_source) -> p.name)
162
+
|> Object.mem "version" string ~enc:(fun (p : package_source) -> p.version)
163
+
|> Object.mem "source" source_jsont ~enc:(fun (p : package_source) -> p.source)
164
+
|> Object.opt_mem "dev_repo" dev_repo_jsont ~enc:(fun (p : package_source) -> p.dev_repo)
165
+
|> Object.finish
166
+
167
+
let package_sources_jsont = Jsont.list package_source_jsont
168
+
169
+
let grouped_sources_jsont : grouped_sources Jsont.t =
170
+
let open Jsont in
171
+
Object.map ~kind:"grouped_sources"
172
+
(fun dev_repo packages -> ({ dev_repo; packages } : grouped_sources))
173
+
|> Object.opt_mem "dev_repo" dev_repo_jsont ~enc:(fun (g : grouped_sources) -> g.dev_repo)
174
+
|> Object.mem "packages" (list package_source_jsont) ~enc:(fun (g : grouped_sources) -> g.packages)
175
+
|> Object.finish
176
+
177
+
let grouped_sources_list_jsont = Jsont.list grouped_sources_jsont
178
+
179
+
(* TOML Codecs *)
180
+
181
+
let source_tomlt : source Tomlt.t =
182
+
let open Tomlt in
183
+
let open Table in
184
+
obj (fun source_type url checksums mirrors branch ->
185
+
match source_type with
186
+
| "archive" ->
187
+
let checksums = match checksums with Some cs -> cs | None -> [] in
188
+
ArchiveSource { url; checksums; mirrors }
189
+
| "git" -> GitSource { url; branch }
190
+
| "none" | _ -> NoSource)
191
+
|> mem "type" string ~enc:(function
192
+
| ArchiveSource _ -> "archive"
193
+
| GitSource _ -> "git"
194
+
| NoSource -> "none")
195
+
|> mem "url" string ~dec_absent:"" ~enc:(function
196
+
| ArchiveSource a -> a.url
197
+
| GitSource g -> g.url
198
+
| NoSource -> "")
199
+
|> opt_mem "checksums" (list string) ~enc:(function
200
+
| ArchiveSource a -> Some a.checksums
201
+
| _ -> None)
202
+
|> mem "mirrors" (list string) ~dec_absent:[] ~enc:(function
203
+
| ArchiveSource a -> a.mirrors
204
+
| _ -> [])
205
+
|> opt_mem "branch" string ~enc:(function
206
+
| GitSource g -> g.branch
207
+
| _ -> None)
208
+
|> finish
209
+
210
+
let dev_repo_tomlt =
211
+
Tomlt.(
212
+
map
213
+
~dec:(fun s -> Dev_repo.of_string s)
214
+
~enc:Dev_repo.to_string string)
215
+
216
+
let package_source_tomlt : package_source Tomlt.t =
217
+
let open Tomlt in
218
+
let open Table in
219
+
obj (fun name version source dev_repo ->
220
+
({ name; version; source; dev_repo } : package_source))
221
+
|> mem "name" string ~enc:(fun (p : package_source) -> p.name)
222
+
|> mem "version" string ~enc:(fun (p : package_source) -> p.version)
223
+
|> mem "source" source_tomlt ~enc:(fun (p : package_source) -> p.source)
224
+
|> opt_mem "dev_repo" dev_repo_tomlt ~enc:(fun (p : package_source) -> p.dev_repo)
225
+
|> finish
226
+
227
+
let package_sources_tomlt = Tomlt.array_of_tables package_source_tomlt
228
+
229
+
let grouped_sources_tomlt : grouped_sources Tomlt.t =
230
+
let open Tomlt in
231
+
let open Table in
232
+
obj (fun dev_repo packages -> ({ dev_repo; packages } : grouped_sources))
233
+
|> opt_mem "dev_repo" dev_repo_tomlt ~enc:(fun (g : grouped_sources) -> g.dev_repo)
234
+
|> mem "packages" (array_of_tables package_source_tomlt) ~enc:(fun (g : grouped_sources) -> g.packages)
235
+
|> finish
236
+
237
+
let grouped_sources_list_tomlt = Tomlt.array_of_tables grouped_sources_tomlt
+85
lib/source.mli
+85
lib/source.mli
···
···
1
+
(** Package source URL extraction.
2
+
3
+
Extracts download URLs or git remotes from opam package metadata. *)
4
+
5
+
(** {1 Source Types} *)
6
+
7
+
type source_kind =
8
+
| Archive (** Tarball/archive URL with optional checksums *)
9
+
| Git (** Git repository URL *)
10
+
(** The kind of source to extract. *)
11
+
12
+
type archive_source = {
13
+
url : string;
14
+
checksums : string list; (** SHA256, MD5, etc. *)
15
+
mirrors : string list;
16
+
}
17
+
(** An archive source with URL and integrity info. *)
18
+
19
+
type git_source = {
20
+
url : string;
21
+
branch : string option; (** Branch/tag/ref if specified *)
22
+
}
23
+
(** A git repository source. *)
24
+
25
+
type source =
26
+
| ArchiveSource of archive_source
27
+
| GitSource of git_source
28
+
| NoSource
29
+
(** A package source. *)
30
+
31
+
type package_source = {
32
+
name : string;
33
+
version : string;
34
+
source : source;
35
+
dev_repo : Dev_repo.t option;
36
+
}
37
+
(** A package with its source and dev-repo for grouping. *)
38
+
39
+
type grouped_sources = {
40
+
dev_repo : Dev_repo.t option;
41
+
packages : package_source list;
42
+
}
43
+
(** Packages grouped by their shared dev-repo. *)
44
+
45
+
(** {1 Extraction} *)
46
+
47
+
val extract : source_kind -> Repo_index.package_info -> package_source
48
+
(** [extract kind info] extracts the source of the specified kind from
49
+
package [info]. For [Archive], uses the url field. For [Git], uses
50
+
dev-repo or falls back to url if it's a git URL. *)
51
+
52
+
val extract_all : source_kind -> Repo_index.package_info list -> package_source list
53
+
(** [extract_all kind packages] extracts sources for all packages. *)
54
+
55
+
val group_by_dev_repo : package_source list -> grouped_sources list
56
+
(** [group_by_dev_repo sources] groups packages by their dev-repo.
57
+
Packages with the same dev-repo are grouped together since they
58
+
come from the same repository. Groups with dev-repo are sorted first,
59
+
followed by packages without dev-repo. *)
60
+
61
+
(** {1 Codecs} *)
62
+
63
+
val package_source_jsont : package_source Jsont.t
64
+
(** JSON codec for a package source. *)
65
+
66
+
val package_sources_jsont : package_source list Jsont.t
67
+
(** JSON codec for a list of package sources. *)
68
+
69
+
val grouped_sources_jsont : grouped_sources Jsont.t
70
+
(** JSON codec for grouped sources. *)
71
+
72
+
val grouped_sources_list_jsont : grouped_sources list Jsont.t
73
+
(** JSON codec for a list of grouped sources. *)
74
+
75
+
val package_source_tomlt : package_source Tomlt.t
76
+
(** TOML codec for a package source. *)
77
+
78
+
val package_sources_tomlt : package_source list Tomlt.t
79
+
(** TOML codec for a list of package sources (as array of tables). *)
80
+
81
+
val grouped_sources_tomlt : grouped_sources Tomlt.t
82
+
(** TOML codec for grouped sources. *)
83
+
84
+
val grouped_sources_list_tomlt : grouped_sources list Tomlt.t
85
+
(** TOML codec for a list of grouped sources (as array of tables). *)
+15
lib/unpac.ml
+15
lib/unpac.ml
···
···
1
+
(** Unpac - Monorepo management library. *)
2
+
3
+
module Config = Config
4
+
module Dev_repo = Dev_repo
5
+
module Repo_index = Repo_index
6
+
module Output = Output
7
+
module Source = Source
8
+
module Solver = Solver
9
+
module Cache = Cache
10
+
11
+
(** Vendor operations *)
12
+
module Git = Git
13
+
module Recovery = Recovery
14
+
module Vendor = Vendor
15
+
module Project = Project
+526
lib/vendor.ml
+526
lib/vendor.ml
···
···
1
+
(** Vendor package management operations. *)
2
+
3
+
let src = Logs.Src.create "unpac.vendor" ~doc:"Vendor operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
(* Option helper for compatibility *)
7
+
let option_value ~default = function
8
+
| Some x -> x
9
+
| None -> default
10
+
11
+
(* Types *)
12
+
13
+
type package_status = {
14
+
name : string;
15
+
url : string;
16
+
branch : string;
17
+
upstream_sha : string option;
18
+
vendor_sha : string option;
19
+
patches_sha : string option;
20
+
patch_count : int;
21
+
in_project : bool;
22
+
opam_packages : string list;
23
+
}
24
+
25
+
let pp_package_status fmt s =
26
+
Format.fprintf fmt "@[<v>%s:@, url: %s@, branch: %s@, upstream: %a@, vendor: %a@, patches: %a (%d)@, in_project: %b@, opam_packages: %a@]"
27
+
s.name s.url s.branch
28
+
Fmt.(option string) s.upstream_sha
29
+
Fmt.(option string) s.vendor_sha
30
+
Fmt.(option string) s.patches_sha
31
+
s.patch_count
32
+
s.in_project
33
+
Fmt.(list ~sep:comma string) s.opam_packages
34
+
35
+
type add_result =
36
+
| Success of {
37
+
canonical_name : string;
38
+
opam_packages : string list;
39
+
upstream_sha : string;
40
+
vendor_sha : string;
41
+
}
42
+
| Already_vendored of string
43
+
| Failed of {
44
+
step : string;
45
+
error : exn;
46
+
recovery_hint : string;
47
+
}
48
+
49
+
type update_result =
50
+
| Updated of {
51
+
old_sha : string;
52
+
new_sha : string;
53
+
commit_count : int;
54
+
}
55
+
| No_changes
56
+
| Update_failed of {
57
+
step : string;
58
+
error : exn;
59
+
recovery_hint : string;
60
+
}
61
+
62
+
(* Branch naming conventions *)
63
+
64
+
let remote_name pkg = "origin-" ^ pkg
65
+
let upstream_branch pkg = "upstream/" ^ pkg
66
+
let vendor_branch pkg = "vendor/" ^ pkg
67
+
let patches_branch pkg = "patches/" ^ pkg
68
+
let vendor_path pkg = "vendor/" ^ pkg ^ "/"
69
+
70
+
(* Queries *)
71
+
72
+
let is_vendored ~proc_mgr ~cwd name =
73
+
Git.remote_exists ~proc_mgr ~cwd (remote_name name)
74
+
75
+
let get_vendored_packages ~proc_mgr ~cwd =
76
+
Git.list_remotes ~proc_mgr ~cwd
77
+
|> List.filter_map (fun remote ->
78
+
if String.starts_with ~prefix:"origin-" remote then
79
+
Some (String.sub remote 7 (String.length remote - 7))
80
+
else
81
+
None)
82
+
|> List.sort String.compare
83
+
84
+
let package_status ~proc_mgr ~cwd name =
85
+
if not (is_vendored ~proc_mgr ~cwd name) then None
86
+
else
87
+
let remote = remote_name name in
88
+
let url = Git.remote_url ~proc_mgr ~cwd remote |> option_value ~default:"" in
89
+
let upstream_sha = Git.rev_parse ~proc_mgr ~cwd (upstream_branch name) in
90
+
let vendor_sha = Git.rev_parse ~proc_mgr ~cwd (vendor_branch name) in
91
+
let patches_sha = Git.rev_parse ~proc_mgr ~cwd (patches_branch name) in
92
+
let patch_count =
93
+
match (vendor_sha, patches_sha) with
94
+
| Some v, Some p ->
95
+
begin try Git.rev_list_count ~proc_mgr ~cwd v p
96
+
with _ -> 0
97
+
end
98
+
| _ -> 0
99
+
in
100
+
(* Check if vendor directory exists in current branch *)
101
+
let current = Git.current_branch ~proc_mgr ~cwd in
102
+
let in_project =
103
+
match current with
104
+
| Some branch -> Git.ls_tree ~proc_mgr ~cwd ~tree:branch ~path:(vendor_path name)
105
+
| None -> false
106
+
in
107
+
(* Detect branch from remote tracking *)
108
+
let branch =
109
+
try Git.ls_remote_default_branch ~proc_mgr ~url
110
+
with _ -> "main"
111
+
in
112
+
Some {
113
+
name;
114
+
url;
115
+
branch;
116
+
upstream_sha = Option.map (fun s -> String.sub s 0 (min 7 (String.length s))) upstream_sha;
117
+
vendor_sha = Option.map (fun s -> String.sub s 0 (min 7 (String.length s))) vendor_sha;
118
+
patches_sha = Option.map (fun s -> String.sub s 0 (min 7 (String.length s))) patches_sha;
119
+
patch_count;
120
+
in_project;
121
+
opam_packages = []; (* TODO: load from config *)
122
+
}
123
+
124
+
let all_status ~proc_mgr ~cwd =
125
+
get_vendored_packages ~proc_mgr ~cwd
126
+
|> List.filter_map (fun name -> package_status ~proc_mgr ~cwd name)
127
+
128
+
(* Conflict prompt generation *)
129
+
130
+
let generate_conflict_prompt ~operation ~pkg_name ~files =
131
+
let files_list = String.concat "\n" (List.map (fun f -> "- " ^ f) files) in
132
+
Printf.sprintf {|
133
+
## Git %s Conflict Resolution Needed
134
+
135
+
Package `%s` has conflicts in the following files:
136
+
%s
137
+
138
+
### To resolve manually:
139
+
1. Edit the conflicting files to resolve conflicts (look for <<<<<<< markers)
140
+
2. Stage resolved files: git add <resolved-files>
141
+
3. Continue the operation: unpac vendor continue
142
+
143
+
### To abort:
144
+
Run: unpac vendor abort
145
+
146
+
### Or ask Claude to help:
147
+
```
148
+
Please help me resolve the %s conflicts for the %s package.
149
+
150
+
The conflicting files are:
151
+
%s
152
+
153
+
Show me the resolved versions of each file. The conflicts are between
154
+
the vendor branch (upstream code with path prefix vendor/%s/) and
155
+
my project branch modifications.
156
+
```
157
+
|} operation pkg_name files_list
158
+
operation pkg_name files_list pkg_name
159
+
160
+
(* Get current timestamp in ISO 8601 format *)
161
+
let iso_timestamp () =
162
+
let t = Unix.gettimeofday () in
163
+
let tm = Unix.gmtime t in
164
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
165
+
(tm.Unix.tm_year + 1900)
166
+
(tm.Unix.tm_mon + 1)
167
+
tm.Unix.tm_mday
168
+
tm.Unix.tm_hour
169
+
tm.Unix.tm_min
170
+
tm.Unix.tm_sec
171
+
172
+
(* Execute a single step *)
173
+
let execute_step ~proc_mgr ~cwd step =
174
+
let open Recovery in
175
+
match step with
176
+
| Remote_add { remote; url } ->
177
+
Log.info (fun m -> m "Adding remote %s -> %s" remote url);
178
+
ignore (Git.ensure_remote ~proc_mgr ~cwd ~name:remote ~url)
179
+
180
+
| Fetch { remote } ->
181
+
Log.info (fun m -> m "Fetching from %s..." remote);
182
+
Git.fetch ~proc_mgr ~cwd ~remote
183
+
184
+
| Create_upstream { branch; start_point } ->
185
+
Log.info (fun m -> m "Creating pristine branch: %s" branch);
186
+
ignore (Git.ensure_branch ~proc_mgr ~cwd ~name:branch ~start_point)
187
+
188
+
| Create_vendor { name; upstream } ->
189
+
Log.info (fun m -> m "Creating vendor branch with path rewrite: %s" (vendor_branch name));
190
+
let current = Git.current_branch ~proc_mgr ~cwd in
191
+
let vbranch = vendor_branch name in
192
+
193
+
(* Create orphan branch *)
194
+
Git.checkout_orphan ~proc_mgr ~cwd vbranch;
195
+
196
+
(* Clear everything from index *)
197
+
Git.rm_cached_rf ~proc_mgr ~cwd;
198
+
199
+
(* Read tree with prefix *)
200
+
Git.read_tree_prefix ~proc_mgr ~cwd ~prefix:(vendor_path name) ~tree:upstream;
201
+
202
+
(* Checkout files to working directory *)
203
+
Git.checkout_index ~proc_mgr ~cwd;
204
+
205
+
(* Commit *)
206
+
let short_sha = Git.rev_parse_short ~proc_mgr ~cwd upstream in
207
+
let full_sha = Git.rev_parse_exn ~proc_mgr ~cwd upstream in
208
+
let url = Git.remote_url ~proc_mgr ~cwd (remote_name name) |> option_value ~default:"" in
209
+
let message = Printf.sprintf "vendor/%s: import at %s\n\nUpstream: %s\nCommit: %s"
210
+
name short_sha url full_sha
211
+
in
212
+
Git.commit ~proc_mgr ~cwd ~message;
213
+
214
+
(* Return to original branch *)
215
+
begin match current with
216
+
| Some b -> Git.checkout ~proc_mgr ~cwd b
217
+
| None -> ()
218
+
end
219
+
220
+
| Create_patches { branch; vendor } ->
221
+
Log.info (fun m -> m "Creating patches branch: %s" branch);
222
+
ignore (Git.ensure_branch ~proc_mgr ~cwd ~name:branch ~start_point:vendor)
223
+
224
+
| Merge_to_project { patches } ->
225
+
Log.info (fun m -> m "Merging %s into project branch..." patches);
226
+
let pkg_name =
227
+
if String.starts_with ~prefix:"patches/" patches then
228
+
String.sub patches 8 (String.length patches - 8)
229
+
else patches
230
+
in
231
+
let message = Printf.sprintf "Merge %s\n\nVendor package: %s" patches pkg_name in
232
+
begin match Git.merge_allow_unrelated ~proc_mgr ~cwd ~branch:patches ~message with
233
+
| Ok () -> ()
234
+
| Error (`Conflict files) ->
235
+
let prompt = generate_conflict_prompt ~operation:"merge" ~pkg_name ~files in
236
+
Log.warn (fun m -> m "Merge conflict in %s" patches);
237
+
Log.info (fun m -> m "%s" prompt);
238
+
raise (Git.err (Git.Merge_conflict { branch = patches; conflicting_files = files }))
239
+
end
240
+
241
+
| Update_toml { package_name = _ } ->
242
+
Log.info (fun m -> m "Updating unpac.toml...");
243
+
(* TODO: Actually update the TOML file *)
244
+
()
245
+
246
+
| Commit { message } ->
247
+
if Git.has_uncommitted_changes ~proc_mgr ~cwd then begin
248
+
Git.add_all ~proc_mgr ~cwd;
249
+
Git.commit ~proc_mgr ~cwd ~message
250
+
end
251
+
252
+
(* Build steps for add_package *)
253
+
let build_add_steps ~name ~url ~branch ~opam_packages:_ =
254
+
let remote = remote_name name in
255
+
let upstream = upstream_branch name in
256
+
let vendor = vendor_branch name in
257
+
let patches = patches_branch name in
258
+
let start_point = remote ^ "/" ^ branch in
259
+
Recovery.[
260
+
Remote_add { remote; url };
261
+
Fetch { remote };
262
+
Create_upstream { branch = upstream; start_point };
263
+
Create_vendor { name; upstream };
264
+
Create_patches { branch = patches; vendor };
265
+
Merge_to_project { patches };
266
+
Update_toml { package_name = name };
267
+
Commit { message = Printf.sprintf "vendor: add %s" name };
268
+
]
269
+
270
+
(* Operations *)
271
+
272
+
let add_package ~proc_mgr ~cwd ~name ~url ~branch ~opam_packages =
273
+
(* Check if already vendored *)
274
+
if is_vendored ~proc_mgr ~cwd name then begin
275
+
Log.warn (fun m -> m "Package %s is already vendored" name);
276
+
Already_vendored name
277
+
end else begin
278
+
(* Get current state for recovery *)
279
+
let original_branch = Git.current_branch_exn ~proc_mgr ~cwd in
280
+
let original_head = Git.current_head ~proc_mgr ~cwd in
281
+
282
+
(* Build recovery state *)
283
+
let steps = build_add_steps ~name ~url ~branch ~opam_packages in
284
+
let state = Recovery.{
285
+
operation = Add_package { name; url; branch; opam_packages };
286
+
original_branch;
287
+
original_head;
288
+
started = iso_timestamp ();
289
+
completed = [];
290
+
pending = steps;
291
+
} in
292
+
Recovery.save ~cwd state;
293
+
294
+
(* Execute steps with recovery tracking *)
295
+
let rec execute_steps state =
296
+
match state.Recovery.pending with
297
+
| [] ->
298
+
Recovery.clear ~cwd;
299
+
let upstream_sha = Git.rev_parse_exn ~proc_mgr ~cwd (upstream_branch name) in
300
+
let vendor_sha = Git.rev_parse_exn ~proc_mgr ~cwd (vendor_branch name) in
301
+
Success {
302
+
canonical_name = name;
303
+
opam_packages;
304
+
upstream_sha;
305
+
vendor_sha;
306
+
}
307
+
| step :: rest ->
308
+
begin try
309
+
execute_step ~proc_mgr ~cwd step;
310
+
let state = { state with
311
+
Recovery.completed = step :: state.completed;
312
+
pending = rest;
313
+
} in
314
+
Recovery.save ~cwd state;
315
+
execute_steps state
316
+
with exn ->
317
+
let hint = match step with
318
+
| Recovery.Merge_to_project _ ->
319
+
"Merge conflict. Resolve conflicts then run: unpac vendor continue"
320
+
| Recovery.Create_vendor _ ->
321
+
"Failed creating vendor branch. Run: unpac vendor abort"
322
+
| _ ->
323
+
"Run 'unpac vendor abort' to rollback, or fix and 'unpac vendor continue'"
324
+
in
325
+
Failed {
326
+
step = Recovery.step_name step;
327
+
error = exn;
328
+
recovery_hint = hint;
329
+
}
330
+
end
331
+
in
332
+
execute_steps state
333
+
end
334
+
335
+
let update_package ~proc_mgr ~cwd ~name =
336
+
if not (is_vendored ~proc_mgr ~cwd name) then begin
337
+
Log.err (fun m -> m "Package %s is not vendored" name);
338
+
Update_failed {
339
+
step = "check_vendored";
340
+
error = Git.err (Git.Remote_not_found (remote_name name));
341
+
recovery_hint = Printf.sprintf "Use 'unpac add opam %s' to add it first" name;
342
+
}
343
+
end else begin
344
+
let remote = remote_name name in
345
+
let upstream = upstream_branch name in
346
+
let vendor = vendor_branch name in
347
+
348
+
try
349
+
(* Get old SHA *)
350
+
let old_sha = Git.rev_parse_exn ~proc_mgr ~cwd upstream in
351
+
352
+
(* Fetch latest *)
353
+
Log.info (fun m -> m "Fetching from %s..." remote);
354
+
Git.fetch ~proc_mgr ~cwd ~remote;
355
+
356
+
(* Get URL and detect branch *)
357
+
let url = Git.remote_url ~proc_mgr ~cwd remote |> option_value ~default:"" in
358
+
let branch = Git.ls_remote_default_branch ~proc_mgr ~url in
359
+
let remote_ref = remote ^ "/" ^ branch in
360
+
361
+
(* Update upstream branch *)
362
+
Log.info (fun m -> m "Updating %s..." upstream);
363
+
Git.branch_force ~proc_mgr ~cwd ~name:upstream ~point:remote_ref;
364
+
365
+
let new_sha = Git.rev_parse_exn ~proc_mgr ~cwd upstream in
366
+
367
+
if old_sha = new_sha then begin
368
+
Log.info (fun m -> m "No changes in upstream");
369
+
No_changes
370
+
end else begin
371
+
(* Show changelog *)
372
+
let commits = Git.log_oneline ~proc_mgr ~cwd ~max_count:20 old_sha new_sha in
373
+
let commit_count = List.length commits in
374
+
Log.info (fun m -> m "Changes in upstream (%d commits):" commit_count);
375
+
List.iter (fun line -> Log.info (fun m -> m " %s" line)) commits;
376
+
377
+
(* Update vendor branch *)
378
+
Log.info (fun m -> m "Updating %s with path rewrite..." vendor);
379
+
let current = Git.current_branch ~proc_mgr ~cwd in
380
+
381
+
Git.checkout ~proc_mgr ~cwd vendor;
382
+
383
+
(* Remove old vendor files *)
384
+
Git.rm_rf ~proc_mgr ~cwd ~target:(vendor_path name);
385
+
386
+
(* Read new tree *)
387
+
Git.read_tree_prefix ~proc_mgr ~cwd ~prefix:(vendor_path name) ~tree:upstream;
388
+
Git.checkout_index ~proc_mgr ~cwd;
389
+
390
+
(* Commit *)
391
+
let old_short = String.sub old_sha 0 7 in
392
+
let new_short = String.sub new_sha 0 7 in
393
+
let changelog = String.concat "\n" (List.filteri (fun i _ -> i < 10) commits) in
394
+
let message = Printf.sprintf "vendor/%s: update to %s\n\nChanges from %s to %s:\n%s"
395
+
name new_short old_short new_short changelog
396
+
in
397
+
Git.add_all ~proc_mgr ~cwd;
398
+
Git.commit ~proc_mgr ~cwd ~message;
399
+
400
+
(* Return to original branch *)
401
+
begin match current with
402
+
| Some b -> Git.checkout ~proc_mgr ~cwd b
403
+
| None -> ()
404
+
end;
405
+
406
+
Updated { old_sha; new_sha; commit_count }
407
+
end
408
+
with exn ->
409
+
Update_failed {
410
+
step = "update";
411
+
error = exn;
412
+
recovery_hint = "Check git status and resolve manually";
413
+
}
414
+
end
415
+
416
+
let rebase_patches ~proc_mgr ~cwd ~name =
417
+
let vendor = vendor_branch name in
418
+
let patches = patches_branch name in
419
+
420
+
if not (Git.branch_exists ~proc_mgr ~cwd patches) then begin
421
+
Log.err (fun m -> m "Patches branch %s does not exist" patches);
422
+
Error (`Conflict "Patches branch does not exist")
423
+
end else begin
424
+
let current = Git.current_branch ~proc_mgr ~cwd in
425
+
426
+
Git.checkout ~proc_mgr ~cwd patches;
427
+
428
+
(* Count patches *)
429
+
let patch_count = Git.rev_list_count ~proc_mgr ~cwd vendor patches in
430
+
431
+
if patch_count = 0 then begin
432
+
Log.info (fun m -> m "No patches to rebase");
433
+
begin match current with
434
+
| Some b -> Git.checkout ~proc_mgr ~cwd b
435
+
| None -> ()
436
+
end;
437
+
Ok ()
438
+
end else begin
439
+
Log.info (fun m -> m "Rebasing %d patch(es)..." patch_count);
440
+
match Git.rebase ~proc_mgr ~cwd ~onto:vendor with
441
+
| Ok () ->
442
+
Log.info (fun m -> m "Rebase completed successfully");
443
+
begin match current with
444
+
| Some b -> Git.checkout ~proc_mgr ~cwd b
445
+
| None -> ()
446
+
end;
447
+
Ok ()
448
+
| Error (`Conflict hint) ->
449
+
let prompt = generate_conflict_prompt ~operation:"rebase" ~pkg_name:name ~files:[] in
450
+
Log.warn (fun m -> m "Rebase has conflicts");
451
+
Log.info (fun m -> m "%s" prompt);
452
+
Error (`Conflict hint)
453
+
end
454
+
end
455
+
456
+
let merge_to_project ~proc_mgr ~cwd ~name =
457
+
let patches = patches_branch name in
458
+
459
+
if not (Git.branch_exists ~proc_mgr ~cwd patches) then begin
460
+
Log.err (fun m -> m "Patches branch %s does not exist" patches);
461
+
Error (`Conflict ["Patches branch does not exist"])
462
+
end else begin
463
+
let message = Printf.sprintf "Merge %s\n\nVendor package: %s" patches name in
464
+
match Git.merge_allow_unrelated ~proc_mgr ~cwd ~branch:patches ~message with
465
+
| Ok () ->
466
+
Log.info (fun m -> m "Merge completed successfully");
467
+
Ok ()
468
+
| Error (`Conflict files) ->
469
+
let prompt = generate_conflict_prompt ~operation:"merge" ~pkg_name:name ~files in
470
+
Log.warn (fun m -> m "Merge has conflicts");
471
+
Log.info (fun m -> m "%s" prompt);
472
+
Error (`Conflict files)
473
+
end
474
+
475
+
(* Recovery *)
476
+
477
+
let continue ~proc_mgr ~cwd state =
478
+
Log.info (fun m -> m "Continuing operation: %a" Recovery.pp_operation state.Recovery.operation);
479
+
480
+
let rec execute_steps state =
481
+
match state.Recovery.pending with
482
+
| [] ->
483
+
Recovery.clear ~cwd;
484
+
begin match state.operation with
485
+
| Recovery.Add_package { name; opam_packages; _ } ->
486
+
let upstream_sha = Git.rev_parse_exn ~proc_mgr ~cwd (upstream_branch name) in
487
+
let vendor_sha = Git.rev_parse_exn ~proc_mgr ~cwd (vendor_branch name) in
488
+
Success {
489
+
canonical_name = name;
490
+
opam_packages;
491
+
upstream_sha;
492
+
vendor_sha;
493
+
}
494
+
| _ ->
495
+
(* For other operations, return a generic success *)
496
+
Success {
497
+
canonical_name = "unknown";
498
+
opam_packages = [];
499
+
upstream_sha = "";
500
+
vendor_sha = "";
501
+
}
502
+
end
503
+
| step :: rest ->
504
+
begin try
505
+
execute_step ~proc_mgr ~cwd step;
506
+
let state = { state with
507
+
Recovery.completed = step :: state.completed;
508
+
pending = rest;
509
+
} in
510
+
Recovery.save ~cwd state;
511
+
execute_steps state
512
+
with exn ->
513
+
let hint = match step with
514
+
| Recovery.Merge_to_project _ ->
515
+
"Merge conflict. Resolve conflicts then run: unpac vendor continue"
516
+
| _ ->
517
+
"Run 'unpac vendor abort' to rollback, or fix and 'unpac vendor continue'"
518
+
in
519
+
Failed {
520
+
step = Recovery.step_name step;
521
+
error = exn;
522
+
recovery_hint = hint;
523
+
}
524
+
end
525
+
in
526
+
execute_steps state
+157
lib/vendor.mli
+157
lib/vendor.mli
···
···
1
+
(** Vendor package management operations.
2
+
3
+
This module implements the three-tier branch model for vendoring packages:
4
+
- [upstream/<pkg>] - pristine upstream with original paths
5
+
- [vendor/<pkg>] - orphan branch with path-rewritten files
6
+
- [patches/<pkg>] - local modifications on top of vendor *)
7
+
8
+
(** {1 Types} *)
9
+
10
+
type package_status = {
11
+
name : string;
12
+
url : string;
13
+
branch : string;
14
+
upstream_sha : string option;
15
+
vendor_sha : string option;
16
+
patches_sha : string option;
17
+
patch_count : int;
18
+
in_project : bool;
19
+
opam_packages : string list;
20
+
}
21
+
22
+
val pp_package_status : Format.formatter -> package_status -> unit
23
+
24
+
type add_result =
25
+
| Success of {
26
+
canonical_name : string;
27
+
opam_packages : string list;
28
+
upstream_sha : string;
29
+
vendor_sha : string;
30
+
}
31
+
| Already_vendored of string
32
+
| Failed of {
33
+
step : string;
34
+
error : exn;
35
+
recovery_hint : string;
36
+
}
37
+
38
+
type update_result =
39
+
| Updated of {
40
+
old_sha : string;
41
+
new_sha : string;
42
+
commit_count : int;
43
+
}
44
+
| No_changes
45
+
| Update_failed of {
46
+
step : string;
47
+
error : exn;
48
+
recovery_hint : string;
49
+
}
50
+
51
+
(** {1 Branch naming conventions} *)
52
+
53
+
val remote_name : string -> string
54
+
(** [remote_name pkg] returns ["origin-<pkg>"] *)
55
+
56
+
val upstream_branch : string -> string
57
+
(** [upstream_branch pkg] returns ["upstream/<pkg>"] *)
58
+
59
+
val vendor_branch : string -> string
60
+
(** [vendor_branch pkg] returns ["vendor/<pkg>"] *)
61
+
62
+
val patches_branch : string -> string
63
+
(** [patches_branch pkg] returns ["patches/<pkg>"] *)
64
+
65
+
val vendor_path : string -> string
66
+
(** [vendor_path pkg] returns ["vendor/<pkg>/"] *)
67
+
68
+
(** {1 Queries} *)
69
+
70
+
val is_vendored :
71
+
proc_mgr:Git.proc_mgr ->
72
+
cwd:Git.path ->
73
+
string ->
74
+
bool
75
+
(** [is_vendored ~proc_mgr ~cwd name] checks if package [name] is vendored. *)
76
+
77
+
val get_vendored_packages :
78
+
proc_mgr:Git.proc_mgr ->
79
+
cwd:Git.path ->
80
+
string list
81
+
(** [get_vendored_packages ~proc_mgr ~cwd] returns list of vendored package names. *)
82
+
83
+
val package_status :
84
+
proc_mgr:Git.proc_mgr ->
85
+
cwd:Git.path ->
86
+
string ->
87
+
package_status option
88
+
(** [package_status ~proc_mgr ~cwd name] returns status of vendored package. *)
89
+
90
+
val all_status :
91
+
proc_mgr:Git.proc_mgr ->
92
+
cwd:Git.path ->
93
+
package_status list
94
+
(** [all_status ~proc_mgr ~cwd] returns status of all vendored packages. *)
95
+
96
+
(** {1 Operations} *)
97
+
98
+
val add_package :
99
+
proc_mgr:Git.proc_mgr ->
100
+
cwd:Git.path ->
101
+
name:string ->
102
+
url:string ->
103
+
branch:string ->
104
+
opam_packages:string list ->
105
+
add_result
106
+
(** [add_package ~proc_mgr ~cwd ~name ~url ~branch ~opam_packages] vendors a package.
107
+
108
+
This:
109
+
1. Adds remote [origin-<name>]
110
+
2. Fetches from the remote
111
+
3. Creates [upstream/<name>] branch (pristine)
112
+
4. Creates [vendor/<name>] orphan branch with path rewrite
113
+
5. Creates [patches/<name>] branch
114
+
6. Merges [patches/<name>] into current project branch
115
+
7. Updates unpac.toml with package info *)
116
+
117
+
val update_package :
118
+
proc_mgr:Git.proc_mgr ->
119
+
cwd:Git.path ->
120
+
name:string ->
121
+
update_result
122
+
(** [update_package ~proc_mgr ~cwd ~name] updates a vendored package from upstream.
123
+
124
+
This:
125
+
1. Fetches latest from [origin-<name>]
126
+
2. Updates [upstream/<name>] branch
127
+
3. Updates [vendor/<name>] branch with new import *)
128
+
129
+
val rebase_patches :
130
+
proc_mgr:Git.proc_mgr ->
131
+
cwd:Git.path ->
132
+
name:string ->
133
+
(unit, [ `Conflict of string ]) result
134
+
(** [rebase_patches ~proc_mgr ~cwd ~name] rebases patches onto updated vendor. *)
135
+
136
+
val merge_to_project :
137
+
proc_mgr:Git.proc_mgr ->
138
+
cwd:Git.path ->
139
+
name:string ->
140
+
(unit, [ `Conflict of string list ]) result
141
+
(** [merge_to_project ~proc_mgr ~cwd ~name] merges patches branch into project. *)
142
+
143
+
(** {1 Recovery} *)
144
+
145
+
val continue :
146
+
proc_mgr:Git.proc_mgr ->
147
+
cwd:Git.path ->
148
+
Recovery.state ->
149
+
add_result
150
+
(** [continue ~proc_mgr ~cwd state] continues an interrupted operation. *)
151
+
152
+
val generate_conflict_prompt :
153
+
operation:string ->
154
+
pkg_name:string ->
155
+
files:string list ->
156
+
string
157
+
(** [generate_conflict_prompt] generates a prompt for Claude to help resolve conflicts. *)
+36
unpac.opam
+36
unpac.opam
···
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Monorepo management tool"
4
+
description:
5
+
"A tool for managing OCaml monorepos with opam repository integration"
6
+
authors: ["Anil Madhavapeddy"]
7
+
license: "ISC"
8
+
depends: [
9
+
"dune" {>= "3.0"}
10
+
"ocaml" {>= "5.1.0"}
11
+
"cmdliner" {>= "1.2.0"}
12
+
"eio_main" {>= "1.0"}
13
+
"logs" {>= "0.7.0"}
14
+
"fmt" {>= "0.9.0"}
15
+
"tomlt"
16
+
"jsont"
17
+
"xdge"
18
+
"opam-format"
19
+
"opam-core"
20
+
"opam-repository"
21
+
"odoc" {with-doc}
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
[
26
+
"dune"
27
+
"build"
28
+
"-p"
29
+
name
30
+
"-j"
31
+
jobs
32
+
"@install"
33
+
"@runtest" {with-test}
34
+
"@doc" {with-doc}
35
+
]
36
+
]
+9
unpac.toml.example
+9
unpac.toml.example
···
···
1
+
[opam]
2
+
# Repositories are listed in priority order.
3
+
# Later repositories take priority over earlier ones for duplicate packages.
4
+
repositories = [
5
+
{ name = "default", path = "/workspace/opam/opam-repository" },
6
+
{ name = "aoah", path = "/workspace/opam/aoah-opam-repo" },
7
+
# Remote URLs (not yet implemented):
8
+
# { name = "remote", url = "git+https://github.com/org/opam-repo.git" },
9
+
]