anil.recoil.org
A monorepo management tool for the agentic ages
metadata
+19
-1
.gitignore
+19
-1
.gitignore
···
1
+
# OCaml build artifacts
2
+
_build/
3
+
*.install
4
+
*.merlin
5
+
6
+
# Third-party sources (fetch locally with opam source)
7
+
third_party/
8
+
9
+
# Editor and OS files
10
+
.DS_Store
11
+
*.swp
12
+
*~
13
+
.vscode/
14
+
.idea/
15
+
16
+
# Opam local switch
17
+
_opam/
18
+
19
+
# Project-specific
1
20
*.toml
2
-
_build
3
21
*.sh
4
22
.unpac.log
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+53
.tangled/workflows/build.yml
+53
.tangled/workflows/build.yml
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
engine: nixery
6
+
7
+
dependencies:
8
+
nixpkgs:
9
+
- shell
10
+
- stdenv
11
+
- findutils
12
+
- binutils
13
+
- libunwind
14
+
- ncurses
15
+
- opam
16
+
- git
17
+
- gawk
18
+
- gnupatch
19
+
- gnum4
20
+
- gnumake
21
+
- gnutar
22
+
- gnused
23
+
- gnugrep
24
+
- diffutils
25
+
- gzip
26
+
- bzip2
27
+
- gcc
28
+
- ocaml
29
+
- pkg-config
30
+
31
+
steps:
32
+
- name: opam
33
+
command: |
34
+
opam init --disable-sandboxing -a -y
35
+
- name: repo
36
+
command: |
37
+
opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
38
+
- name: switch
39
+
command: |
40
+
opam install . --confirm-level=unsafe-yes --deps-only
41
+
- name: build
42
+
command: |
43
+
opam exec -- dune build
44
+
- name: switch-test
45
+
command: |
46
+
opam install . --confirm-level=unsafe-yes --deps-only --with-test
47
+
- name: test
48
+
command: |
49
+
opam exec -- dune runtest --verbose
50
+
- name: doc
51
+
command: |
52
+
opam install -y odoc
53
+
opam exec -- dune build @doc
+15
LICENSE.md
+15
LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>
4
+
5
+
Permission to use, copy, modify, and distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+50
README.md
+50
README.md
···
1
+
# unpac - OCaml Monorepo Management Tool
2
+
3
+
A tool for managing OCaml monorepos with opam repository integration. Unpac handles vendoring dependencies, managing worktrees, and synchronizing packages across a monorepo.
4
+
5
+
## Key Features
6
+
7
+
- **Dependency Vendoring**: Vendor opam packages directly into your monorepo
8
+
- **Worktree Management**: Manage git worktrees for isolated development
9
+
- **Repository Integration**: Seamless integration with opam repositories
10
+
- **Eio-based**: Built on the Eio direct-style effects library for modern OCaml
11
+
12
+
## Installation
13
+
14
+
```
15
+
opam install unpac
16
+
```
17
+
18
+
## Usage
19
+
20
+
Configure your monorepo with an `unpac.toml` file:
21
+
22
+
```toml
23
+
# Example configuration - see unpac.toml.example for details
24
+
```
25
+
26
+
Then run:
27
+
28
+
```bash
29
+
unpac init # Initialize a new monorepo
30
+
unpac vendor # Vendor dependencies
31
+
unpac sync # Synchronize packages
32
+
```
33
+
34
+
## Packages
35
+
36
+
- **unpac**: Core library for monorepo management
37
+
- **unpac-opam**: Opam backend for dependency resolution and vendoring
38
+
39
+
## Documentation
40
+
41
+
API documentation is available via:
42
+
43
+
```
44
+
opam install unpac
45
+
odig doc unpac
46
+
```
47
+
48
+
## License
49
+
50
+
ISC
+439
-282
bin/main.ml
+439
-282
bin/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
open Cmdliner
2
7
3
8
(* Logging setup *)
···
6
11
Logs.set_level (Some Logs.Info);
7
12
Logs.set_reporter (Logs_fmt.reporter ())
8
13
9
-
let logging_term =
10
-
Term.(const setup_logging $ const ())
14
+
let logging_term = Term.(const setup_logging $ const ())
11
15
12
16
(* Helper to find project root *)
13
17
let with_root f =
···
19
23
| None ->
20
24
Format.eprintf "Error: Not in an unpac project.@.";
21
25
exit 1
22
-
| Some root ->
23
-
f ~env ~fs ~proc_mgr ~root
26
+
| Some root -> f ~env ~fs ~proc_mgr ~root
24
27
25
28
(* Helper to get config path *)
26
29
let config_path root =
···
39
42
let path = config_path root in
40
43
Unpac.Config.save_exn path config;
41
44
let main_wt = Unpac.Worktree.path root Unpac.Worktree.Main in
42
-
Unpac.Git.run_exn ~proc_mgr ~cwd:main_wt ["add"; "unpac.toml"] |> ignore;
43
-
Unpac.Git.run_exn ~proc_mgr ~cwd:main_wt ["commit"; "-m"; msg] |> ignore
45
+
Unpac.Git.run_exn ~proc_mgr ~cwd:main_wt [ "add"; "unpac.toml" ] |> ignore;
46
+
Unpac.Git.run_exn ~proc_mgr ~cwd:main_wt [ "commit"; "-m"; msg ] |> ignore
44
47
45
48
(* Check if string looks like a URL or path (vs a package name) *)
46
49
let is_url_or_path s =
47
-
String.starts_with ~prefix:"http://" s ||
48
-
String.starts_with ~prefix:"https://" s ||
49
-
String.starts_with ~prefix:"git@" s ||
50
-
String.starts_with ~prefix:"git://" s ||
51
-
String.starts_with ~prefix:"ssh://" s ||
52
-
String.starts_with ~prefix:"file://" s ||
53
-
String.starts_with ~prefix:"/" s || (* Absolute path *)
54
-
String.starts_with ~prefix:"./" s || (* Relative path *)
55
-
String.starts_with ~prefix:"../" s || (* Relative path *)
56
-
String.contains s ':' (* URL with scheme *)
50
+
String.starts_with ~prefix:"http://" s
51
+
|| String.starts_with ~prefix:"https://" s
52
+
|| String.starts_with ~prefix:"git@" s
53
+
|| String.starts_with ~prefix:"git://" s
54
+
|| String.starts_with ~prefix:"ssh://" s
55
+
|| String.starts_with ~prefix:"file://" s
56
+
|| String.starts_with ~prefix:"/" s
57
+
(* Absolute path *)
58
+
|| String.starts_with ~prefix:"./" s
59
+
(* Relative path *)
60
+
|| String.starts_with ~prefix:"../" s
61
+
||
62
+
(* Relative path *)
63
+
String.contains s ':' (* URL with scheme *)
57
64
58
65
(* Normalize a dev-repo URL for grouping comparison *)
59
66
let normalize_dev_repo url =
60
67
let s = url in
61
68
(* Strip git+ prefix *)
62
-
let s = if String.starts_with ~prefix:"git+" s then
63
-
String.sub s 4 (String.length s - 4) else s in
69
+
let s =
70
+
if String.starts_with ~prefix:"git+" s then
71
+
String.sub s 4 (String.length s - 4)
72
+
else s
73
+
in
64
74
(* Strip trailing .git *)
65
-
let s = if String.ends_with ~suffix:".git" s then
66
-
String.sub s 0 (String.length s - 4) else s in
75
+
let s =
76
+
if String.ends_with ~suffix:".git" s then
77
+
String.sub s 0 (String.length s - 4)
78
+
else s
79
+
in
67
80
(* Strip trailing slash *)
68
-
let s = if String.ends_with ~suffix:"/" s then
69
-
String.sub s 0 (String.length s - 1) else s in
81
+
let s =
82
+
if String.ends_with ~suffix:"/" s then String.sub s 0 (String.length s - 1)
83
+
else s
84
+
in
70
85
(* Normalize github URLs: git@github.com:x/y -> https://github.com/x/y *)
71
-
let s = if String.starts_with ~prefix:"git@github.com:" s then
72
-
"https://github.com/" ^ String.sub s 15 (String.length s - 15) else s in
86
+
let s =
87
+
if String.starts_with ~prefix:"git@github.com:" s then
88
+
"https://github.com/" ^ String.sub s 15 (String.length s - 15)
89
+
else s
90
+
in
73
91
String.lowercase_ascii s
74
92
75
93
(* Group solved packages by their dev-repo *)
76
94
type package_group = {
77
-
canonical_name : string; (* First package name, used as vendor name *)
78
-
dev_repo : string; (* Original dev-repo URL *)
79
-
packages : string list; (* All package names in this group *)
95
+
canonical_name : string; (* First package name, used as vendor name *)
96
+
dev_repo : string; (* Original dev-repo URL *)
97
+
packages : string list; (* All package names in this group *)
80
98
}
81
99
82
-
let group_packages_by_dev_repo ~config (pkgs : OpamPackage.t list) : package_group list =
100
+
let group_packages_by_dev_repo ~config (pkgs : OpamPackage.t list) :
101
+
package_group list =
83
102
let repos = config.Unpac.Config.opam.repositories in
84
103
(* Build a map from normalized dev-repo to package info *)
85
104
let groups = Hashtbl.create 16 in
86
-
List.iter (fun pkg ->
87
-
let name = OpamPackage.Name.to_string (OpamPackage.name pkg) in
88
-
let version = OpamPackage.Version.to_string (OpamPackage.version pkg) in
89
-
match Unpac_opam.Repo.find_package ~repos ~name ~version () with
90
-
| None -> () (* Skip packages not found *)
91
-
| Some result ->
92
-
match result.metadata.dev_repo with
93
-
| None -> () (* Skip packages without dev-repo *)
94
-
| Some dev_repo ->
95
-
let key = normalize_dev_repo dev_repo in
96
-
match Hashtbl.find_opt groups key with
97
-
| None ->
98
-
Hashtbl.add groups key (dev_repo, [name])
99
-
| Some (orig_url, names) ->
100
-
Hashtbl.replace groups key (orig_url, name :: names)
101
-
) pkgs;
105
+
List.iter
106
+
(fun pkg ->
107
+
let name = OpamPackage.Name.to_string (OpamPackage.name pkg) in
108
+
let version = OpamPackage.Version.to_string (OpamPackage.version pkg) in
109
+
match Unpac_opam.Repo.find_package ~repos ~name ~version () with
110
+
| None -> () (* Skip packages not found *)
111
+
| Some result -> (
112
+
match result.metadata.dev_repo with
113
+
| None -> () (* Skip packages without dev-repo *)
114
+
| Some dev_repo -> (
115
+
let key = normalize_dev_repo dev_repo in
116
+
match Hashtbl.find_opt groups key with
117
+
| None -> Hashtbl.add groups key (dev_repo, [ name ])
118
+
| Some (orig_url, names) ->
119
+
Hashtbl.replace groups key (orig_url, name :: names))))
120
+
pkgs;
102
121
(* Convert to list of groups *)
103
-
Hashtbl.fold (fun _key (dev_repo, names) acc ->
104
-
let names = List.rev names in (* Preserve order *)
105
-
let canonical_name = List.hd names in
106
-
{ canonical_name; dev_repo; packages = names } :: acc
107
-
) groups []
122
+
Hashtbl.fold
123
+
(fun _key (dev_repo, names) acc ->
124
+
let names = List.rev names in
125
+
(* Preserve order *)
126
+
let canonical_name = List.hd names in
127
+
{ canonical_name; dev_repo; packages = names } :: acc)
128
+
groups []
108
129
|> List.sort (fun a b -> String.compare a.canonical_name b.canonical_name)
109
130
110
131
(* Helper to resolve vendor cache *)
111
132
let resolve_cache ~proc_mgr ~fs ~config ~cli_cache =
112
133
match Unpac.Config.resolve_vendor_cache ?cli_override:cli_cache config with
113
134
| None -> None
114
-
| Some path ->
115
-
Some (Unpac.Vendor_cache.init ~proc_mgr ~fs ~path ())
135
+
| Some path -> Some (Unpac.Vendor_cache.init ~proc_mgr ~fs ~path ())
116
136
117
137
(* Init command *)
118
138
let init_cmd =
···
129
149
Format.printf "Initialized unpac project at %s@." path;
130
150
Format.printf "@.Next steps:@.";
131
151
Format.printf " cd %s@." path;
132
-
Format.printf " unpac opam repo add <name> <path> # configure opam repository@.";
152
+
Format.printf
153
+
" unpac opam repo add <name> <path> # configure opam repository@.";
133
154
Format.printf " unpac project new <name> # create a project@."
134
155
in
135
156
let info = Cmd.info "init" ~doc in
···
148
169
Format.printf "Created project %s@." name;
149
170
Format.printf "@.Next steps:@.";
150
171
Format.printf " unpac opam add <package> # vendor a package@.";
151
-
Format.printf " unpac opam merge <package> %s # merge package into project@." name
172
+
Format.printf
173
+
" unpac opam merge <package> %s # merge package into project@." name
152
174
in
153
175
let info = Cmd.info "new" ~doc in
154
176
Cmd.v info Term.(const run $ logging_term $ name_arg)
···
168
190
let project_cmd =
169
191
let doc = "Project management commands." in
170
192
let info = Cmd.info "project" ~doc in
171
-
Cmd.group info [project_new_cmd; project_list_cmd]
193
+
Cmd.group info [ project_new_cmd; project_list_cmd ]
172
194
173
195
(* Opam repo add command *)
174
196
let opam_repo_add_cmd =
···
191
213
end;
192
214
(* Resolve to absolute path *)
193
215
let abs_path =
194
-
if Filename.is_relative path then
195
-
Filename.concat (Sys.getcwd ()) path
216
+
if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
196
217
else path
197
218
in
198
219
(* Check path exists *)
···
200
221
Format.eprintf "Error: '%s' is not a valid directory@." abs_path;
201
222
exit 1
202
223
end;
203
-
let repo : Unpac.Config.repo_config = {
204
-
repo_name = name;
205
-
source = Local abs_path;
206
-
} in
224
+
let repo : Unpac.Config.repo_config =
225
+
{ repo_name = name; source = Local abs_path }
226
+
in
207
227
let config' = Unpac.Config.add_repo config repo in
208
228
save_config ~proc_mgr root config' (Printf.sprintf "Add repository %s" name);
209
229
Format.printf "Added repository %s at %s@." name abs_path;
210
-
Format.printf "@.Next: unpac opam add <package> # vendor a package by name@."
230
+
Format.printf
231
+
"@.Next: unpac opam add <package> # vendor a package by name@."
211
232
in
212
233
let info = Cmd.info "add" ~doc in
213
234
Cmd.v info Term.(const run $ logging_term $ name_arg $ path_arg)
···
221
242
if config.opam.repositories = [] then begin
222
243
Format.printf "No repositories configured@.";
223
244
Format.printf "@.Hint: unpac opam repo add <name> <path>@."
224
-
end else
225
-
List.iter (fun (r : Unpac.Config.repo_config) ->
226
-
let path = match r.source with
227
-
| Local p -> p
228
-
| Remote u -> u
229
-
in
230
-
Format.printf "%s: %s@." r.repo_name path
231
-
) config.opam.repositories
245
+
end
246
+
else
247
+
List.iter
248
+
(fun (r : Unpac.Config.repo_config) ->
249
+
let path = match r.source with Local p -> p | Remote u -> u in
250
+
Format.printf "%s: %s@." r.repo_name path)
251
+
config.opam.repositories
232
252
in
233
253
let info = Cmd.info "list" ~doc in
234
254
Cmd.v info Term.(const run $ logging_term)
···
248
268
exit 1
249
269
end;
250
270
let config' = Unpac.Config.remove_repo config name in
251
-
save_config ~proc_mgr root config' (Printf.sprintf "Remove repository %s" name);
271
+
save_config ~proc_mgr root config'
272
+
(Printf.sprintf "Remove repository %s" name);
252
273
Format.printf "Removed repository %s@." name
253
274
in
254
275
let info = Cmd.info "remove" ~doc in
···
258
279
let opam_repo_cmd =
259
280
let doc = "Manage opam repositories." in
260
281
let info = Cmd.info "repo" ~doc in
261
-
Cmd.group info [opam_repo_add_cmd; opam_repo_list_cmd; opam_repo_remove_cmd]
282
+
Cmd.group info [ opam_repo_add_cmd; opam_repo_list_cmd; opam_repo_remove_cmd ]
262
283
263
284
(* Opam config compiler command *)
264
285
let opam_config_compiler_cmd =
···
271
292
with_root @@ fun ~env:_ ~fs:_ ~proc_mgr ~root ->
272
293
let config = load_config root in
273
294
match version_opt with
274
-
| None ->
295
+
| None -> (
275
296
(* Show current compiler *)
276
-
(match Unpac.Config.get_compiler config with
277
-
| Some v -> Format.printf "Compiler: %s@." v
278
-
| None -> Format.printf "No compiler configured@.@.Hint: unpac opam config compiler 5.2.0@.")
297
+
match Unpac.Config.get_compiler config with
298
+
| Some v -> Format.printf "Compiler: %s@." v
299
+
| None ->
300
+
Format.printf
301
+
"No compiler configured@.@.Hint: unpac opam config compiler \
302
+
5.2.0@.")
279
303
| Some version ->
280
304
(* Set compiler *)
281
305
let config' = Unpac.Config.set_compiler config version in
282
-
save_config ~proc_mgr root config' (Printf.sprintf "Set compiler to %s" version);
306
+
save_config ~proc_mgr root config'
307
+
(Printf.sprintf "Set compiler to %s" version);
283
308
Format.printf "Compiler set to %s@." version
284
309
in
285
310
let info = Cmd.info "compiler" ~doc in
···
289
314
let opam_config_cmd =
290
315
let doc = "Configure opam settings." in
291
316
let info = Cmd.info "config" ~doc in
292
-
Cmd.group info [opam_config_compiler_cmd]
317
+
Cmd.group info [ opam_config_compiler_cmd ]
293
318
294
319
(* Opam add command - enhanced to support package names and dependency solving *)
295
320
let opam_add_cmd =
···
300
325
in
301
326
let name_arg =
302
327
let doc = "Override package name." in
303
-
Arg.(value & opt (some string) None & info ["n"; "name"] ~docv:"NAME" ~doc)
328
+
Arg.(
329
+
value & opt (some string) None & info [ "n"; "name" ] ~docv:"NAME" ~doc)
304
330
in
305
331
let version_arg =
306
332
let doc = "Package version (when adding by name)." in
307
-
Arg.(value & opt (some string) None & info ["V"; "pkg-version"] ~docv:"VERSION" ~doc)
333
+
Arg.(
334
+
value
335
+
& opt (some string) None
336
+
& info [ "V"; "pkg-version" ] ~docv:"VERSION" ~doc)
308
337
in
309
338
let branch_arg =
310
339
let doc = "Git branch to vendor (defaults to remote default)." in
311
-
Arg.(value & opt (some string) None & info ["b"; "branch"] ~docv:"BRANCH" ~doc)
340
+
Arg.(
341
+
value
342
+
& opt (some string) None
343
+
& info [ "b"; "branch" ] ~docv:"BRANCH" ~doc)
312
344
in
313
345
let solve_arg =
314
346
let doc = "Solve dependencies and vendor all required packages." in
315
-
Arg.(value & flag & info ["solve"] ~doc)
347
+
Arg.(value & flag & info [ "solve" ] ~doc)
316
348
in
317
349
let cache_arg =
318
-
let doc = "Path to vendor cache (overrides config and UNPAC_VENDOR_CACHE env var)." in
319
-
Arg.(value & opt (some string) None & info ["cache"] ~docv:"PATH" ~doc)
350
+
let doc =
351
+
"Path to vendor cache (overrides config and UNPAC_VENDOR_CACHE env var)."
352
+
in
353
+
Arg.(value & opt (some string) None & info [ "cache" ] ~docv:"PATH" ~doc)
320
354
in
321
355
let run () pkg name_opt version_opt branch_opt solve cli_cache =
322
356
with_root @@ fun ~env:_ ~fs ~proc_mgr ~root ->
···
327
361
(* Solve dependencies and add all packages *)
328
362
let repos = config.opam.repositories in
329
363
if repos = [] then begin
330
-
Format.eprintf "No repositories configured. Add one with: unpac opam repo add <name> <path>@.";
364
+
Format.eprintf
365
+
"No repositories configured. Add one with: unpac opam repo add \
366
+
<name> <path>@.";
331
367
exit 1
332
368
end;
333
-
let ocaml_version = match Unpac.Config.get_compiler config with
369
+
let ocaml_version =
370
+
match Unpac.Config.get_compiler config with
334
371
| Some v -> v
335
372
| None ->
336
373
Format.eprintf "No compiler version configured.@.";
···
338
375
exit 1
339
376
in
340
377
(* Get repo paths *)
341
-
let repo_paths = List.map (fun (r : Unpac.Config.repo_config) ->
342
-
match r.source with
343
-
| Unpac.Config.Local p -> p
344
-
| Unpac.Config.Remote u -> u (* TODO: handle remote repos *)
345
-
) repos in
378
+
let repo_paths =
379
+
List.map
380
+
(fun (r : Unpac.Config.repo_config) ->
381
+
match r.source with
382
+
| Unpac.Config.Local p -> p
383
+
| Unpac.Config.Remote u -> u (* TODO: handle remote repos *))
384
+
repos
385
+
in
346
386
Format.printf "Solving dependencies for %s...@." pkg;
347
-
match Unpac_opam.Solver.solve ~repos:repo_paths ~ocaml_version ~packages:[pkg] with
387
+
match
388
+
Unpac_opam.Solver.solve ~repos:repo_paths ~ocaml_version
389
+
~packages:[ pkg ]
390
+
with
348
391
| Error msg ->
349
392
Format.eprintf "Dependency solving failed:@.%s@." msg;
350
393
exit 1
351
394
| Ok result ->
352
395
let pkgs = result.packages in
353
396
Format.printf "Solution found: %d packages@." (List.length pkgs);
354
-
List.iter (fun p ->
355
-
Format.printf " %s.%s@."
356
-
(OpamPackage.Name.to_string (OpamPackage.name p))
357
-
(OpamPackage.Version.to_string (OpamPackage.version p))
358
-
) pkgs;
397
+
List.iter
398
+
(fun p ->
399
+
Format.printf " %s.%s@."
400
+
(OpamPackage.Name.to_string (OpamPackage.name p))
401
+
(OpamPackage.Version.to_string (OpamPackage.version p)))
402
+
pkgs;
359
403
360
404
(* Group packages by dev-repo to avoid duplicating sources *)
361
405
let groups = group_packages_by_dev_repo ~config pkgs in
362
-
Format.printf "@.Grouped into %d unique repositories:@." (List.length groups);
363
-
List.iter (fun (g : package_group) ->
364
-
if List.length g.packages > 1 then
365
-
Format.printf " %s (%d packages: %s)@."
366
-
g.canonical_name
367
-
(List.length g.packages)
368
-
(String.concat ", " g.packages)
369
-
else
370
-
Format.printf " %s@." g.canonical_name
371
-
) groups;
406
+
Format.printf "@.Grouped into %d unique repositories:@."
407
+
(List.length groups);
408
+
List.iter
409
+
(fun (g : package_group) ->
410
+
if List.length g.packages > 1 then
411
+
Format.printf " %s (%d packages: %s)@." g.canonical_name
412
+
(List.length g.packages)
413
+
(String.concat ", " g.packages)
414
+
else Format.printf " %s@." g.canonical_name)
415
+
groups;
372
416
373
417
Format.printf "@.Vendoring repositories...@.";
374
418
let added = ref 0 in
375
419
let failed = ref 0 in
376
-
List.iter (fun (g : package_group) ->
377
-
(* Use canonical name as vendor name, dev-repo as URL *)
378
-
let url = if String.starts_with ~prefix:"git+" g.dev_repo then
379
-
String.sub g.dev_repo 4 (String.length g.dev_repo - 4)
380
-
else g.dev_repo in
381
-
let info : Unpac.Backend.package_info = {
382
-
name = g.canonical_name;
383
-
url;
384
-
branch = None;
385
-
} in
386
-
match Unpac_opam.Opam.add_package ~proc_mgr ~root ?cache info with
387
-
| Unpac.Backend.Added { name = pkg_name; sha } ->
388
-
Format.printf "Added %s (%s)@." pkg_name (String.sub sha 0 7);
389
-
if List.length g.packages > 1 then
390
-
Format.printf " Contains: %s@." (String.concat ", " g.packages);
391
-
incr added
392
-
| Unpac.Backend.Already_exists pkg_name ->
393
-
Format.printf "Package %s already vendored@." pkg_name
394
-
| Unpac.Backend.Failed { name = pkg_name; error } ->
395
-
Format.eprintf "Error adding %s: %s@." pkg_name error;
396
-
incr failed
397
-
) groups;
398
-
Format.printf "@.Done: %d repositories added, %d failed@." !added !failed;
420
+
List.iter
421
+
(fun (g : package_group) ->
422
+
(* Use canonical name as vendor name, dev-repo as URL *)
423
+
let url =
424
+
if String.starts_with ~prefix:"git+" g.dev_repo then
425
+
String.sub g.dev_repo 4 (String.length g.dev_repo - 4)
426
+
else g.dev_repo
427
+
in
428
+
let info : Unpac.Backend.package_info =
429
+
{ name = g.canonical_name; url; branch = None }
430
+
in
431
+
match Unpac_opam.Opam.add_package ~proc_mgr ~root ?cache info with
432
+
| Unpac.Backend.Added { name = pkg_name; sha } ->
433
+
Format.printf "Added %s (%s)@." pkg_name (String.sub sha 0 7);
434
+
if List.length g.packages > 1 then
435
+
Format.printf " Contains: %s@."
436
+
(String.concat ", " g.packages);
437
+
incr added
438
+
| Unpac.Backend.Already_exists pkg_name ->
439
+
Format.printf "Package %s already vendored@." pkg_name
440
+
| Unpac.Backend.Failed { name = pkg_name; error } ->
441
+
Format.eprintf "Error adding %s: %s@." pkg_name error;
442
+
incr failed)
443
+
groups;
444
+
Format.printf "@.Done: %d repositories added, %d failed@." !added
445
+
!failed;
399
446
if !failed > 0 then exit 1
400
-
end else begin
447
+
end
448
+
else begin
401
449
(* Single package mode *)
402
450
let url, name =
403
451
if is_url_or_path pkg then begin
404
452
(* It's a URL *)
405
-
let n = match name_opt with
453
+
let n =
454
+
match name_opt with
406
455
| Some n -> n
407
456
| None ->
408
457
let base = Filename.basename pkg in
···
411
460
else base
412
461
in
413
462
(pkg, n)
414
-
end else begin
463
+
end
464
+
else begin
415
465
(* It's a package name - look up in repositories *)
416
466
let repos = config.opam.repositories in
417
467
if repos = [] then begin
418
-
Format.eprintf "No repositories configured. Add one with: unpac opam repo add <name> <path>@.";
468
+
Format.eprintf
469
+
"No repositories configured. Add one with: unpac opam repo add \
470
+
<name> <path>@.";
419
471
exit 1
420
472
end;
421
-
match Unpac_opam.Repo.find_package ~repos ~name:pkg ?version:version_opt () with
473
+
match
474
+
Unpac_opam.Repo.find_package ~repos ~name:pkg ?version:version_opt
475
+
()
476
+
with
422
477
| None ->
423
-
Format.eprintf "Package '%s' not found in configured repositories@." pkg;
478
+
Format.eprintf
479
+
"Package '%s' not found in configured repositories@." pkg;
424
480
exit 1
425
-
| Some result ->
481
+
| Some result -> (
426
482
match result.metadata.dev_repo with
427
483
| None ->
428
484
Format.eprintf "Package '%s' has no dev-repo field@." pkg;
429
485
exit 1
430
486
| Some dev_repo ->
431
487
(* Strip git+ prefix if present (opam dev-repo format) *)
432
-
let url = if String.starts_with ~prefix:"git+" dev_repo then
433
-
String.sub dev_repo 4 (String.length dev_repo - 4)
434
-
else dev_repo in
488
+
let url =
489
+
if String.starts_with ~prefix:"git+" dev_repo then
490
+
String.sub dev_repo 4 (String.length dev_repo - 4)
491
+
else dev_repo
492
+
in
435
493
let n = match name_opt with Some n -> n | None -> pkg in
436
-
(url, n)
494
+
(url, n))
437
495
end
438
496
in
439
497
440
-
let info : Unpac.Backend.package_info = {
441
-
name;
442
-
url;
443
-
branch = branch_opt;
444
-
} in
498
+
let info : Unpac.Backend.package_info =
499
+
{ name; url; branch = branch_opt }
500
+
in
445
501
match Unpac_opam.Opam.add_package ~proc_mgr ~root ?cache info with
446
502
| Unpac.Backend.Added { name = pkg_name; sha } ->
447
503
Format.printf "Added %s (%s)@." pkg_name (String.sub sha 0 7);
448
504
Format.printf "@.Next steps:@.";
449
-
Format.printf " unpac opam edit %s # make local changes@." pkg_name;
450
-
Format.printf " unpac opam merge %s <project> # merge into a project@." pkg_name
505
+
Format.printf
506
+
" unpac opam edit %s # make local changes@." pkg_name;
507
+
Format.printf
508
+
" unpac opam merge %s <project> # merge into a project@."
509
+
pkg_name
451
510
| Unpac.Backend.Already_exists name ->
452
511
Format.printf "Package %s already vendored@." name
453
512
| Unpac.Backend.Failed { name; error } ->
···
456
515
end
457
516
in
458
517
let info = Cmd.info "add" ~doc in
459
-
Cmd.v info Term.(const run $ logging_term $ pkg_arg $ name_arg $ version_arg $ branch_arg $ solve_arg $ cache_arg)
518
+
Cmd.v info
519
+
Term.(
520
+
const run $ logging_term $ pkg_arg $ name_arg $ version_arg $ branch_arg
521
+
$ solve_arg $ cache_arg)
460
522
461
523
(* Opam list command *)
462
524
let opam_list_cmd =
···
467
529
if packages = [] then begin
468
530
Format.printf "No packages vendored@.";
469
531
Format.printf "@.Hint: unpac opam add <package>@."
470
-
end else
471
-
List.iter (Format.printf "%s@.") packages
532
+
end
533
+
else List.iter (Format.printf "%s@.") packages
472
534
in
473
535
let info = Cmd.info "list" ~doc in
474
536
Cmd.v info Term.(const run $ logging_term)
475
537
476
538
(* Opam edit command *)
477
539
let opam_edit_cmd =
478
-
let doc = "Open a package's patches worktree for editing. \
479
-
Also creates a vendor worktree for reference." in
540
+
let doc =
541
+
"Open a package's patches worktree for editing. Also creates a vendor \
542
+
worktree for reference."
543
+
in
480
544
let pkg_arg =
481
545
let doc = "Package name to edit." in
482
546
Arg.(required & pos 0 (some string) None & info [] ~docv:"PACKAGE" ~doc)
···
492
556
(* Ensure both patches and vendor worktrees exist *)
493
557
Unpac.Worktree.ensure ~proc_mgr root (Unpac.Worktree.Opam_patches pkg);
494
558
Unpac.Worktree.ensure ~proc_mgr root (Unpac.Worktree.Opam_vendor pkg);
495
-
let patches_path = snd (Unpac.Worktree.path root (Unpac.Worktree.Opam_patches pkg)) in
496
-
let vendor_path = snd (Unpac.Worktree.path root (Unpac.Worktree.Opam_vendor pkg)) in
559
+
let patches_path =
560
+
snd (Unpac.Worktree.path root (Unpac.Worktree.Opam_patches pkg))
561
+
in
562
+
let vendor_path =
563
+
snd (Unpac.Worktree.path root (Unpac.Worktree.Opam_vendor pkg))
564
+
in
497
565
Format.printf "Editing %s@." pkg;
498
566
Format.printf "@.";
499
567
Format.printf "Worktrees created:@.";
···
526
594
end;
527
595
(* Check for uncommitted changes in patches worktree *)
528
596
let wt_path = Unpac.Worktree.path root patches_kind in
529
-
let status = Unpac.Git.run_exn ~proc_mgr ~cwd:wt_path ["status"; "--porcelain"] in
597
+
let status =
598
+
Unpac.Git.run_exn ~proc_mgr ~cwd:wt_path [ "status"; "--porcelain" ]
599
+
in
530
600
if String.trim status <> "" then begin
531
601
Format.eprintf "Warning: uncommitted changes in %s@." pkg;
532
602
Format.eprintf "Commit or discard them before closing.@.";
···
539
609
Format.printf "Closed editing session for %s@." pkg;
540
610
Format.printf "@.Next steps:@.";
541
611
Format.printf " unpac opam diff %s # view your changes@." pkg;
542
-
Format.printf " unpac opam merge %s <project> # merge into a project@." pkg
612
+
Format.printf " unpac opam merge %s <project> # merge into a project@."
613
+
pkg
543
614
in
544
615
let info = Cmd.info "done" ~doc in
545
616
Cmd.v info Term.(const run $ logging_term $ pkg_arg)
···
555
626
with_root @@ fun ~env:_ ~fs:_ ~proc_mgr ~root ->
556
627
match Unpac_opam.Opam.update_package ~proc_mgr ~root name with
557
628
| Unpac.Backend.Updated { name = pkg_name; old_sha; new_sha } ->
558
-
Format.printf "Updated %s: %s -> %s@." pkg_name
559
-
(String.sub old_sha 0 7) (String.sub new_sha 0 7);
629
+
Format.printf "Updated %s: %s -> %s@." pkg_name (String.sub old_sha 0 7)
630
+
(String.sub new_sha 0 7);
560
631
Format.printf "@.Next steps:@.";
561
-
Format.printf " unpac opam diff %s # view changes@." pkg_name;
562
-
Format.printf " unpac opam merge %s <project> # merge into a project@." pkg_name
563
-
| Unpac.Backend.No_changes name ->
564
-
Format.printf "%s is up to date@." name
632
+
Format.printf " unpac opam diff %s # view changes@."
633
+
pkg_name;
634
+
Format.printf
635
+
" unpac opam merge %s <project> # merge into a project@." pkg_name
636
+
| Unpac.Backend.No_changes name -> Format.printf "%s is up to date@." name
565
637
| Unpac.Backend.Update_failed { name; error } ->
566
638
Format.eprintf "Error updating %s: %s@." name error;
567
639
exit 1
···
571
643
572
644
(* Opam merge command *)
573
645
let opam_merge_cmd =
574
-
let doc = "Merge vendored opam packages into a project. \
575
-
Use --solve to merge a package and its dependencies, \
576
-
or --all to merge all vendored packages." in
646
+
let doc =
647
+
"Merge vendored opam packages into a project. Use --solve to merge a \
648
+
package and its dependencies, or --all to merge all vendored packages."
649
+
in
577
650
let args =
578
651
let doc = "PACKAGE PROJECT (or just PROJECT with --all)." in
579
652
Arg.(value & pos_all string [] & info [] ~docv:"ARGS" ~doc)
580
653
in
581
654
let all_flag =
582
655
let doc = "Merge all vendored packages into the project." in
583
-
Arg.(value & flag & info ["all"] ~doc)
656
+
Arg.(value & flag & info [ "all" ] ~doc)
584
657
in
585
658
let solve_flag =
586
-
let doc = "Solve dependencies for PACKAGE and merge all solved packages into the project." in
587
-
Arg.(value & flag & info ["solve"] ~doc)
659
+
let doc =
660
+
"Solve dependencies for PACKAGE and merge all solved packages into the \
661
+
project."
662
+
in
663
+
Arg.(value & flag & info [ "solve" ] ~doc)
588
664
in
589
665
let run () args all solve =
590
666
with_root @@ fun ~env:_ ~fs:_ ~proc_mgr ~root ->
···
592
668
593
669
let merge_one ~project pkg =
594
670
let patches_branch = Unpac_opam.Opam.patches_branch pkg in
595
-
match Unpac.Backend.merge_to_project ~proc_mgr ~root ~project ~patches_branch with
671
+
match
672
+
Unpac.Backend.merge_to_project ~proc_mgr ~root ~project ~patches_branch
673
+
with
596
674
| Ok () ->
597
675
Format.printf "Merged %s@." pkg;
598
676
true
···
603
681
in
604
682
605
683
let merge_packages packages project =
606
-
Format.printf "Merging %d packages into project %s...@." (List.length packages) project;
607
-
let (successes, failures) = List.fold_left (fun (s, f) pkg ->
608
-
if merge_one ~project pkg then (s + 1, f) else (s, f + 1)
609
-
) (0, 0) packages in
684
+
Format.printf "Merging %d packages into project %s...@."
685
+
(List.length packages) project;
686
+
let successes, failures =
687
+
List.fold_left
688
+
(fun (s, f) pkg ->
689
+
if merge_one ~project pkg then (s + 1, f) else (s, f + 1))
690
+
(0, 0) packages
691
+
in
610
692
Format.printf "@.Done: %d merged" successes;
611
693
if failures > 0 then Format.printf ", %d had conflicts" failures;
612
694
Format.printf "@.";
613
695
if failures > 0 then begin
614
696
Format.eprintf "Resolve conflicts in project/%s and commit.@." project;
615
697
exit 1
616
-
end else
617
-
Format.printf "Next: Build your project in project/%s@." project
698
+
end
699
+
else Format.printf "Next: Build your project in project/%s@." project
618
700
in
619
701
620
702
if solve then begin
621
703
(* Solve dependencies and merge all solved packages that are vendored *)
622
-
let pkg, project = match args with
623
-
| [pkg; project] -> pkg, project
704
+
let pkg, project =
705
+
match args with
706
+
| [ pkg; project ] -> (pkg, project)
624
707
| _ ->
625
708
Format.eprintf "Usage: unpac opam merge --solve PACKAGE PROJECT@.";
626
709
exit 1
627
710
in
628
711
let repos = config.opam.repositories in
629
712
if repos = [] then begin
630
-
Format.eprintf "No repositories configured. Add one with: unpac opam repo add <name> <path>@.";
713
+
Format.eprintf
714
+
"No repositories configured. Add one with: unpac opam repo add \
715
+
<name> <path>@.";
631
716
exit 1
632
717
end;
633
-
let ocaml_version = match Unpac.Config.get_compiler config with
718
+
let ocaml_version =
719
+
match Unpac.Config.get_compiler config with
634
720
| Some v -> v
635
721
| None ->
636
722
Format.eprintf "No compiler version configured.@.";
637
723
Format.eprintf "Set one with: unpac opam config compiler 5.2.0@.";
638
724
exit 1
639
725
in
640
-
let repo_paths = List.map (fun (r : Unpac.Config.repo_config) ->
641
-
match r.source with
642
-
| Unpac.Config.Local p -> p
643
-
| Unpac.Config.Remote u -> u
644
-
) repos in
726
+
let repo_paths =
727
+
List.map
728
+
(fun (r : Unpac.Config.repo_config) ->
729
+
match r.source with
730
+
| Unpac.Config.Local p -> p
731
+
| Unpac.Config.Remote u -> u)
732
+
repos
733
+
in
645
734
Format.printf "Solving dependencies for %s...@." pkg;
646
-
match Unpac_opam.Solver.solve ~repos:repo_paths ~ocaml_version ~packages:[pkg] with
735
+
match
736
+
Unpac_opam.Solver.solve ~repos:repo_paths ~ocaml_version
737
+
~packages:[ pkg ]
738
+
with
647
739
| Error msg ->
648
740
Format.eprintf "Dependency solving failed:@.%s@." msg;
649
741
exit 1
650
742
| Ok result ->
651
743
(* Group by dev-repo to get canonical names *)
652
744
let groups = group_packages_by_dev_repo ~config result.packages in
653
-
let canonical_names = List.map (fun (g : package_group) -> g.canonical_name) groups in
745
+
let canonical_names =
746
+
List.map (fun (g : package_group) -> g.canonical_name) groups
747
+
in
654
748
(* Filter to only vendored packages *)
655
749
let vendored = Unpac_opam.Opam.list_packages ~proc_mgr ~root in
656
-
let to_merge = List.filter (fun name -> List.mem name vendored) canonical_names in
750
+
let to_merge =
751
+
List.filter (fun name -> List.mem name vendored) canonical_names
752
+
in
657
753
if to_merge = [] then begin
658
-
Format.eprintf "No vendored packages match the solved dependencies.@.";
659
-
Format.eprintf "Run 'unpac opam add %s --solve' first to vendor them.@." pkg;
754
+
Format.eprintf
755
+
"No vendored packages match the solved dependencies.@.";
756
+
Format.eprintf
757
+
"Run 'unpac opam add %s --solve' first to vendor them.@." pkg;
660
758
exit 1
661
759
end;
662
-
Format.printf "Found %d vendored packages to merge.@.@." (List.length to_merge);
760
+
Format.printf "Found %d vendored packages to merge.@.@."
761
+
(List.length to_merge);
663
762
merge_packages to_merge project
664
-
end else if all then begin
763
+
end
764
+
else if all then begin
665
765
(* Merge all vendored packages *)
666
-
let project = match args with
667
-
| [project] -> project
766
+
let project =
767
+
match args with
768
+
| [ project ] -> project
668
769
| _ ->
669
770
Format.eprintf "Usage: unpac opam merge --all PROJECT@.";
670
771
exit 1
···
675
776
exit 1
676
777
end;
677
778
merge_packages packages project
678
-
end else begin
779
+
end
780
+
else begin
679
781
(* Single package mode *)
680
-
let pkg, project = match args with
681
-
| [pkg; project] -> pkg, project
782
+
let pkg, project =
783
+
match args with
784
+
| [ pkg; project ] -> (pkg, project)
682
785
| _ ->
683
786
Format.eprintf "Usage: unpac opam merge PACKAGE PROJECT@.";
684
787
exit 1
···
714
817
let remote = "origin-" ^ pkg in
715
818
let url = Unpac.Git.remote_url ~proc_mgr ~cwd:git remote in
716
819
Format.printf "Package: %s@." pkg;
717
-
(match url with
718
-
| Some u -> Format.printf "URL: %s@." u
719
-
| None -> ());
820
+
(match url with Some u -> Format.printf "URL: %s@." u | None -> ());
720
821
(* Get branch SHAs *)
721
822
let upstream = Unpac_opam.Opam.upstream_branch pkg in
722
823
let vendor = Unpac_opam.Opam.vendor_branch pkg in
723
824
let patches = Unpac_opam.Opam.patches_branch pkg in
724
825
(match Unpac.Git.rev_parse ~proc_mgr ~cwd:git upstream with
725
-
| Some sha -> Format.printf "Upstream: %s@." (String.sub sha 0 7)
726
-
| None -> ());
826
+
| Some sha -> Format.printf "Upstream: %s@." (String.sub sha 0 7)
827
+
| None -> ());
727
828
(match Unpac.Git.rev_parse ~proc_mgr ~cwd:git vendor with
728
-
| Some sha -> Format.printf "Vendor: %s@." (String.sub sha 0 7)
729
-
| None -> ());
829
+
| Some sha -> Format.printf "Vendor: %s@." (String.sub sha 0 7)
830
+
| None -> ());
730
831
(match Unpac.Git.rev_parse ~proc_mgr ~cwd:git patches with
731
-
| Some sha -> Format.printf "Patches: %s@." (String.sub sha 0 7)
732
-
| None -> ());
832
+
| Some sha -> Format.printf "Patches: %s@." (String.sub sha 0 7)
833
+
| None -> ());
733
834
(* Count commits ahead *)
734
-
let log_output = Unpac.Git.run_exn ~proc_mgr ~cwd:git
735
-
["log"; "--oneline"; vendor ^ ".." ^ patches] in
736
-
let commits = List.length (String.split_on_char '\n' log_output |>
737
-
List.filter (fun s -> String.trim s <> "")) in
835
+
let log_output =
836
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git
837
+
[ "log"; "--oneline"; vendor ^ ".." ^ patches ]
838
+
in
839
+
let commits =
840
+
List.length
841
+
(String.split_on_char '\n' log_output
842
+
|> List.filter (fun s -> String.trim s <> ""))
843
+
in
738
844
Format.printf "Local commits: %d@." commits;
739
845
Format.printf "@.Commands:@.";
740
846
Format.printf " unpac opam diff %s # view local changes@." pkg;
···
762
868
end;
763
869
let vendor = Unpac_opam.Opam.vendor_branch pkg in
764
870
let patches = Unpac_opam.Opam.patches_branch pkg in
765
-
let diff = Unpac.Git.run_exn ~proc_mgr ~cwd:git
766
-
["diff"; vendor; patches] in
871
+
let diff =
872
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git [ "diff"; vendor; patches ]
873
+
in
767
874
if String.trim diff = "" then begin
768
875
Format.printf "No local changes@.";
769
876
Format.printf "@.Hint: unpac opam edit %s # to make changes@." pkg
770
-
end else begin
877
+
end
878
+
else begin
771
879
print_string diff;
772
880
Format.printf "@.Next: unpac opam merge %s <project>@." pkg
773
881
end
···
792
900
exit 1
793
901
end;
794
902
(* Remove worktrees if exist *)
795
-
(try Unpac.Worktree.remove_force ~proc_mgr root (Unpac.Worktree.Opam_upstream pkg) with _ -> ());
796
-
(try Unpac.Worktree.remove_force ~proc_mgr root (Unpac.Worktree.Opam_vendor pkg) with _ -> ());
797
-
(try Unpac.Worktree.remove_force ~proc_mgr root (Unpac.Worktree.Opam_patches pkg) with _ -> ());
903
+
(try
904
+
Unpac.Worktree.remove_force ~proc_mgr root
905
+
(Unpac.Worktree.Opam_upstream pkg)
906
+
with _ -> ());
907
+
(try
908
+
Unpac.Worktree.remove_force ~proc_mgr root
909
+
(Unpac.Worktree.Opam_vendor pkg)
910
+
with _ -> ());
911
+
(try
912
+
Unpac.Worktree.remove_force ~proc_mgr root
913
+
(Unpac.Worktree.Opam_patches pkg)
914
+
with _ -> ());
798
915
(* Delete branches *)
799
916
let upstream = Unpac_opam.Opam.upstream_branch pkg in
800
917
let vendor = Unpac_opam.Opam.vendor_branch pkg in
801
918
let patches = Unpac_opam.Opam.patches_branch pkg in
802
-
(try Unpac.Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; upstream] |> ignore with _ -> ());
803
-
(try Unpac.Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; vendor] |> ignore with _ -> ());
804
-
(try Unpac.Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; patches] |> ignore with _ -> ());
919
+
(try
920
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git [ "branch"; "-D"; upstream ]
921
+
|> ignore
922
+
with _ -> ());
923
+
(try
924
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git [ "branch"; "-D"; vendor ] |> ignore
925
+
with _ -> ());
926
+
(try
927
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git [ "branch"; "-D"; patches ]
928
+
|> ignore
929
+
with _ -> ());
805
930
(* Remove remote *)
806
931
let remote = "origin-" ^ pkg in
807
-
(try Unpac.Git.run_exn ~proc_mgr ~cwd:git ["remote"; "remove"; remote] |> ignore with _ -> ());
932
+
(try
933
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git [ "remote"; "remove"; remote ]
934
+
|> ignore
935
+
with _ -> ());
808
936
Format.printf "Removed %s@." pkg;
809
-
Format.printf "@.Hint: unpac opam add <package> # to add another package@."
937
+
Format.printf
938
+
"@.Hint: unpac opam add <package> # to add another package@."
810
939
in
811
940
let info = Cmd.info "remove" ~doc in
812
941
Cmd.v info Term.(const run $ logging_term $ pkg_arg)
···
815
944
let opam_cmd =
816
945
let doc = "Opam package vendoring commands." in
817
946
let info = Cmd.info "opam" ~doc in
818
-
Cmd.group info [
819
-
opam_repo_cmd;
820
-
opam_config_cmd;
821
-
opam_add_cmd;
822
-
opam_list_cmd;
823
-
opam_edit_cmd;
824
-
opam_done_cmd;
825
-
opam_update_cmd;
826
-
opam_merge_cmd;
827
-
opam_info_cmd;
828
-
opam_diff_cmd;
829
-
opam_remove_cmd;
830
-
]
947
+
Cmd.group info
948
+
[
949
+
opam_repo_cmd;
950
+
opam_config_cmd;
951
+
opam_add_cmd;
952
+
opam_list_cmd;
953
+
opam_edit_cmd;
954
+
opam_done_cmd;
955
+
opam_update_cmd;
956
+
opam_merge_cmd;
957
+
opam_info_cmd;
958
+
opam_diff_cmd;
959
+
opam_remove_cmd;
960
+
]
831
961
832
962
(* Push command - push all unpac branches to a remote *)
833
963
let push_cmd =
···
838
968
in
839
969
let force_arg =
840
970
let doc = "Force push (use with caution)." in
841
-
Arg.(value & flag & info ["f"; "force"] ~doc)
971
+
Arg.(value & flag & info [ "f"; "force" ] ~doc)
842
972
in
843
973
let dry_run_arg =
844
974
let doc = "Show what would be pushed without actually pushing." in
845
-
Arg.(value & flag & info ["n"; "dry-run"] ~doc)
975
+
Arg.(value & flag & info [ "n"; "dry-run" ] ~doc)
846
976
in
847
977
let run () remote force dry_run =
848
978
with_root @@ fun ~env:_ ~fs:_ ~proc_mgr ~root ->
···
850
980
851
981
(* Check if remote exists *)
852
982
(match Unpac.Git.remote_url ~proc_mgr ~cwd:git remote with
853
-
| None ->
854
-
Format.eprintf "Remote '%s' not configured.@." remote;
855
-
Format.eprintf "Add it with: git -C %s remote add %s <url>@." (snd git) remote;
856
-
exit 1
857
-
| Some _ -> ());
983
+
| None ->
984
+
Format.eprintf "Remote '%s' not configured.@." remote;
985
+
Format.eprintf "Add it with: git -C %s remote add %s <url>@." (snd git)
986
+
remote;
987
+
exit 1
988
+
| Some _ -> ());
858
989
859
990
(* Get all branches *)
860
-
let all_branches = Unpac.Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--format=%(refname:short)"] in
991
+
let all_branches =
992
+
Unpac.Git.run_lines ~proc_mgr ~cwd:git
993
+
[ "branch"; "--format=%(refname:short)" ]
994
+
in
861
995
862
996
(* Filter to only unpac-managed branches *)
863
-
let unpac_branches = List.filter (fun b ->
864
-
b = "main" ||
865
-
String.starts_with ~prefix:"opam/" b ||
866
-
String.starts_with ~prefix:"project/" b
867
-
) all_branches in
997
+
let unpac_branches =
998
+
List.filter
999
+
(fun b ->
1000
+
b = "main"
1001
+
|| String.starts_with ~prefix:"opam/" b
1002
+
|| String.starts_with ~prefix:"project/" b)
1003
+
all_branches
1004
+
in
868
1005
869
1006
if unpac_branches = [] then begin
870
1007
Format.printf "No branches to push@.";
···
877
1014
878
1015
if dry_run then begin
879
1016
Format.printf "(dry run - no changes made)@."
880
-
end else begin
1017
+
end
1018
+
else begin
881
1019
(* Build push command *)
882
-
let force_flag = if force then ["--force"] else [] in
883
-
let push_args = ["push"] @ force_flag @ [remote; "--"] @ unpac_branches in
1020
+
let force_flag = if force then [ "--force" ] else [] in
1021
+
let push_args =
1022
+
[ "push" ] @ force_flag @ [ remote; "--" ] @ unpac_branches
1023
+
in
884
1024
885
1025
Format.printf "Pushing %d branches...@." (List.length unpac_branches);
886
1026
try
···
892
1032
end
893
1033
in
894
1034
let info = Cmd.info "push" ~doc in
895
-
Cmd.v info Term.(const run $ logging_term $ remote_arg $ force_arg $ dry_run_arg)
1035
+
Cmd.v info
1036
+
Term.(const run $ logging_term $ remote_arg $ force_arg $ dry_run_arg)
896
1037
897
1038
(* Vendor status command *)
898
1039
let vendor_status_cmd =
···
909
1050
end;
910
1051
911
1052
(* Get all project branches *)
912
-
let all_branches = Unpac.Git.run_lines ~proc_mgr ~cwd:git
913
-
["branch"; "--format=%(refname:short)"] in
914
-
let project_branches = List.filter (fun b ->
915
-
String.starts_with ~prefix:"project/" b
916
-
) all_branches in
917
-
let project_names = List.map (fun b ->
918
-
String.sub b 8 (String.length b - 8) (* Remove "project/" prefix *)
919
-
) project_branches in
1053
+
let all_branches =
1054
+
Unpac.Git.run_lines ~proc_mgr ~cwd:git
1055
+
[ "branch"; "--format=%(refname:short)" ]
1056
+
in
1057
+
let project_branches =
1058
+
List.filter
1059
+
(fun b -> String.starts_with ~prefix:"project/" b)
1060
+
all_branches
1061
+
in
1062
+
let project_names =
1063
+
List.map
1064
+
(fun b ->
1065
+
String.sub b 8 (String.length b - 8) (* Remove "project/" prefix *))
1066
+
project_branches
1067
+
in
920
1068
921
1069
(* Print header *)
922
1070
Format.printf "%-25s %8s %s@." "Package" "Patches" "Merged into";
923
1071
Format.printf "%s@." (String.make 70 '-');
924
1072
925
1073
(* For each package, get patch count and merge status *)
926
-
List.iter (fun pkg ->
927
-
let vendor_branch = Unpac_opam.Opam.vendor_branch pkg in
928
-
let patches_branch = Unpac_opam.Opam.patches_branch pkg in
1074
+
List.iter
1075
+
(fun pkg ->
1076
+
let vendor_branch = Unpac_opam.Opam.vendor_branch pkg in
1077
+
let patches_branch = Unpac_opam.Opam.patches_branch pkg in
929
1078
930
-
(* Count commits on patches that aren't on vendor *)
931
-
let patch_count =
932
-
let output = Unpac.Git.run_exn ~proc_mgr ~cwd:git
933
-
["rev-list"; "--count"; vendor_branch ^ ".." ^ patches_branch] in
934
-
int_of_string (String.trim output)
935
-
in
1079
+
(* Count commits on patches that aren't on vendor *)
1080
+
let patch_count =
1081
+
let output =
1082
+
Unpac.Git.run_exn ~proc_mgr ~cwd:git
1083
+
[ "rev-list"; "--count"; vendor_branch ^ ".." ^ patches_branch ]
1084
+
in
1085
+
int_of_string (String.trim output)
1086
+
in
936
1087
937
-
(* Check which projects contain this package's patches *)
938
-
let merged_into = List.filter (fun proj_name ->
939
-
let proj_branch = "project/" ^ proj_name in
940
-
(* Check if patches branch is an ancestor of project branch *)
941
-
match Unpac.Git.run ~proc_mgr ~cwd:git
942
-
["merge-base"; "--is-ancestor"; patches_branch; proj_branch] with
943
-
| Ok _ -> true
944
-
| Error _ -> false
945
-
) project_names in
1088
+
(* Check which projects contain this package's patches *)
1089
+
let merged_into =
1090
+
List.filter
1091
+
(fun proj_name ->
1092
+
let proj_branch = "project/" ^ proj_name in
1093
+
(* Check if patches branch is an ancestor of project branch *)
1094
+
match
1095
+
Unpac.Git.run ~proc_mgr ~cwd:git
1096
+
[ "merge-base"; "--is-ancestor"; patches_branch; proj_branch ]
1097
+
with
1098
+
| Ok _ -> true
1099
+
| Error _ -> false)
1100
+
project_names
1101
+
in
946
1102
947
-
let merged_str = if merged_into = [] then "-"
948
-
else String.concat ", " merged_into in
1103
+
let merged_str =
1104
+
if merged_into = [] then "-" else String.concat ", " merged_into
1105
+
in
949
1106
950
-
Format.printf "%-25s %8d %s@." pkg patch_count merged_str
951
-
) packages;
1107
+
Format.printf "%-25s %8d %s@." pkg patch_count merged_str)
1108
+
packages;
952
1109
953
1110
Format.printf "@.Total: %d packages@." (List.length packages)
954
1111
in
···
959
1116
let vendor_cmd =
960
1117
let doc = "Vendor status and management commands." in
961
1118
let info = Cmd.info "vendor" ~doc in
962
-
Cmd.group info [vendor_status_cmd]
1119
+
Cmd.group info [ vendor_status_cmd ]
963
1120
964
1121
(* Main command *)
965
1122
let main_cmd =
966
1123
let doc = "Multi-backend vendoring tool using git worktrees." in
967
1124
let info = Cmd.info "unpac" ~version:"0.1.0" ~doc in
968
-
Cmd.group info [init_cmd; project_cmd; opam_cmd; vendor_cmd; push_cmd]
1125
+
Cmd.group info [ init_cmd; project_cmd; opam_cmd; vendor_cmd; push_cmd ]
969
1126
970
1127
let () = exit (Cmd.eval main_cmd)
+5
dune
+5
dune
+20
-8
dune-project
+20
-8
dune-project
···
1
1
(lang dune 3.20)
2
+
2
3
(name unpac)
4
+
3
5
(generate_opam_files true)
4
6
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy")
9
+
(homepage "https://tangled.org/@anil.recoil.org/unpac")
10
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
+
(bug_reports "https://tangled.org/@anil.recoil.org/unpac/issues")
12
+
(maintenance_intent "(latest)")
13
+
5
14
(package
6
15
(name unpac)
7
16
(synopsis "Monorepo management tool")
8
-
(description "A tool for managing OCaml monorepos with opam repository integration")
9
-
(authors "Anil Madhavapeddy")
10
-
(license ISC)
17
+
(description
18
+
"A tool for managing OCaml monorepos with opam repository integration. \
19
+
Unpac handles vendoring dependencies, managing worktrees, and \
20
+
synchronizing packages across a monorepo.")
11
21
(depends
12
22
(ocaml (>= 5.1.0))
13
23
(eio_main (>= 1.0))
14
24
(logs (>= 0.7.0))
15
25
(fmt (>= 0.9.0))
16
-
tomlt))
26
+
tomlt
27
+
(odoc :with-doc)))
17
28
18
29
(package
19
30
(name unpac-opam)
20
31
(synopsis "Opam backend for unpac")
21
-
(description "Opam package vendoring backend for unpac")
22
-
(authors "Anil Madhavapeddy")
23
-
(license ISC)
32
+
(description
33
+
"Opam package vendoring backend for unpac. \
34
+
Provides opam repository integration for dependency resolution and vendoring.")
24
35
(depends
25
36
(ocaml (>= 5.1.0))
26
37
unpac
···
28
39
opam-core
29
40
opam-state
30
41
opam-0install
31
-
(cmdliner (>= 1.2.0))))
42
+
(cmdliner (>= 1.2.0))
43
+
(odoc :with-doc)))
+16
-21
lib/backend.ml
+16
-21
lib/backend.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Backend module signature for package managers.
2
7
3
8
Each backend (opam, cargo, etc.) implements this interface to provide
···
31
36
(** {2 Branch Naming} *)
32
37
33
38
val upstream_branch : string -> string
34
-
(** [upstream_branch pkg] returns branch name, e.g. "opam/upstream/astring". *)
39
+
(** [upstream_branch pkg] returns branch name, e.g. "opam/upstream/astring".
40
+
*)
35
41
36
42
val vendor_branch : string -> string
37
43
(** [vendor_branch pkg] returns branch name, e.g. "opam/vendor/astring". *)
···
51
57
(** {2 Package Operations} *)
52
58
53
59
val add_package :
54
-
proc_mgr:Git.proc_mgr ->
55
-
root:Worktree.root ->
56
-
package_info ->
57
-
add_result
60
+
proc_mgr:Git.proc_mgr -> root:Worktree.root -> package_info -> add_result
58
61
(** [add_package ~proc_mgr ~root info] vendors a single package.
59
62
60
-
1. Creates/updates opam/upstream/<pkg> from URL
61
-
2. Creates opam/vendor/<pkg> orphan with vendor/ prefix
62
-
3. Creates opam/patches/<pkg> from vendor *)
63
+
1. Creates/updates opam/upstream/<pkg> from URL 2. Creates
64
+
opam/vendor/<pkg> orphan with vendor/ prefix 3. Creates opam/patches/<pkg>
65
+
from vendor *)
63
66
64
67
val update_package :
65
-
proc_mgr:Git.proc_mgr ->
66
-
root:Worktree.root ->
67
-
string ->
68
-
update_result
68
+
proc_mgr:Git.proc_mgr -> root:Worktree.root -> string -> update_result
69
69
(** [update_package ~proc_mgr ~root name] updates a package from upstream.
70
70
71
-
1. Fetches latest into opam/upstream/<pkg>
72
-
2. Updates opam/vendor/<pkg> with new content
73
-
Does NOT rebase patches - that's a separate operation. *)
71
+
1. Fetches latest into opam/upstream/<pkg> 2. Updates opam/vendor/<pkg>
72
+
with new content Does NOT rebase patches - that's a separate operation. *)
74
73
75
-
val list_packages :
76
-
proc_mgr:Git.proc_mgr ->
77
-
root:Worktree.root ->
78
-
string list
74
+
val list_packages : proc_mgr:Git.proc_mgr -> root:Worktree.root -> string list
79
75
(** [list_packages ~proc_mgr root] returns all vendored package names. *)
80
76
end
81
77
···
85
81
86
82
let merge_to_project ~proc_mgr ~root ~project ~patches_branch =
87
83
let project_wt = Worktree.path root (Worktree.Project project) in
88
-
Git.merge_allow_unrelated ~proc_mgr ~cwd:project_wt
89
-
~branch:patches_branch
84
+
Git.merge_allow_unrelated ~proc_mgr ~cwd:project_wt ~branch:patches_branch
90
85
~message:(Printf.sprintf "Merge %s" patches_branch)
91
86
92
87
let rebase_patches ~proc_mgr ~root ~patches_kind ~onto =
+23
-37
lib/config.ml
+23
-37
lib/config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Configuration file handling for unpac.
2
7
3
8
Loads and parses main/unpac.toml configuration files. *)
4
9
5
10
(** {1 Types} *)
6
11
7
-
type repo_source =
8
-
| Local of string
9
-
| Remote of string
10
-
11
-
type repo_config = {
12
-
repo_name : string;
13
-
source : repo_source;
14
-
}
15
-
16
-
type opam_config = {
17
-
repositories : repo_config list;
18
-
compiler : string option;
19
-
}
20
-
21
-
type project_config = {
22
-
project_name : string;
23
-
}
12
+
type repo_source = Local of string | Remote of string
13
+
type repo_config = { repo_name : string; source : repo_source }
14
+
type opam_config = { repositories : repo_config list; compiler : string option }
15
+
type project_config = { project_name : string }
24
16
25
17
type t = {
26
18
opam : opam_config;
···
60
52
let open Tomlt in
61
53
let open Table in
62
54
obj (fun repositories compiler : opam_config -> { repositories; compiler })
63
-
|> mem "repositories" (list repo_config_codec)
64
-
~enc:(fun (c : opam_config) -> c.repositories)
55
+
|> mem "repositories" (list repo_config_codec) ~enc:(fun (c : opam_config) ->
56
+
c.repositories)
65
57
|> opt_mem "compiler" string ~enc:(fun (c : opam_config) -> c.compiler)
66
58
|> finish
67
59
···
87
79
| Sys_error msg -> Error msg
88
80
| Failure msg -> Error msg
89
81
90
-
let load_exn path =
91
-
match load path with Ok c -> c | Error msg -> failwith msg
82
+
let load_exn path = match load path with Ok c -> c | Error msg -> failwith msg
92
83
93
84
(** {1 Saving} *)
94
85
···
96
87
try
97
88
let content = Tomlt_bytesrw.encode_string codec config in
98
89
Out_channel.with_open_text path (fun oc ->
99
-
Out_channel.output_string oc content);
90
+
Out_channel.output_string oc content);
100
91
Ok ()
101
92
with
102
93
| Sys_error msg -> Error msg
103
94
| Failure msg -> Error msg
104
95
105
96
let save_exn path config =
106
-
match save path config with
107
-
| Ok () -> ()
108
-
| Error msg -> failwith msg
97
+
match save path config with Ok () -> () | Error msg -> failwith msg
109
98
110
99
(** {1 Helpers} *)
111
100
···
116
105
List.find_opt (fun p -> p.project_name = name) config.projects
117
106
118
107
let add_repo config repo =
119
-
let repos = config.opam.repositories @ [repo] in
108
+
let repos = config.opam.repositories @ [ repo ] in
120
109
{ config with opam = { config.opam with repositories = repos } }
121
110
122
111
let remove_repo config name =
123
-
let repos = List.filter (fun r -> r.repo_name <> name) config.opam.repositories in
112
+
let repos =
113
+
List.filter (fun r -> r.repo_name <> name) config.opam.repositories
114
+
in
124
115
{ config with opam = { config.opam with repositories = repos } }
125
116
126
117
let find_repo config name =
···
129
120
let set_compiler config version =
130
121
{ config with opam = { config.opam with compiler = Some version } }
131
122
132
-
let get_compiler config =
133
-
config.opam.compiler
134
-
135
-
let set_vendor_cache config path =
136
-
{ config with vendor_cache = Some path }
137
-
138
-
let get_vendor_cache config =
139
-
config.vendor_cache
123
+
let get_compiler config = config.opam.compiler
124
+
let set_vendor_cache config path = { config with vendor_cache = Some path }
125
+
let get_vendor_cache config = config.vendor_cache
140
126
141
127
let resolve_vendor_cache ?cli_override config =
142
128
(* Priority: CLI flag > env var > config file > default *)
143
129
match cli_override with
144
130
| Some path -> Some path
145
-
| None ->
131
+
| None -> (
146
132
match Sys.getenv_opt "UNPAC_VENDOR_CACHE" with
147
133
| Some path -> Some path
148
-
| None -> config.vendor_cache
134
+
| None -> config.vendor_cache)
+11
-19
lib/config.mli
+11
-19
lib/config.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Configuration file handling for unpac.
2
7
3
8
Loads and parses main/unpac.toml configuration files. *)
4
9
5
10
(** {1 Types} *)
6
11
7
-
type repo_source =
8
-
| Local of string
9
-
| Remote of string
10
-
11
-
type repo_config = {
12
-
repo_name : string;
13
-
source : repo_source;
14
-
}
15
-
16
-
type opam_config = {
17
-
repositories : repo_config list;
18
-
compiler : string option;
19
-
}
20
-
21
-
type project_config = {
22
-
project_name : string;
23
-
}
12
+
type repo_source = Local of string | Remote of string
13
+
type repo_config = { repo_name : string; source : repo_source }
14
+
type opam_config = { repositories : repo_config list; compiler : string option }
15
+
type project_config = { project_name : string }
24
16
25
17
type t = {
26
18
opam : opam_config;
···
75
67
76
68
val resolve_vendor_cache : ?cli_override:string -> t -> string option
77
69
(** [resolve_vendor_cache ?cli_override config] resolves vendor cache path.
78
-
Priority: CLI flag > UNPAC_VENDOR_CACHE env var > config file.
79
-
Returns None if not configured anywhere. *)
70
+
Priority: CLI flag > UNPAC_VENDOR_CACHE env var > config file. Returns None
71
+
if not configured anywhere. *)
80
72
81
73
(** {1 Codecs} *)
82
74
+1
-8
lib/dune
+1
-8
lib/dune
+175
-144
lib/git.ml
+175
-144
lib/git.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Git operations wrapped with Eio and robust error handling. *)
2
7
3
8
let src = Logs.Src.create "unpac.git" ~doc:"Git operations"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
12
(* Error types *)
···
26
32
let pp_error fmt = function
27
33
| Command_failed { cmd; exit_code; stderr; _ } ->
28
34
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
35
+
Fmt.(list ~sep:sp string)
36
+
cmd exit_code (String.trim stderr)
37
+
| Not_a_repository -> Format.fprintf fmt "not a git repository"
38
+
| Remote_exists name -> Format.fprintf fmt "remote '%s' already exists" name
39
+
| Remote_not_found name -> Format.fprintf fmt "remote '%s' not found" name
40
+
| Branch_exists name -> Format.fprintf fmt "branch '%s' already exists" name
41
+
| Branch_not_found name -> Format.fprintf fmt "branch '%s' not found" name
41
42
| Merge_conflict { branch; conflicting_files } ->
42
43
Format.fprintf fmt "merge conflict in '%s': %a" branch
43
-
Fmt.(list ~sep:comma string) conflicting_files
44
+
Fmt.(list ~sep:comma string)
45
+
conflicting_files
44
46
| Rebase_conflict { onto; hint } ->
45
47
Format.fprintf fmt "rebase conflict onto '%s': %s" onto hint
46
48
| Uncommitted_changes ->
47
49
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"
50
+
| Not_on_branch -> Format.fprintf fmt "not on any branch"
51
+
| Detached_head -> Format.fprintf fmt "HEAD is detached"
52
52
53
53
type Eio.Exn.err += E of error
54
54
55
55
let () =
56
56
Eio.Exn.register_pp (fun fmt -> function
57
-
| E e -> Format.fprintf fmt "Git %a" pp_error e; true
57
+
| E e ->
58
+
Format.fprintf fmt "Git %a" pp_error e;
59
+
true
58
60
| _ -> false)
59
61
60
62
let err e = Eio.Exn.create (E e)
···
69
71
let string_trim s = String.trim s
70
72
71
73
let lines s =
72
-
String.split_on_char '\n' s
73
-
|> List.filter (fun s -> String.trim s <> "")
74
+
String.split_on_char '\n' s |> List.filter (fun s -> String.trim s <> "")
74
75
75
76
(* Low-level execution *)
76
77
···
83
84
Eio.Switch.run @@ fun sw ->
84
85
let stdout_r, stdout_w = Eio.Process.pipe proc_mgr ~sw in
85
86
let stderr_r, stderr_w = Eio.Process.pipe proc_mgr ~sw in
86
-
let child = Eio.Process.spawn proc_mgr ~sw
87
+
let child =
88
+
Eio.Process.spawn proc_mgr ~sw
87
89
?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
+
~stdout:stdout_w ~stderr:stderr_w full_cmd
90
91
in
91
92
Eio.Flow.close stdout_w;
92
93
Eio.Flow.close stderr_w;
93
94
(* Read stdout and stderr concurrently *)
94
95
Eio.Fiber.both
95
96
(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 ())
97
+
let chunk = Cstruct.create 4096 in
98
+
let rec loop () =
99
+
match Eio.Flow.single_read stdout_r chunk with
100
+
| n ->
101
+
Buffer.add_string stdout_buf
102
+
(Cstruct.to_string (Cstruct.sub chunk 0 n));
103
+
loop ()
104
+
| exception End_of_file -> ()
105
+
in
106
+
loop ())
105
107
(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 ());
108
+
let chunk = Cstruct.create 4096 in
109
+
let rec loop () =
110
+
match Eio.Flow.single_read stderr_r chunk with
111
+
| n ->
112
+
Buffer.add_string stderr_buf
113
+
(Cstruct.to_string (Cstruct.sub chunk 0 n));
114
+
loop ()
115
+
| exception End_of_file -> ()
116
+
in
117
+
loop ());
115
118
let status = Eio.Process.await child in
116
119
let stdout = Buffer.contents stdout_buf in
117
120
let stderr = Buffer.contents stderr_buf in
118
121
match status with
119
-
| `Exited 0 ->
120
-
Log.debug (fun m -> m "Output: %s" (string_trim stdout));
121
-
Ok stdout
122
-
| `Exited code ->
123
-
Log.debug (fun m -> m "Failed (exit %d): %s" code (string_trim stderr));
124
-
Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
125
-
| `Signaled signal ->
126
-
Log.debug (fun m -> m "Killed by signal %d" signal);
127
-
let code = 128 + signal in
128
-
Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
122
+
| `Exited 0 ->
123
+
Log.debug (fun m -> m "Output: %s" (string_trim stdout));
124
+
Ok stdout
125
+
| `Exited code ->
126
+
Log.debug (fun m -> m "Failed (exit %d): %s" code (string_trim stderr));
127
+
Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
128
+
| `Signaled signal ->
129
+
Log.debug (fun m -> m "Killed by signal %d" signal);
130
+
let code = 128 + signal in
131
+
Error (Command_failed { cmd = args; exit_code = code; stdout; stderr })
129
132
with exn ->
130
133
Log.err (fun m -> m "Exception running git: %a" Fmt.exn exn);
131
134
raise exn
···
135
138
| Ok output -> output
136
139
| Error e ->
137
140
let ex = err e in
138
-
raise (Eio.Exn.add_context ex "running git %a" Fmt.(list ~sep:sp string) args)
141
+
raise
142
+
(Eio.Exn.add_context ex "running git %a" Fmt.(list ~sep:sp string) args)
139
143
140
144
let run_lines ~proc_mgr ?cwd args =
141
145
run_exn ~proc_mgr ?cwd args |> string_trim |> lines
···
145
149
let is_repository path =
146
150
let git_dir = Eio.Path.(path / ".git") in
147
151
match Eio.Path.kind ~follow:false git_dir with
148
-
| `Directory | `Regular_file -> true (* .git can be a file for worktrees *)
152
+
| `Directory | `Regular_file -> true (* .git can be a file for worktrees *)
149
153
| _ -> false
150
154
| exception _ -> false
151
155
152
156
let current_branch ~proc_mgr ~cwd =
153
-
match run ~proc_mgr ~cwd ["symbolic-ref"; "--short"; "HEAD"] with
157
+
match run ~proc_mgr ~cwd [ "symbolic-ref"; "--short"; "HEAD" ] with
154
158
| Ok output -> Some (string_trim output)
155
159
| Error _ -> None
156
160
···
160
164
| None -> raise (err Not_on_branch)
161
165
162
166
let current_head ~proc_mgr ~cwd =
163
-
run_exn ~proc_mgr ~cwd ["rev-parse"; "HEAD"] |> string_trim
167
+
run_exn ~proc_mgr ~cwd [ "rev-parse"; "HEAD" ] |> string_trim
164
168
165
169
let has_uncommitted_changes ~proc_mgr ~cwd =
166
-
let status = run_exn ~proc_mgr ~cwd ["status"; "--porcelain"] in
170
+
let status = run_exn ~proc_mgr ~cwd [ "status"; "--porcelain" ] in
167
171
String.trim status <> ""
168
172
169
173
let remote_exists ~proc_mgr ~cwd name =
170
-
match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
174
+
match run ~proc_mgr ~cwd [ "remote"; "get-url"; name ] with
171
175
| Ok _ -> true
172
176
| Error _ -> false
173
177
174
178
let branch_exists ~proc_mgr ~cwd name =
175
-
match run ~proc_mgr ~cwd ["show-ref"; "--verify"; "--quiet"; "refs/heads/" ^ name] with
179
+
match
180
+
run ~proc_mgr ~cwd
181
+
[ "show-ref"; "--verify"; "--quiet"; "refs/heads/" ^ name ]
182
+
with
176
183
| Ok _ -> true
177
184
| Error _ -> false
178
185
179
186
let rev_parse ~proc_mgr ~cwd ref_ =
180
-
match run ~proc_mgr ~cwd ["rev-parse"; "--verify"; "--quiet"; ref_] with
187
+
match run ~proc_mgr ~cwd [ "rev-parse"; "--verify"; "--quiet"; ref_ ] with
181
188
| Ok output -> Some (string_trim output)
182
189
| Error _ -> None
183
190
···
187
194
| None -> raise (err (Branch_not_found ref_))
188
195
189
196
let rev_parse_short ~proc_mgr ~cwd ref_ =
190
-
run_exn ~proc_mgr ~cwd ["rev-parse"; "--short"; ref_] |> string_trim
197
+
run_exn ~proc_mgr ~cwd [ "rev-parse"; "--short"; ref_ ] |> string_trim
191
198
192
199
let ls_remote_default_branch ~proc_mgr ~cwd ~url =
193
200
Log.info (fun m -> m "Detecting default branch for %s..." url);
194
201
(* Try to get the default branch from the remote *)
195
-
let output = run_exn ~proc_mgr ~cwd ["ls-remote"; "--symref"; url; "HEAD"] in
202
+
let output =
203
+
run_exn ~proc_mgr ~cwd [ "ls-remote"; "--symref"; url; "HEAD" ]
204
+
in
196
205
(* Parse output like: ref: refs/heads/main\tHEAD *)
197
206
let default =
198
207
let lines = String.split_on_char '\n' output in
199
-
List.find_map (fun line ->
200
-
if String.starts_with ~prefix:"ref:" line then
201
-
let parts = String.split_on_char '\t' line in
202
-
match parts with
203
-
| ref_part :: _ ->
204
-
let ref_part = String.trim ref_part in
205
-
if String.starts_with ~prefix:"ref: refs/heads/" ref_part then
206
-
Some (String.sub ref_part 16 (String.length ref_part - 16))
207
-
else None
208
-
| _ -> None
209
-
else None
210
-
) lines
208
+
List.find_map
209
+
(fun line ->
210
+
if String.starts_with ~prefix:"ref:" line then
211
+
let parts = String.split_on_char '\t' line in
212
+
match parts with
213
+
| ref_part :: _ ->
214
+
let ref_part = String.trim ref_part in
215
+
if String.starts_with ~prefix:"ref: refs/heads/" ref_part then
216
+
Some (String.sub ref_part 16 (String.length ref_part - 16))
217
+
else None
218
+
| _ -> None
219
+
else None)
220
+
lines
211
221
in
212
222
match default with
213
223
| Some branch ->
···
215
225
branch
216
226
| None ->
217
227
(* Fallback: try common branch names *)
218
-
Log.debug (fun m -> m "Could not detect default branch, trying common names...");
228
+
Log.debug (fun m ->
229
+
m "Could not detect default branch, trying common names...");
219
230
let try_branch name =
220
-
match run ~proc_mgr ~cwd ["ls-remote"; "--heads"; url; name] with
231
+
match run ~proc_mgr ~cwd [ "ls-remote"; "--heads"; url; name ] with
221
232
| Ok output when String.trim output <> "" -> true
222
233
| _ -> false
223
234
in
···
228
239
"main"
229
240
end
230
241
231
-
let list_remotes ~proc_mgr ~cwd =
232
-
run_lines ~proc_mgr ~cwd ["remote"]
242
+
let list_remotes ~proc_mgr ~cwd = run_lines ~proc_mgr ~cwd [ "remote" ]
233
243
234
244
let remote_url ~proc_mgr ~cwd name =
235
-
match run ~proc_mgr ~cwd ["remote"; "get-url"; name] with
245
+
match run ~proc_mgr ~cwd [ "remote"; "get-url"; name ] with
236
246
| Ok output -> Some (string_trim output)
237
247
| Error _ -> None
238
248
239
249
let log_oneline ~proc_mgr ~cwd ?max_count from_ref to_ref =
240
250
let range = from_ref ^ ".." ^ to_ref in
241
-
let args = ["log"; "--oneline"; range] in
242
-
let args = match max_count with
243
-
| Some n -> args @ ["--max-count"; string_of_int n]
251
+
let args = [ "log"; "--oneline"; range ] in
252
+
let args =
253
+
match max_count with
254
+
| Some n -> args @ [ "--max-count"; string_of_int n ]
244
255
| None -> args
245
256
in
246
257
run_lines ~proc_mgr ~cwd args
247
258
248
259
let diff_stat ~proc_mgr ~cwd from_ref to_ref =
249
260
let range = from_ref ^ ".." ^ to_ref in
250
-
run_exn ~proc_mgr ~cwd ["diff"; "--stat"; range]
261
+
run_exn ~proc_mgr ~cwd [ "diff"; "--stat"; range ]
251
262
252
263
let ls_tree ~proc_mgr ~cwd ~tree ~path =
253
-
match run ~proc_mgr ~cwd ["ls-tree"; tree; path] with
264
+
match run ~proc_mgr ~cwd [ "ls-tree"; tree; path ] with
254
265
| Ok output -> String.trim output <> ""
255
266
| Error _ -> false
256
267
257
268
let rev_list_count ~proc_mgr ~cwd from_ref to_ref =
258
269
let range = from_ref ^ ".." ^ to_ref in
259
-
let output = run_exn ~proc_mgr ~cwd ["rev-list"; "--count"; range] in
270
+
let output = run_exn ~proc_mgr ~cwd [ "rev-list"; "--count"; range ] in
260
271
int_of_string (string_trim output)
261
272
262
273
(* Idempotent mutations *)
···
265
276
match remote_url ~proc_mgr ~cwd name with
266
277
| None ->
267
278
Log.info (fun m -> m "Adding remote %s -> %s" name url);
268
-
run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore;
279
+
run_exn ~proc_mgr ~cwd [ "remote"; "add"; name; url ] |> ignore;
269
280
`Created
270
281
| Some existing_url ->
271
282
if existing_url = url then begin
272
283
Log.debug (fun m -> m "Remote %s already exists with correct URL" name);
273
284
`Existed
274
-
end else begin
275
-
Log.info (fun m -> m "Updating remote %s URL: %s -> %s" name existing_url url);
276
-
run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore;
285
+
end
286
+
else begin
287
+
Log.info (fun m ->
288
+
m "Updating remote %s URL: %s -> %s" name existing_url url);
289
+
run_exn ~proc_mgr ~cwd [ "remote"; "set-url"; name; url ] |> ignore;
277
290
`Updated
278
291
end
279
292
···
281
294
if branch_exists ~proc_mgr ~cwd name then begin
282
295
Log.debug (fun m -> m "Branch %s already exists" name);
283
296
`Existed
284
-
end else begin
297
+
end
298
+
else begin
285
299
Log.info (fun m -> m "Creating branch %s at %s" name start_point);
286
-
run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore;
300
+
run_exn ~proc_mgr ~cwd [ "branch"; name; start_point ] |> ignore;
287
301
`Created
288
302
end
289
303
···
291
305
292
306
let init ~proc_mgr ~cwd =
293
307
Log.info (fun m -> m "Initializing git repository...");
294
-
run_exn ~proc_mgr ~cwd ["init"] |> ignore
308
+
run_exn ~proc_mgr ~cwd [ "init" ] |> ignore
295
309
296
310
let fetch ~proc_mgr ~cwd ~remote =
297
311
Log.info (fun m -> m "Fetching from %s..." remote);
298
-
run_exn ~proc_mgr ~cwd ["fetch"; remote] |> ignore
312
+
run_exn ~proc_mgr ~cwd [ "fetch"; remote ] |> ignore
299
313
300
314
let checkout ~proc_mgr ~cwd ref_ =
301
315
Log.debug (fun m -> m "Checking out %s" ref_);
302
-
run_exn ~proc_mgr ~cwd ["checkout"; ref_] |> ignore
316
+
run_exn ~proc_mgr ~cwd [ "checkout"; ref_ ] |> ignore
303
317
304
318
let checkout_orphan ~proc_mgr ~cwd name =
305
319
Log.info (fun m -> m "Creating orphan branch %s" name);
306
-
run_exn ~proc_mgr ~cwd ["checkout"; "--orphan"; name] |> ignore
320
+
run_exn ~proc_mgr ~cwd [ "checkout"; "--orphan"; name ] |> ignore
307
321
308
322
let read_tree_prefix ~proc_mgr ~cwd ~prefix ~tree =
309
323
Log.debug (fun m -> m "Reading tree %s with prefix %s" tree prefix);
310
-
run_exn ~proc_mgr ~cwd ["read-tree"; "--prefix=" ^ prefix; tree] |> ignore
324
+
run_exn ~proc_mgr ~cwd [ "read-tree"; "--prefix=" ^ prefix; tree ] |> ignore
311
325
312
326
let checkout_index ~proc_mgr ~cwd =
313
327
Log.debug (fun m -> m "Checking out index to working directory");
314
-
run_exn ~proc_mgr ~cwd ["checkout-index"; "-a"; "-f"] |> ignore
328
+
run_exn ~proc_mgr ~cwd [ "checkout-index"; "-a"; "-f" ] |> ignore
315
329
316
330
let rm_rf ~proc_mgr ~cwd ~target =
317
331
Log.debug (fun m -> m "Removing %s from git" target);
318
332
(* Ignore errors - target might not exist *)
319
-
ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; target])
333
+
ignore (run ~proc_mgr ~cwd [ "rm"; "-rf"; target ])
320
334
321
335
let rm_cached_rf ~proc_mgr ~cwd =
322
336
Log.debug (fun m -> m "Removing all files from index");
323
337
(* Ignore errors - index might be empty *)
324
-
ignore (run ~proc_mgr ~cwd ["rm"; "-rf"; "--cached"; "."])
338
+
ignore (run ~proc_mgr ~cwd [ "rm"; "-rf"; "--cached"; "." ])
325
339
326
340
let add_all ~proc_mgr ~cwd =
327
341
Log.debug (fun m -> m "Staging all changes");
328
-
run_exn ~proc_mgr ~cwd ["add"; "-A"] |> ignore
342
+
run_exn ~proc_mgr ~cwd [ "add"; "-A" ] |> ignore
329
343
330
344
let commit ~proc_mgr ~cwd ~message =
331
-
Log.debug (fun m -> m "Committing: %s" (String.sub message 0 (min 50 (String.length message))));
332
-
run_exn ~proc_mgr ~cwd ["commit"; "-m"; message] |> ignore
345
+
Log.debug (fun m ->
346
+
m "Committing: %s" (String.sub message 0 (min 50 (String.length message))));
347
+
run_exn ~proc_mgr ~cwd [ "commit"; "-m"; message ] |> ignore
333
348
334
349
let commit_allow_empty ~proc_mgr ~cwd ~message =
335
-
Log.debug (fun m -> m "Committing (allow empty): %s" (String.sub message 0 (min 50 (String.length message))));
336
-
run_exn ~proc_mgr ~cwd ["commit"; "--allow-empty"; "-m"; message] |> ignore
350
+
Log.debug (fun m ->
351
+
m "Committing (allow empty): %s"
352
+
(String.sub message 0 (min 50 (String.length message))));
353
+
run_exn ~proc_mgr ~cwd [ "commit"; "--allow-empty"; "-m"; message ] |> ignore
337
354
338
355
let branch_create ~proc_mgr ~cwd ~name ~start_point =
339
356
Log.info (fun m -> m "Creating branch %s at %s" name start_point);
340
-
run_exn ~proc_mgr ~cwd ["branch"; name; start_point] |> ignore
357
+
run_exn ~proc_mgr ~cwd [ "branch"; name; start_point ] |> ignore
341
358
342
359
let branch_force ~proc_mgr ~cwd ~name ~point =
343
360
Log.info (fun m -> m "Force-moving branch %s to %s" name point);
344
-
run_exn ~proc_mgr ~cwd ["branch"; "-f"; name; point] |> ignore
361
+
run_exn ~proc_mgr ~cwd [ "branch"; "-f"; name; point ] |> ignore
345
362
346
363
let remote_add ~proc_mgr ~cwd ~name ~url =
347
364
Log.info (fun m -> m "Adding remote %s -> %s" name url);
348
-
run_exn ~proc_mgr ~cwd ["remote"; "add"; name; url] |> ignore
365
+
run_exn ~proc_mgr ~cwd [ "remote"; "add"; name; url ] |> ignore
349
366
350
367
let remote_set_url ~proc_mgr ~cwd ~name ~url =
351
368
Log.info (fun m -> m "Setting remote %s URL to %s" name url);
352
-
run_exn ~proc_mgr ~cwd ["remote"; "set-url"; name; url] |> ignore
369
+
run_exn ~proc_mgr ~cwd [ "remote"; "set-url"; name; url ] |> ignore
353
370
354
371
let merge_allow_unrelated ~proc_mgr ~cwd ~branch ~message =
355
372
Log.info (fun m -> m "Merging %s (allow unrelated histories)..." branch);
356
-
match run ~proc_mgr ~cwd ["merge"; "--allow-unrelated-histories"; "-m"; message; branch] with
373
+
match
374
+
run ~proc_mgr ~cwd
375
+
[ "merge"; "--allow-unrelated-histories"; "-m"; message; branch ]
376
+
with
357
377
| Ok _ -> Ok ()
358
378
| Error (Command_failed { exit_code = 1; _ }) ->
359
379
(* Merge conflict - get list of conflicting files *)
360
-
let output = run_exn ~proc_mgr ~cwd ["diff"; "--name-only"; "--diff-filter=U"] in
380
+
let output =
381
+
run_exn ~proc_mgr ~cwd [ "diff"; "--name-only"; "--diff-filter=U" ]
382
+
in
361
383
let files = lines output in
362
-
Log.warn (fun m -> m "Merge conflict: %a" Fmt.(list ~sep:comma string) files);
384
+
Log.warn (fun m ->
385
+
m "Merge conflict: %a" Fmt.(list ~sep:comma string) files);
363
386
Error (`Conflict files)
364
-
| Error e ->
365
-
raise (err e)
387
+
| Error e -> raise (err e)
366
388
367
389
let rebase ~proc_mgr ~cwd ~onto =
368
390
Log.info (fun m -> m "Rebasing onto %s..." onto);
369
-
match run ~proc_mgr ~cwd ["rebase"; onto] with
391
+
match run ~proc_mgr ~cwd [ "rebase"; onto ] with
370
392
| Ok _ -> Ok ()
371
393
| Error (Command_failed { stderr; _ }) ->
372
394
let hint =
373
-
if String.length stderr > 200 then
374
-
String.sub stderr 0 200 ^ "..."
375
-
else
376
-
stderr
395
+
if String.length stderr > 200 then String.sub stderr 0 200 ^ "..."
396
+
else stderr
377
397
in
378
398
Log.warn (fun m -> m "Rebase conflict onto %s" onto);
379
399
Error (`Conflict hint)
380
-
| Error e ->
381
-
raise (err e)
400
+
| Error e -> raise (err e)
382
401
383
402
let rebase_abort ~proc_mgr ~cwd =
384
403
Log.info (fun m -> m "Aborting rebase...");
385
-
ignore (run ~proc_mgr ~cwd ["rebase"; "--abort"])
404
+
ignore (run ~proc_mgr ~cwd [ "rebase"; "--abort" ])
386
405
387
406
let merge_abort ~proc_mgr ~cwd =
388
407
Log.info (fun m -> m "Aborting merge...");
389
-
ignore (run ~proc_mgr ~cwd ["merge"; "--abort"])
408
+
ignore (run ~proc_mgr ~cwd [ "merge"; "--abort" ])
390
409
391
410
let reset_hard ~proc_mgr ~cwd ref_ =
392
411
Log.info (fun m -> m "Hard reset to %s" ref_);
393
-
run_exn ~proc_mgr ~cwd ["reset"; "--hard"; ref_] |> ignore
412
+
run_exn ~proc_mgr ~cwd [ "reset"; "--hard"; ref_ ] |> ignore
394
413
395
414
let clean_fd ~proc_mgr ~cwd =
396
415
Log.debug (fun m -> m "Cleaning untracked files");
397
-
run_exn ~proc_mgr ~cwd ["clean"; "-fd"] |> ignore
416
+
run_exn ~proc_mgr ~cwd [ "clean"; "-fd" ] |> ignore
398
417
399
418
let filter_repo_to_subdirectory ~proc_mgr ~cwd ~branch ~subdirectory =
400
-
Log.info (fun m -> m "Rewriting history of %s into subdirectory %s..." branch subdirectory);
419
+
Log.info (fun m ->
420
+
m "Rewriting history of %s into subdirectory %s..." branch subdirectory);
421
+
401
422
(* Use git-filter-repo with --to-subdirectory-filter to rewrite all paths into subdirectory.
402
423
This preserves full history with paths prefixed. Much faster than filter-branch.
403
424
···
417
438
let temp_wt : path = (fs, temp_wt_path) in
418
439
419
440
(* Remove any existing temp worktree *)
420
-
ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
441
+
ignore (run ~proc_mgr ~cwd [ "worktree"; "remove"; "-f"; temp_wt_relpath ]);
421
442
422
443
(* Create worktree for the branch *)
423
-
run_exn ~proc_mgr ~cwd ["worktree"; "add"; temp_wt_relpath; branch] |> ignore;
444
+
run_exn ~proc_mgr ~cwd [ "worktree"; "add"; temp_wt_relpath; branch ]
445
+
|> ignore;
424
446
425
447
(* Run git-filter-repo in the worktree *)
426
-
let result = run ~proc_mgr ~cwd:temp_wt [
427
-
"filter-repo";
428
-
"--to-subdirectory-filter"; subdirectory;
429
-
"--force";
430
-
"--refs"; "HEAD"
431
-
] in
448
+
let result =
449
+
run ~proc_mgr ~cwd:temp_wt
450
+
[
451
+
"filter-repo";
452
+
"--to-subdirectory-filter";
453
+
subdirectory;
454
+
"--force";
455
+
"--refs";
456
+
"HEAD";
457
+
]
458
+
in
432
459
433
460
(* Handle result: get the new SHA, cleanup worktree, then update branch *)
434
-
(match result with
435
-
| Ok _ ->
436
-
(* Get the new HEAD SHA from the worktree BEFORE removing it *)
437
-
let new_sha = run_exn ~proc_mgr ~cwd:temp_wt ["rev-parse"; "HEAD"] |> string_trim in
438
-
(* Cleanup temporary worktree first (must do this before updating branch) *)
439
-
ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
440
-
(* Now update the branch in the bare repo *)
441
-
run_exn ~proc_mgr ~cwd ["branch"; "-f"; branch; new_sha] |> ignore
442
-
| Error e ->
443
-
(* Cleanup and re-raise *)
444
-
ignore (run ~proc_mgr ~cwd ["worktree"; "remove"; "-f"; temp_wt_relpath]);
445
-
raise (err e))
461
+
match result with
462
+
| Ok _ ->
463
+
(* Get the new HEAD SHA from the worktree BEFORE removing it *)
464
+
let new_sha =
465
+
run_exn ~proc_mgr ~cwd:temp_wt [ "rev-parse"; "HEAD" ] |> string_trim
466
+
in
467
+
(* Cleanup temporary worktree first (must do this before updating branch) *)
468
+
ignore
469
+
(run ~proc_mgr ~cwd [ "worktree"; "remove"; "-f"; temp_wt_relpath ]);
470
+
(* Now update the branch in the bare repo *)
471
+
run_exn ~proc_mgr ~cwd [ "branch"; "-f"; branch; new_sha ] |> ignore
472
+
| Error e ->
473
+
(* Cleanup and re-raise *)
474
+
ignore
475
+
(run ~proc_mgr ~cwd [ "worktree"; "remove"; "-f"; temp_wt_relpath ]);
476
+
raise (err e)
+64
-194
lib/git.mli
+64
-194
lib/git.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Git operations wrapped with Eio and robust error handling.
2
7
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. *)
8
+
All git commands are executed via [Eio.Process] with proper logging and
9
+
error context. Errors are wrapped in [Eio.Exn.Io] with context chains for
10
+
debugging. *)
6
11
7
12
(** {1 Error Types} *)
8
13
···
39
44
(** {1 Low-level execution} *)
40
45
41
46
val run :
42
-
proc_mgr:proc_mgr ->
43
-
?cwd:path ->
44
-
string list ->
45
-
(string, error) result
47
+
proc_mgr:proc_mgr -> ?cwd:path -> string list -> (string, error) result
46
48
(** [run ~proc_mgr args] executes [git args] and returns stdout on success. *)
47
49
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. *)
50
+
val run_exn : proc_mgr:proc_mgr -> ?cwd:path -> string list -> string
51
+
(** [run_exn ~proc_mgr args] executes [git args] and returns stdout. Raises on
52
+
failure with context. *)
55
53
56
-
val run_lines :
57
-
proc_mgr:proc_mgr ->
58
-
?cwd:path ->
59
-
string list ->
60
-
string list
54
+
val run_lines : proc_mgr:proc_mgr -> ?cwd:path -> string list -> string list
61
55
(** [run_lines ~proc_mgr args] executes and splits output by newlines. *)
62
56
63
57
(** {1 Queries - Safe read-only operations} *)
···
65
59
val is_repository : path -> bool
66
60
(** [is_repository path] checks if [path] contains a [.git] directory. *)
67
61
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. *)
62
+
val current_branch : proc_mgr:proc_mgr -> cwd:path -> string option
63
+
(** [current_branch] returns [Some branch] if on a branch, [None] if detached.
64
+
*)
73
65
74
-
val current_branch_exn :
75
-
proc_mgr:proc_mgr ->
76
-
cwd:path ->
77
-
string
66
+
val current_branch_exn : proc_mgr:proc_mgr -> cwd:path -> string
78
67
(** [current_branch_exn] returns current branch or raises [Not_on_branch]. *)
79
68
80
-
val current_head :
81
-
proc_mgr:proc_mgr ->
82
-
cwd:path ->
83
-
string
69
+
val current_head : proc_mgr:proc_mgr -> cwd:path -> string
84
70
(** [current_head] returns the current HEAD SHA. *)
85
71
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. *)
72
+
val has_uncommitted_changes : proc_mgr:proc_mgr -> cwd:path -> bool
73
+
(** [has_uncommitted_changes] returns true if there are staged or unstaged
74
+
changes. *)
91
75
92
-
val remote_exists :
93
-
proc_mgr:proc_mgr ->
94
-
cwd:path ->
95
-
string ->
96
-
bool
76
+
val remote_exists : proc_mgr:proc_mgr -> cwd:path -> string -> bool
97
77
(** [remote_exists ~proc_mgr ~cwd name] checks if remote [name] exists. *)
98
78
99
-
val branch_exists :
100
-
proc_mgr:proc_mgr ->
101
-
cwd:path ->
102
-
string ->
103
-
bool
79
+
val branch_exists : proc_mgr:proc_mgr -> cwd:path -> string -> bool
104
80
(** [branch_exists ~proc_mgr ~cwd name] checks if branch [name] exists. *)
105
81
106
-
val rev_parse :
107
-
proc_mgr:proc_mgr ->
108
-
cwd:path ->
109
-
string ->
110
-
string option
82
+
val rev_parse : proc_mgr:proc_mgr -> cwd:path -> string -> string option
111
83
(** [rev_parse ~proc_mgr ~cwd ref] returns the SHA for [ref], or [None]. *)
112
84
113
-
val rev_parse_exn :
114
-
proc_mgr:proc_mgr ->
115
-
cwd:path ->
116
-
string ->
117
-
string
85
+
val rev_parse_exn : proc_mgr:proc_mgr -> cwd:path -> string -> string
118
86
(** [rev_parse_exn] returns SHA or raises. *)
119
87
120
-
val rev_parse_short :
121
-
proc_mgr:proc_mgr ->
122
-
cwd:path ->
123
-
string ->
124
-
string
88
+
val rev_parse_short : proc_mgr:proc_mgr -> cwd:path -> string -> string
125
89
(** [rev_parse_short] returns abbreviated SHA. *)
126
90
127
91
val ls_remote_default_branch :
128
-
proc_mgr:proc_mgr ->
129
-
cwd:path ->
130
-
url:string ->
131
-
string
132
-
(** [ls_remote_default_branch ~proc_mgr ~cwd ~url] detects the default branch of remote. *)
92
+
proc_mgr:proc_mgr -> cwd:path -> url:string -> string
93
+
(** [ls_remote_default_branch ~proc_mgr ~cwd ~url] detects the default branch of
94
+
remote. *)
133
95
134
-
val list_remotes :
135
-
proc_mgr:proc_mgr ->
136
-
cwd:path ->
137
-
string list
96
+
val list_remotes : proc_mgr:proc_mgr -> cwd:path -> string list
138
97
(** [list_remotes] returns all remote names. *)
139
98
140
-
val remote_url :
141
-
proc_mgr:proc_mgr ->
142
-
cwd:path ->
143
-
string ->
144
-
string option
99
+
val remote_url : proc_mgr:proc_mgr -> cwd:path -> string -> string option
145
100
(** [remote_url ~proc_mgr ~cwd name] returns the URL for remote [name]. *)
146
101
147
102
val log_oneline :
···
153
108
string list
154
109
(** [log_oneline ~proc_mgr ~cwd from_ref to_ref] returns commit summaries. *)
155
110
156
-
val diff_stat :
157
-
proc_mgr:proc_mgr ->
158
-
cwd:path ->
159
-
string ->
160
-
string ->
161
-
string
111
+
val diff_stat : proc_mgr:proc_mgr -> cwd:path -> string -> string -> string
162
112
(** [diff_stat ~proc_mgr ~cwd from_ref to_ref] returns diff statistics. *)
163
113
164
114
val ls_tree :
165
-
proc_mgr:proc_mgr ->
166
-
cwd:path ->
167
-
tree:string ->
168
-
path:string ->
169
-
bool
115
+
proc_mgr:proc_mgr -> cwd:path -> tree:string -> path:string -> bool
170
116
(** [ls_tree ~proc_mgr ~cwd ~tree ~path] checks if [path] exists in [tree]. *)
171
117
172
-
val rev_list_count :
173
-
proc_mgr:proc_mgr ->
174
-
cwd:path ->
175
-
string ->
176
-
string ->
177
-
int
178
-
(** [rev_list_count ~proc_mgr ~cwd from_ref to_ref] counts commits between refs. *)
118
+
val rev_list_count : proc_mgr:proc_mgr -> cwd:path -> string -> string -> int
119
+
(** [rev_list_count ~proc_mgr ~cwd from_ref to_ref] counts commits between refs.
120
+
*)
179
121
180
122
(** {1 Idempotent mutations - Safe to re-run} *)
181
123
···
197
139
198
140
(** {1 State-changing operations} *)
199
141
200
-
val init :
201
-
proc_mgr:proc_mgr ->
202
-
cwd:path ->
203
-
unit
142
+
val init : proc_mgr:proc_mgr -> cwd:path -> unit
204
143
(** [init] initializes a new git repository. *)
205
144
206
-
val fetch :
207
-
proc_mgr:proc_mgr ->
208
-
cwd:path ->
209
-
remote:string ->
210
-
unit
145
+
val fetch : proc_mgr:proc_mgr -> cwd:path -> remote:string -> unit
211
146
(** [fetch] fetches from a remote. *)
212
147
213
-
val checkout :
214
-
proc_mgr:proc_mgr ->
215
-
cwd:path ->
216
-
string ->
217
-
unit
148
+
val checkout : proc_mgr:proc_mgr -> cwd:path -> string -> unit
218
149
(** [checkout] switches to a branch or commit. *)
219
150
220
-
val checkout_orphan :
221
-
proc_mgr:proc_mgr ->
222
-
cwd:path ->
223
-
string ->
224
-
unit
151
+
val checkout_orphan : proc_mgr:proc_mgr -> cwd:path -> string -> unit
225
152
(** [checkout_orphan] creates and switches to a new orphan branch. *)
226
153
227
154
val read_tree_prefix :
228
-
proc_mgr:proc_mgr ->
229
-
cwd:path ->
230
-
prefix:string ->
231
-
tree:string ->
232
-
unit
155
+
proc_mgr:proc_mgr -> cwd:path -> prefix:string -> tree:string -> unit
233
156
(** [read_tree_prefix] reads a tree into the index with a path prefix. *)
234
157
235
-
val checkout_index :
236
-
proc_mgr:proc_mgr ->
237
-
cwd:path ->
238
-
unit
158
+
val checkout_index : proc_mgr:proc_mgr -> cwd:path -> unit
239
159
(** [checkout_index] checks out files from the index to working directory. *)
240
160
241
-
val rm_rf :
242
-
proc_mgr:proc_mgr ->
243
-
cwd:path ->
244
-
target:string ->
245
-
unit
161
+
val rm_rf : proc_mgr:proc_mgr -> cwd:path -> target:string -> unit
246
162
(** [rm_rf] removes files/directories from git tracking. *)
247
163
248
-
val rm_cached_rf :
249
-
proc_mgr:proc_mgr ->
250
-
cwd:path ->
251
-
unit
164
+
val rm_cached_rf : proc_mgr:proc_mgr -> cwd:path -> unit
252
165
(** [rm_cached_rf] removes all files from index (for orphan branch setup). *)
253
166
254
-
val add_all :
255
-
proc_mgr:proc_mgr ->
256
-
cwd:path ->
257
-
unit
167
+
val add_all : proc_mgr:proc_mgr -> cwd:path -> unit
258
168
(** [add_all] stages all changes. *)
259
169
260
-
val commit :
261
-
proc_mgr:proc_mgr ->
262
-
cwd:path ->
263
-
message:string ->
264
-
unit
170
+
val commit : proc_mgr:proc_mgr -> cwd:path -> message:string -> unit
265
171
(** [commit] creates a commit with the given message. *)
266
172
267
-
val commit_allow_empty :
268
-
proc_mgr:proc_mgr ->
269
-
cwd:path ->
270
-
message:string ->
271
-
unit
173
+
val commit_allow_empty : proc_mgr:proc_mgr -> cwd:path -> message:string -> unit
272
174
(** [commit_allow_empty] creates a commit even if there are no changes. *)
273
175
274
176
val branch_create :
275
-
proc_mgr:proc_mgr ->
276
-
cwd:path ->
277
-
name:string ->
278
-
start_point:string ->
279
-
unit
177
+
proc_mgr:proc_mgr -> cwd:path -> name:string -> start_point:string -> unit
280
178
(** [branch_create] creates a new branch at [start_point]. *)
281
179
282
180
val branch_force :
283
-
proc_mgr:proc_mgr ->
284
-
cwd:path ->
285
-
name:string ->
286
-
point:string ->
287
-
unit
181
+
proc_mgr:proc_mgr -> cwd:path -> name:string -> point:string -> unit
288
182
(** [branch_force] moves branch to point (creates if needed). *)
289
183
290
184
val remote_add :
291
-
proc_mgr:proc_mgr ->
292
-
cwd:path ->
293
-
name:string ->
294
-
url:string ->
295
-
unit
185
+
proc_mgr:proc_mgr -> cwd:path -> name:string -> url:string -> unit
296
186
(** [remote_add] adds a new remote. *)
297
187
298
188
val remote_set_url :
299
-
proc_mgr:proc_mgr ->
300
-
cwd:path ->
301
-
name:string ->
302
-
url:string ->
303
-
unit
189
+
proc_mgr:proc_mgr -> cwd:path -> name:string -> url:string -> unit
304
190
(** [remote_set_url] updates the URL of an existing remote. *)
305
191
306
192
val merge_allow_unrelated :
···
309
195
branch:string ->
310
196
message:string ->
311
197
(unit, [ `Conflict of string list ]) result
312
-
(** [merge_allow_unrelated] merges with [--allow-unrelated-histories].
313
-
Returns [Error (`Conflict files)] if there are conflicts. *)
198
+
(** [merge_allow_unrelated] merges with [--allow-unrelated-histories]. Returns
199
+
[Error (`Conflict files)] if there are conflicts. *)
314
200
315
201
val rebase :
316
202
proc_mgr:proc_mgr ->
317
203
cwd:path ->
318
204
onto:string ->
319
205
(unit, [ `Conflict of string ]) result
320
-
(** [rebase] rebases current branch onto [onto].
321
-
Returns [Error (`Conflict hint)] if there are conflicts. *)
206
+
(** [rebase] rebases current branch onto [onto]. Returns
207
+
[Error (`Conflict hint)] if there are conflicts. *)
322
208
323
-
val rebase_abort :
324
-
proc_mgr:proc_mgr ->
325
-
cwd:path ->
326
-
unit
209
+
val rebase_abort : proc_mgr:proc_mgr -> cwd:path -> unit
327
210
(** [rebase_abort] aborts an in-progress rebase. *)
328
211
329
-
val merge_abort :
330
-
proc_mgr:proc_mgr ->
331
-
cwd:path ->
332
-
unit
212
+
val merge_abort : proc_mgr:proc_mgr -> cwd:path -> unit
333
213
(** [merge_abort] aborts an in-progress merge. *)
334
214
335
-
val reset_hard :
336
-
proc_mgr:proc_mgr ->
337
-
cwd:path ->
338
-
string ->
339
-
unit
215
+
val reset_hard : proc_mgr:proc_mgr -> cwd:path -> string -> unit
340
216
(** [reset_hard] does a hard reset to the given ref. *)
341
217
342
-
val clean_fd :
343
-
proc_mgr:proc_mgr ->
344
-
cwd:path ->
345
-
unit
218
+
val clean_fd : proc_mgr:proc_mgr -> cwd:path -> unit
346
219
(** [clean_fd] removes untracked files and directories. *)
347
220
348
221
val filter_repo_to_subdirectory :
349
-
proc_mgr:proc_mgr ->
350
-
cwd:path ->
351
-
branch:string ->
352
-
subdirectory:string ->
353
-
unit
354
-
(** [filter_repo_to_subdirectory ~proc_mgr ~cwd ~branch ~subdirectory]
355
-
rewrites the history of [branch] so all files are moved into [subdirectory].
356
-
Uses git-filter-repo for fast history rewriting. Preserves full commit history. *)
222
+
proc_mgr:proc_mgr -> cwd:path -> branch:string -> subdirectory:string -> unit
223
+
(** [filter_repo_to_subdirectory ~proc_mgr ~cwd ~branch ~subdirectory] rewrites
224
+
the history of [branch] so all files are moved into [subdirectory]. Uses
225
+
git-filter-repo for fast history rewriting. Preserves full commit history.
226
+
*)
+45
-33
lib/git_repo_lookup.ml
+45
-33
lib/git_repo_lookup.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Git repository URL lookup and rewriting.
2
7
3
-
This module handles URL rewriting for git repositories, mapping known
4
-
slow upstream URLs to faster mirrors, and branch/tag overrides for
5
-
specific packages. *)
8
+
This module handles URL rewriting for git repositories, mapping known slow
9
+
upstream URLs to faster mirrors, and branch/tag overrides for specific
10
+
packages. *)
6
11
7
12
(** Rewrite a git URL to use a faster mirror if available.
8
13
9
14
Currently handles:
10
15
- erratique.ch repos are mirrored on GitHub under dbuenzli
11
-
- git.robur.coop repos are mirrored on GitHub under robur-coop
12
-
(strips the org prefix: git.robur.coop/robur/X -> github.com/robur-coop/X) *)
16
+
- git.robur.coop repos are mirrored on GitHub under robur-coop (strips the
17
+
org prefix: git.robur.coop/robur/X -> github.com/robur-coop/X) *)
13
18
let rewrite_url url =
14
19
(* Helper to check and rewrite prefix *)
15
20
let try_rewrite ~prefix ~replacement url =
16
-
if String.length url > String.length prefix
17
-
&& String.sub url 0 (String.length prefix) = prefix
21
+
if
22
+
String.length url > String.length prefix
23
+
&& String.sub url 0 (String.length prefix) = prefix
18
24
then
19
-
let rest = String.sub url (String.length prefix)
20
-
(String.length url - String.length prefix) in
25
+
let rest =
26
+
String.sub url (String.length prefix)
27
+
(String.length url - String.length prefix)
28
+
in
21
29
Some (replacement ^ rest)
22
30
else None
23
31
in
24
32
(* Helper to rewrite robur.coop URLs, stripping the org path component *)
25
33
let try_rewrite_robur ~prefix url =
26
-
if String.length url > String.length prefix
27
-
&& String.sub url 0 (String.length prefix) = prefix
34
+
if
35
+
String.length url > String.length prefix
36
+
&& String.sub url 0 (String.length prefix) = prefix
28
37
then
29
38
(* rest is e.g. "robur/ohex.git" - strip org prefix *)
30
-
let rest = String.sub url (String.length prefix)
31
-
(String.length url - String.length prefix) in
39
+
let rest =
40
+
String.sub url (String.length prefix)
41
+
(String.length url - String.length prefix)
42
+
in
32
43
(* Find the first slash to strip the org *)
33
44
match String.index_opt rest '/' with
34
45
| Some idx ->
···
38
49
else None
39
50
in
40
51
(* Try each rewrite rule in order *)
41
-
match try_rewrite ~prefix:"https://erratique.ch/repos/"
42
-
~replacement:"https://github.com/dbuenzli/" url with
52
+
match
53
+
try_rewrite ~prefix:"https://erratique.ch/repos/"
54
+
~replacement:"https://github.com/dbuenzli/" url
55
+
with
43
56
| Some u -> u
44
-
| None ->
45
-
match try_rewrite ~prefix:"http://erratique.ch/repos/"
46
-
~replacement:"https://github.com/dbuenzli/" url with
47
-
| Some u -> u
48
-
| None ->
49
-
match try_rewrite_robur ~prefix:"https://git.robur.coop/" url with
50
-
| Some u -> u
51
-
| None ->
52
-
match try_rewrite_robur ~prefix:"git://git.robur.coop/" url with
53
-
| Some u -> u
54
-
| None -> url
57
+
| None -> (
58
+
match
59
+
try_rewrite ~prefix:"http://erratique.ch/repos/"
60
+
~replacement:"https://github.com/dbuenzli/" url
61
+
with
62
+
| Some u -> u
63
+
| None -> (
64
+
match try_rewrite_robur ~prefix:"https://git.robur.coop/" url with
65
+
| Some u -> u
66
+
| None -> (
67
+
match try_rewrite_robur ~prefix:"git://git.robur.coop/" url with
68
+
| Some u -> u
69
+
| None -> url)))
55
70
56
71
(** Override branch/tag for specific packages.
57
72
···
63
78
let branch_override ~name ~url =
64
79
(* Dune's main branch can be unstable; pin to release tag *)
65
80
let is_dune_url =
66
-
String.equal url "https://github.com/ocaml/dune.git" ||
67
-
String.equal url "https://github.com/ocaml/dune" ||
68
-
String.equal url "git://github.com/ocaml/dune.git"
81
+
String.equal url "https://github.com/ocaml/dune.git"
82
+
|| String.equal url "https://github.com/ocaml/dune"
83
+
|| String.equal url "git://github.com/ocaml/dune.git"
69
84
in
70
-
if name = "dune" || is_dune_url then
71
-
Some "3.20.2"
72
-
else
73
-
None
85
+
if name = "dune" || is_dune_url then Some "3.20.2" else None
+36
-28
lib/init.ml
+36
-28
lib/init.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Project initialization for unpac.
2
7
3
8
Creates the bare repository structure and initial main worktree. *)
4
9
5
-
let default_unpac_toml = {|[opam]
10
+
let default_unpac_toml =
11
+
{|[opam]
6
12
repositories = []
7
13
# compiler = "5.4.0"
8
14
···
13
19
# Projects will be added here
14
20
|}
15
21
16
-
let project_dune_project name = Printf.sprintf {|(lang dune 3.20)
22
+
let project_dune_project name =
23
+
Printf.sprintf {|(lang dune 3.20)
17
24
(name %s)
18
25
|} name
19
26
···
31
38
let init ~proc_mgr ~fs path =
32
39
(* Convert relative paths to absolute *)
33
40
let abs_path =
34
-
if Filename.is_relative path then
35
-
Filename.concat (Sys.getcwd ()) path
41
+
if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
36
42
else path
37
43
in
38
44
let root = Eio.Path.(fs / abs_path) in
···
43
49
(* Initialize bare repository *)
44
50
let git_path = Eio.Path.(root / "git") in
45
51
Eio.Path.mkdirs ~exists_ok:false ~perm:0o755 git_path;
46
-
Git.run_exn ~proc_mgr ~cwd:git_path ["init"; "--bare"] |> ignore;
52
+
Git.run_exn ~proc_mgr ~cwd:git_path [ "init"; "--bare" ] |> ignore;
47
53
48
54
(* Create initial main branch with unpac.toml *)
49
55
(* First create a temporary worktree to make the initial commit *)
···
51
57
Eio.Path.mkdirs ~exists_ok:false ~perm:0o755 main_path;
52
58
53
59
(* Initialize as a regular repo temporarily to create first commit *)
54
-
Git.run_exn ~proc_mgr ~cwd:main_path ["init"] |> ignore;
60
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "init" ] |> ignore;
55
61
56
62
(* Write unpac.toml *)
57
63
Eio.Path.save ~create:(`Or_truncate 0o644)
···
59
65
default_unpac_toml;
60
66
61
67
(* Create initial commit *)
62
-
Git.run_exn ~proc_mgr ~cwd:main_path ["add"; "unpac.toml"] |> ignore;
63
-
Git.run_exn ~proc_mgr ~cwd:main_path
64
-
["commit"; "-m"; "Initial commit"] |> ignore;
68
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "add"; "unpac.toml" ] |> ignore;
69
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "commit"; "-m"; "Initial commit" ]
70
+
|> ignore;
65
71
66
72
(* Rename branch to main if needed *)
67
-
Git.run_exn ~proc_mgr ~cwd:main_path ["branch"; "-M"; "main"] |> ignore;
73
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "branch"; "-M"; "main" ] |> ignore;
68
74
69
75
(* Push to bare repo and convert to worktree *)
70
-
Git.run_exn ~proc_mgr ~cwd:main_path
71
-
["remote"; "add"; "origin"; "../git"] |> ignore;
72
-
Git.run_exn ~proc_mgr ~cwd:main_path
73
-
["push"; "-u"; "origin"; "main"] |> ignore;
76
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "remote"; "add"; "origin"; "../git" ]
77
+
|> ignore;
78
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "push"; "-u"; "origin"; "main" ]
79
+
|> ignore;
74
80
75
81
(* Remove the temporary clone and add main as a worktree of the bare repo *)
76
82
Eio.Path.rmtree main_path;
77
83
78
84
(* Add main as a worktree of the bare repo *)
79
-
Git.run_exn ~proc_mgr ~cwd:git_path
80
-
["worktree"; "add"; "../main"; "main"] |> ignore;
85
+
Git.run_exn ~proc_mgr ~cwd:git_path [ "worktree"; "add"; "../main"; "main" ]
86
+
|> ignore;
81
87
82
88
root
83
89
84
90
(** Check if a path is an unpac project root. *)
85
91
let is_unpac_root path =
86
-
Eio.Path.is_directory Eio.Path.(path / "git") &&
87
-
Eio.Path.is_directory Eio.Path.(path / "main") &&
88
-
Eio.Path.is_file Eio.Path.(path / "main" / "unpac.toml")
92
+
Eio.Path.is_directory Eio.Path.(path / "git")
93
+
&& Eio.Path.is_directory Eio.Path.(path / "main")
94
+
&& Eio.Path.is_file Eio.Path.(path / "main" / "unpac.toml")
89
95
90
96
(** Find the unpac root by walking up from current directory. *)
91
97
let find_root ~fs ~cwd =
92
98
let rec go path =
93
99
if is_unpac_root path then Some path
94
-
else match Eio.Path.split path with
100
+
else
101
+
match Eio.Path.split path with
95
102
| Some (parent, _) -> go parent
96
103
| None -> None
97
104
in
···
130
137
vendor_dune;
131
138
132
139
(* Commit template *)
133
-
Git.run_exn ~proc_mgr ~cwd:project_path ["add"; "-A"] |> ignore;
140
+
Git.run_exn ~proc_mgr ~cwd:project_path [ "add"; "-A" ] |> ignore;
134
141
Git.run_exn ~proc_mgr ~cwd:project_path
135
-
["commit"; "-m"; "Initialize project " ^ name] |> ignore;
142
+
[ "commit"; "-m"; "Initialize project " ^ name ]
143
+
|> ignore;
136
144
137
145
(* Update main/unpac.toml to register project *)
138
146
let main_path = Worktree.path root Main in
···
141
149
142
150
(* Simple append to [projects] section - a proper implementation would parse TOML *)
143
151
let updated =
144
-
if content = "" || not (String.ends_with ~suffix:"\n" content)
145
-
then content ^ "\n" ^ name ^ " = {}\n"
152
+
if content = "" || not (String.ends_with ~suffix:"\n" content) then
153
+
content ^ "\n" ^ name ^ " = {}\n"
146
154
else content ^ name ^ " = {}\n"
147
155
in
148
156
Eio.Path.save ~create:(`Or_truncate 0o644) toml_path updated;
149
157
150
-
Git.run_exn ~proc_mgr ~cwd:main_path ["add"; "unpac.toml"] |> ignore;
151
-
Git.run_exn ~proc_mgr ~cwd:main_path
152
-
["commit"; "-m"; "Add project " ^ name] |> ignore;
158
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "add"; "unpac.toml" ] |> ignore;
159
+
Git.run_exn ~proc_mgr ~cwd:main_path [ "commit"; "-m"; "Add project " ^ name ]
160
+
|> ignore;
153
161
154
162
project_path
155
163
···
161
169
(* Delete the branch *)
162
170
let git = Worktree.git_dir root in
163
171
let branch = Worktree.branch (Project name) in
164
-
Git.run_exn ~proc_mgr ~cwd:git ["branch"; "-D"; branch] |> ignore
172
+
Git.run_exn ~proc_mgr ~cwd:git [ "branch"; "-D"; branch ] |> ignore
+10
-13
lib/init.mli
+10
-13
lib/init.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Project initialization for unpac.
2
7
3
8
Creates the bare repository structure and initial main worktree. *)
···
17
22
(** [is_unpac_root path] checks if [path] is an unpac project root. *)
18
23
19
24
val find_root :
20
-
fs:Eio.Fs.dir_ty Eio.Path.t ->
21
-
cwd:string ->
22
-
Worktree.root option
25
+
fs:Eio.Fs.dir_ty Eio.Path.t -> cwd:string -> Worktree.root option
23
26
(** [find_root ~fs ~cwd] walks up from [cwd] to find the unpac root. *)
24
27
25
28
val create_project :
26
-
proc_mgr:Git.proc_mgr ->
27
-
Worktree.root ->
28
-
string ->
29
-
Eio.Fs.dir_ty Eio.Path.t
29
+
proc_mgr:Git.proc_mgr -> Worktree.root -> string -> Eio.Fs.dir_ty Eio.Path.t
30
30
(** [create_project ~proc_mgr root name] creates a new project branch.
31
31
32
32
Creates orphan branch [project/<name>] with template:
···
36
36
37
37
Updates main/unpac.toml to register the project. *)
38
38
39
-
val remove_project :
40
-
proc_mgr:Git.proc_mgr ->
41
-
Worktree.root ->
42
-
string ->
43
-
unit
44
-
(** [remove_project ~proc_mgr root name] removes a project branch and worktree. *)
39
+
val remove_project : proc_mgr:Git.proc_mgr -> Worktree.root -> string -> unit
40
+
(** [remove_project ~proc_mgr root name] removes a project branch and worktree.
41
+
*)
+1
-7
lib/opam/dune
+1
-7
lib/opam/dune
+71
-60
lib/opam/opam.ml
+71
-60
lib/opam/opam.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Opam backend for unpac.
2
7
3
8
Implements vendoring of opam packages using the three-tier branch model:
4
9
- opam/upstream/<pkg> - pristine upstream code
5
-
- opam/vendor/<pkg> - upstream history rewritten with vendor/opam/<pkg>/ prefix
10
+
- opam/vendor/<pkg> - upstream history rewritten with vendor/opam/<pkg>/
11
+
prefix
6
12
- opam/patches/<pkg> - local modifications
7
13
8
14
The vendor branch preserves full git history from upstream, with all paths
···
38
44
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 prefix_dir;
39
45
40
46
let rec copy_dir src dst =
41
-
Eio.Path.read_dir src |> List.iter (fun name ->
42
-
let src_path = Eio.Path.(src / name) in
43
-
let dst_path = Eio.Path.(dst / name) in
44
-
if Eio.Path.is_directory src_path then begin
45
-
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
46
-
copy_dir src_path dst_path
47
-
end else begin
48
-
let content = Eio.Path.load src_path in
49
-
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
50
-
end
51
-
)
47
+
Eio.Path.read_dir src
48
+
|> List.iter (fun name ->
49
+
let src_path = Eio.Path.(src / name) in
50
+
let dst_path = Eio.Path.(dst / name) in
51
+
if Eio.Path.is_directory src_path then begin
52
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
53
+
copy_dir src_path dst_path
54
+
end
55
+
else begin
56
+
let content = Eio.Path.load src_path in
57
+
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
58
+
end)
52
59
in
53
60
54
61
(* Copy everything except .git *)
55
-
Eio.Path.read_dir src_dir |> List.iter (fun name ->
56
-
if name <> ".git" then begin
57
-
let src_path = Eio.Path.(src_dir / name) in
58
-
let dst_path = Eio.Path.(prefix_dir / name) in
59
-
if Eio.Path.is_directory src_path then begin
60
-
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
61
-
copy_dir src_path dst_path
62
-
end else begin
63
-
let content = Eio.Path.load src_path in
64
-
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
65
-
end
66
-
end
67
-
)
62
+
Eio.Path.read_dir src_dir
63
+
|> List.iter (fun name ->
64
+
if name <> ".git" then begin
65
+
let src_path = Eio.Path.(src_dir / name) in
66
+
let dst_path = Eio.Path.(prefix_dir / name) in
67
+
if Eio.Path.is_directory src_path then begin
68
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path;
69
+
copy_dir src_path dst_path
70
+
end
71
+
else begin
72
+
let content = Eio.Path.load src_path in
73
+
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path content
74
+
end
75
+
end)
68
76
69
77
let add_package ~proc_mgr ~root ?cache (info : Backend.package_info) =
70
78
let pkg = info.name in
···
79
87
let url = Git_repo_lookup.rewrite_url info.url in
80
88
81
89
(* Determine the ref to use: explicit > override > default *)
82
-
let branch = match info.branch with
90
+
let branch =
91
+
match info.branch with
83
92
| Some b -> b
84
-
| None ->
93
+
| None -> (
85
94
match Git_repo_lookup.branch_override ~name:pkg ~url with
86
95
| Some b -> b
87
-
| None -> Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url
96
+
| None -> Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url)
88
97
in
89
98
90
99
(* Fetch - either via cache or directly *)
91
-
let ref_point = match cache with
100
+
let ref_point =
101
+
match cache with
92
102
| Some cache_path ->
93
103
(* Fetch through vendor cache *)
94
-
Vendor_cache.fetch_to_project ~proc_mgr
95
-
~cache:cache_path ~project_git:git ~url ~branch
104
+
Vendor_cache.fetch_to_project ~proc_mgr ~cache:cache_path
105
+
~project_git:git ~url ~branch
96
106
| None ->
97
107
(* Direct fetch *)
98
108
let remote = "origin-" ^ pkg in
···
102
112
in
103
113
104
114
(* Step 1: Create upstream branch from fetched ref *)
105
-
Git.branch_force ~proc_mgr ~cwd:git
106
-
~name:(upstream_branch pkg) ~point:ref_point;
115
+
Git.branch_force ~proc_mgr ~cwd:git ~name:(upstream_branch pkg)
116
+
~point:ref_point;
107
117
108
118
(* Step 2: Create vendor branch from upstream and rewrite history *)
109
-
Git.branch_force ~proc_mgr ~cwd:git
110
-
~name:(vendor_branch pkg) ~point:(upstream_branch pkg);
119
+
Git.branch_force ~proc_mgr ~cwd:git ~name:(vendor_branch pkg)
120
+
~point:(upstream_branch pkg);
111
121
112
122
(* Rewrite vendor branch history to move all files into vendor/opam/<pkg>/ *)
113
123
Git.filter_repo_to_subdirectory ~proc_mgr ~cwd:git
114
-
~branch:(vendor_branch pkg)
115
-
~subdirectory:(vendor_path pkg);
124
+
~branch:(vendor_branch pkg) ~subdirectory:(vendor_path pkg);
116
125
117
126
(* Get the vendor SHA after rewriting *)
118
-
let vendor_sha = match Git.rev_parse ~proc_mgr ~cwd:git (vendor_branch pkg) with
127
+
let vendor_sha =
128
+
match Git.rev_parse ~proc_mgr ~cwd:git (vendor_branch pkg) with
119
129
| Some sha -> sha
120
130
| None -> failwith "Vendor branch not found after filter-repo"
121
131
in
122
132
123
133
(* Step 3: Create patches branch from vendor *)
124
-
Git.branch_create ~proc_mgr ~cwd:git
125
-
~name:(patches_branch pkg)
134
+
Git.branch_create ~proc_mgr ~cwd:git ~name:(patches_branch pkg)
126
135
~start_point:(vendor_branch pkg);
127
136
128
137
Backend.Added { name = pkg; sha = vendor_sha }
···
143
152
else begin
144
153
(* Get remote URL - check vendor-cache remote first, then origin-<pkg> *)
145
154
let remote = "origin-" ^ pkg in
146
-
let url = match Git.remote_url ~proc_mgr ~cwd:git remote with
155
+
let url =
156
+
match Git.remote_url ~proc_mgr ~cwd:git remote with
147
157
| Some u -> u
148
158
| None -> failwith ("Remote not found: " ^ remote)
149
159
in
150
160
151
161
(* Fetch latest - either via cache or directly *)
152
162
(match cache with
153
-
| Some cache_path ->
154
-
let branch = Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url in
155
-
ignore (Vendor_cache.fetch_to_project ~proc_mgr
156
-
~cache:cache_path ~project_git:git ~url ~branch)
157
-
| None ->
158
-
Git.fetch ~proc_mgr ~cwd:git ~remote);
163
+
| Some cache_path ->
164
+
let branch = Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url in
165
+
ignore
166
+
(Vendor_cache.fetch_to_project ~proc_mgr ~cache:cache_path
167
+
~project_git:git ~url ~branch)
168
+
| None -> Git.fetch ~proc_mgr ~cwd:git ~remote);
159
169
160
170
(* Get old SHA *)
161
-
let old_sha = match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch pkg) with
171
+
let old_sha =
172
+
match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch pkg) with
162
173
| Some sha -> sha
163
174
| None -> failwith "Upstream branch not found"
164
175
in
165
176
166
177
(* Determine default branch and update upstream *)
167
-
let default_branch = Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url in
178
+
let default_branch =
179
+
Git.ls_remote_default_branch ~proc_mgr ~cwd:git ~url
180
+
in
168
181
let ref_point = remote ^ "/" ^ default_branch in
169
-
Git.branch_force ~proc_mgr ~cwd:git
170
-
~name:(upstream_branch pkg) ~point:ref_point;
182
+
Git.branch_force ~proc_mgr ~cwd:git ~name:(upstream_branch pkg)
183
+
~point:ref_point;
171
184
172
185
(* Get new SHA *)
173
-
let new_sha = match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch pkg) with
186
+
let new_sha =
187
+
match Git.rev_parse ~proc_mgr ~cwd:git (upstream_branch pkg) with
174
188
| Some sha -> sha
175
189
| None -> failwith "Upstream branch not found"
176
190
in
177
191
178
-
if old_sha = new_sha then
179
-
Backend.No_changes pkg
192
+
if old_sha = new_sha then Backend.No_changes pkg
180
193
else begin
181
194
(* Create worktrees *)
182
195
Worktree.ensure ~proc_mgr root (upstream_kind pkg);
···
189
202
let vendor_pkg_path = Eio.Path.(vendor_wt / "vendor" / "opam" / pkg) in
190
203
(try Eio.Path.rmtree vendor_pkg_path with _ -> ());
191
204
192
-
copy_with_prefix
193
-
~src_dir:upstream_wt
194
-
~dst_dir:vendor_wt
205
+
copy_with_prefix ~src_dir:upstream_wt ~dst_dir:vendor_wt
195
206
~prefix:(vendor_path pkg);
196
207
197
208
(* Commit *)
198
209
Git.add_all ~proc_mgr ~cwd:vendor_wt;
199
210
Git.commit ~proc_mgr ~cwd:vendor_wt
200
-
~message:(Printf.sprintf "Update %s to %s" pkg (String.sub new_sha 0 7));
211
+
~message:
212
+
(Printf.sprintf "Update %s to %s" pkg (String.sub new_sha 0 7));
201
213
202
214
(* Cleanup *)
203
215
Worktree.remove ~proc_mgr root (upstream_kind pkg);
···
211
223
(try Worktree.remove_force ~proc_mgr root (vendor_kind pkg) with _ -> ());
212
224
Backend.Update_failed { name = pkg; error = Printexc.to_string exn }
213
225
214
-
let list_packages ~proc_mgr ~root =
215
-
Worktree.list_opam_packages ~proc_mgr root
226
+
let list_packages ~proc_mgr ~root = Worktree.list_opam_packages ~proc_mgr root
+13
-9
lib/opam/opam.mli
+13
-9
lib/opam/opam.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Opam backend for unpac.
2
7
3
8
Implements vendoring of opam packages using the three-tier branch model:
···
38
43
Unpac.Backend.add_result
39
44
(** [add_package ~proc_mgr ~root ?cache info] vendors a single package.
40
45
41
-
1. Fetches upstream into opam/upstream/<pkg> (via cache if provided)
42
-
2. Creates opam/vendor/<pkg> with vendor/opam/<pkg>/ prefix (preserving history)
43
-
3. Creates opam/patches/<pkg> from vendor
46
+
1. Fetches upstream into opam/upstream/<pkg> (via cache if provided) 2.
47
+
Creates opam/vendor/<pkg> with vendor/opam/<pkg>/ prefix (preserving
48
+
history) 3. Creates opam/patches/<pkg> from vendor
44
49
45
50
Uses git-filter-repo for fast history rewriting.
46
51
@param cache Optional vendor cache for shared fetches across projects. *)
···
51
56
?cache:Unpac.Vendor_cache.t ->
52
57
string ->
53
58
Unpac.Backend.update_result
54
-
(** [update_package ~proc_mgr ~root ?cache name] updates a package from upstream.
59
+
(** [update_package ~proc_mgr ~root ?cache name] updates a package from
60
+
upstream.
55
61
56
-
1. Fetches latest into opam/upstream/<pkg> (via cache if provided)
57
-
2. Updates opam/vendor/<pkg> with new content
62
+
1. Fetches latest into opam/upstream/<pkg> (via cache if provided) 2.
63
+
Updates opam/vendor/<pkg> with new content
58
64
59
65
Does NOT rebase patches - call [Backend.rebase_patches] separately.
60
66
61
67
@param cache Optional vendor cache for shared fetches across projects. *)
62
68
63
69
val list_packages :
64
-
proc_mgr:Unpac.Git.proc_mgr ->
65
-
root:Unpac.Worktree.root ->
66
-
string list
70
+
proc_mgr:Unpac.Git.proc_mgr -> root:Unpac.Worktree.root -> string list
67
71
(** [list_packages ~proc_mgr root] returns all vendored opam package names. *)
+50
-45
lib/opam/opam_file.ml
+50
-45
lib/opam/opam_file.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Opam file parsing for extracting package metadata. *)
2
7
3
8
type metadata = {
···
7
12
synopsis : string option;
8
13
}
9
14
10
-
let empty_metadata = {
11
-
name = "";
12
-
version = "";
13
-
dev_repo = None;
14
-
synopsis = None;
15
-
}
15
+
let empty_metadata =
16
+
{ name = ""; version = ""; dev_repo = None; synopsis = None }
16
17
17
18
(** Parse an opam file and extract metadata. *)
18
19
let parse ~name ~version content =
···
23
24
let dev_repo = ref None in
24
25
let synopsis = ref None in
25
26
26
-
List.iter (fun item ->
27
-
match item.OpamParserTypes.FullPos.pelem with
28
-
| OpamParserTypes.FullPos.Variable (name_pos, value_pos) ->
29
-
let var_name = name_pos.OpamParserTypes.FullPos.pelem in
30
-
(match var_name, value_pos.OpamParserTypes.FullPos.pelem with
31
-
| "dev-repo", OpamParserTypes.FullPos.String s ->
32
-
dev_repo := Some s
33
-
| "synopsis", OpamParserTypes.FullPos.String s ->
34
-
synopsis := Some s
35
-
| _ -> ())
36
-
| _ -> ()
37
-
) items;
27
+
List.iter
28
+
(fun item ->
29
+
match item.OpamParserTypes.FullPos.pelem with
30
+
| OpamParserTypes.FullPos.Variable (name_pos, value_pos) -> (
31
+
let var_name = name_pos.OpamParserTypes.FullPos.pelem in
32
+
match (var_name, value_pos.OpamParserTypes.FullPos.pelem) with
33
+
| "dev-repo", OpamParserTypes.FullPos.String s -> dev_repo := Some s
34
+
| "synopsis", OpamParserTypes.FullPos.String s -> synopsis := Some s
35
+
| _ -> ())
36
+
| _ -> ())
37
+
items;
38
38
39
39
{ name; version; dev_repo = !dev_repo; synopsis = !synopsis }
40
-
with _ ->
41
-
{ empty_metadata with name; version }
40
+
with _ -> { empty_metadata with name; version }
42
41
43
42
(** Parse an opam file from a path. *)
44
43
let parse_file ~name ~version path =
45
44
let content = In_channel.with_open_text path In_channel.input_all in
46
45
parse ~name ~version content
47
46
48
-
(** Find a package in an opam repository directory.
49
-
Returns the path to the opam file if found. *)
47
+
(** Find a package in an opam repository directory. Returns the path to the opam
48
+
file if found. *)
50
49
let find_in_repo ~repo_path ~name ?version () =
51
50
let packages_dir = Filename.concat repo_path "packages" in
52
51
let pkg_dir = Filename.concat packages_dir name in
53
52
54
-
if not (Sys.file_exists pkg_dir && Sys.is_directory pkg_dir) then
55
-
None
53
+
if not (Sys.file_exists pkg_dir && Sys.is_directory pkg_dir) then None
56
54
else
57
55
(* List version directories *)
58
56
let entries = Sys.readdir pkg_dir |> Array.to_list in
59
-
let version_dirs = List.filter (fun entry ->
60
-
let full = Filename.concat pkg_dir entry in
61
-
Sys.is_directory full && String.starts_with ~prefix:(name ^ ".") entry
62
-
) entries in
57
+
let version_dirs =
58
+
List.filter
59
+
(fun entry ->
60
+
let full = Filename.concat pkg_dir entry in
61
+
Sys.is_directory full && String.starts_with ~prefix:(name ^ ".") entry)
62
+
entries
63
+
in
63
64
64
65
match version with
65
66
| Some v ->
66
67
(* Look for specific version *)
67
68
let target = name ^ "." ^ v in
68
69
if List.mem target version_dirs then
69
-
let opam_path = Filename.concat (Filename.concat pkg_dir target) "opam" in
70
-
if Sys.file_exists opam_path then Some (opam_path, v)
71
-
else None
70
+
let opam_path =
71
+
Filename.concat (Filename.concat pkg_dir target) "opam"
72
+
in
73
+
if Sys.file_exists opam_path then Some (opam_path, v) else None
72
74
else None
73
-
| None ->
75
+
| None -> (
74
76
(* Find latest version (simple string sort, works for semver) *)
75
77
let sorted = List.sort (fun a b -> String.compare b a) version_dirs in
76
78
match sorted with
77
79
| [] -> None
78
80
| latest :: _ ->
79
-
let v = String.sub latest (String.length name + 1)
80
-
(String.length latest - String.length name - 1) in
81
-
let opam_path = Filename.concat (Filename.concat pkg_dir latest) "opam" in
82
-
if Sys.file_exists opam_path then Some (opam_path, v)
83
-
else None
81
+
let v =
82
+
String.sub latest
83
+
(String.length name + 1)
84
+
(String.length latest - String.length name - 1)
85
+
in
86
+
let opam_path =
87
+
Filename.concat (Filename.concat pkg_dir latest) "opam"
88
+
in
89
+
if Sys.file_exists opam_path then Some (opam_path, v) else None)
84
90
85
91
(** Get metadata for a package from an opam repository. *)
86
92
let get_metadata ~repo_path ~name ?version () =
87
93
match find_in_repo ~repo_path ~name ?version () with
88
94
| None -> None
89
-
| Some (opam_path, v) ->
90
-
Some (parse_file ~name ~version:v opam_path)
95
+
| Some (opam_path, v) -> Some (parse_file ~name ~version:v opam_path)
91
96
92
97
(** List all versions of a package in a repository. *)
93
98
let list_versions ~repo_path ~name =
94
99
let packages_dir = Filename.concat repo_path "packages" in
95
100
let pkg_dir = Filename.concat packages_dir name in
96
101
97
-
if not (Sys.file_exists pkg_dir && Sys.is_directory pkg_dir) then
98
-
[]
102
+
if not (Sys.file_exists pkg_dir && Sys.is_directory pkg_dir) then []
99
103
else
100
-
Sys.readdir pkg_dir
101
-
|> Array.to_list
104
+
Sys.readdir pkg_dir |> Array.to_list
102
105
|> List.filter_map (fun entry ->
103
106
if String.starts_with ~prefix:(name ^ ".") entry then
104
-
Some (String.sub entry (String.length name + 1)
105
-
(String.length entry - String.length name - 1))
107
+
Some
108
+
(String.sub entry
109
+
(String.length name + 1)
110
+
(String.length entry - String.length name - 1))
106
111
else None)
107
112
|> List.sort String.compare
+19
-6
lib/opam/opam_file.mli
+19
-6
lib/opam/opam_file.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Opam file parsing for extracting package metadata. *)
2
7
3
8
type metadata = {
···
13
18
val parse_file : name:string -> version:string -> string -> metadata
14
19
(** [parse_file ~name ~version path] parses an opam file from disk. *)
15
20
16
-
val find_in_repo : repo_path:string -> name:string -> ?version:string -> unit -> (string * string) option
17
-
(** [find_in_repo ~repo_path ~name ?version ()] finds a package in an opam repository.
18
-
Returns [Some (opam_file_path, version)] if found. *)
21
+
val find_in_repo :
22
+
repo_path:string ->
23
+
name:string ->
24
+
?version:string ->
25
+
unit ->
26
+
(string * string) option
27
+
(** [find_in_repo ~repo_path ~name ?version ()] finds a package in an opam
28
+
repository. Returns [Some (opam_file_path, version)] if found. *)
19
29
20
-
val get_metadata : repo_path:string -> name:string -> ?version:string -> unit -> metadata option
21
-
(** [get_metadata ~repo_path ~name ?version ()] gets package metadata from a repository. *)
30
+
val get_metadata :
31
+
repo_path:string -> name:string -> ?version:string -> unit -> metadata option
32
+
(** [get_metadata ~repo_path ~name ?version ()] gets package metadata from a
33
+
repository. *)
22
34
23
35
val list_versions : repo_path:string -> name:string -> string list
24
-
(** [list_versions ~repo_path ~name] lists all available versions of a package. *)
36
+
(** [list_versions ~repo_path ~name] lists all available versions of a package.
37
+
*)
+48
-42
lib/opam/repo.ml
+48
-42
lib/opam/repo.ml
···
1
-
(** Opam repository operations. *)
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
2
5
3
-
type repo = {
4
-
name : string;
5
-
path : string;
6
-
}
6
+
(** Opam repository operations. *)
7
7
8
-
type search_result = {
9
-
repo : repo;
10
-
metadata : Opam_file.metadata;
11
-
}
8
+
type repo = { name : string; path : string }
9
+
type search_result = { repo : repo; metadata : Opam_file.metadata }
12
10
13
11
(** Resolve repository path from config. *)
14
12
let resolve_repo (cfg : Unpac.Config.repo_config) : repo option =
···
25
23
let find_package ~repos ~name ?version () : search_result option =
26
24
let rec search = function
27
25
| [] -> None
28
-
| cfg :: rest ->
26
+
| cfg :: rest -> (
29
27
match resolve_repo cfg with
30
28
| None -> search rest
31
-
| Some repo ->
32
-
match Opam_file.get_metadata ~repo_path:repo.path ~name ?version () with
29
+
| Some repo -> (
30
+
match
31
+
Opam_file.get_metadata ~repo_path:repo.path ~name ?version ()
32
+
with
33
33
| None -> search rest
34
-
| Some metadata -> Some { repo; metadata }
34
+
| Some metadata -> Some { repo; metadata }))
35
35
in
36
36
search repos
37
37
38
38
(** List all versions of a package across repositories. *)
39
39
let list_versions ~repos ~name : (repo * string list) list =
40
-
List.filter_map (fun cfg ->
41
-
match resolve_repo cfg with
42
-
| None -> None
43
-
| Some repo ->
44
-
let versions = Opam_file.list_versions ~repo_path:repo.path ~name in
45
-
if versions = [] then None
46
-
else Some (repo, versions)
47
-
) repos
40
+
List.filter_map
41
+
(fun cfg ->
42
+
match resolve_repo cfg with
43
+
| None -> None
44
+
| Some repo ->
45
+
let versions = Opam_file.list_versions ~repo_path:repo.path ~name in
46
+
if versions = [] then None else Some (repo, versions))
47
+
repos
48
48
49
49
(** Search for packages matching a pattern. *)
50
50
let search_packages ~repos ~pattern : (repo * string) list =
51
-
List.concat_map (fun cfg ->
52
-
match resolve_repo cfg with
53
-
| None -> []
54
-
| Some repo ->
55
-
let packages_dir = Filename.concat repo.path "packages" in
56
-
if not (Sys.file_exists packages_dir) then []
57
-
else
58
-
Sys.readdir packages_dir
59
-
|> Array.to_list
60
-
|> List.filter (fun name ->
61
-
(* Simple substring match *)
62
-
let pattern_lower = String.lowercase_ascii pattern in
63
-
let name_lower = String.lowercase_ascii name in
64
-
String.length pattern_lower <= String.length name_lower &&
65
-
(let rec check i =
66
-
if i > String.length name_lower - String.length pattern_lower then false
67
-
else if String.sub name_lower i (String.length pattern_lower) = pattern_lower then true
68
-
else check (i + 1)
69
-
in check 0))
70
-
|> List.map (fun name -> (repo, name))
71
-
) repos
51
+
List.concat_map
52
+
(fun cfg ->
53
+
match resolve_repo cfg with
54
+
| None -> []
55
+
| Some repo ->
56
+
let packages_dir = Filename.concat repo.path "packages" in
57
+
if not (Sys.file_exists packages_dir) then []
58
+
else
59
+
Sys.readdir packages_dir |> Array.to_list
60
+
|> List.filter (fun name ->
61
+
(* Simple substring match *)
62
+
let pattern_lower = String.lowercase_ascii pattern in
63
+
let name_lower = String.lowercase_ascii name in
64
+
String.length pattern_lower <= String.length name_lower
65
+
&&
66
+
let rec check i =
67
+
if i > String.length name_lower - String.length pattern_lower
68
+
then false
69
+
else if
70
+
String.sub name_lower i (String.length pattern_lower)
71
+
= pattern_lower
72
+
then true
73
+
else check (i + 1)
74
+
in
75
+
check 0)
76
+
|> List.map (fun name -> (repo, name)))
77
+
repos
+12
-15
lib/opam/repo.mli
+12
-15
lib/opam/repo.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Opam repository operations. *)
2
7
3
-
type repo = {
4
-
name : string;
5
-
path : string;
6
-
}
7
-
8
-
type search_result = {
9
-
repo : repo;
10
-
metadata : Opam_file.metadata;
11
-
}
8
+
type repo = { name : string; path : string }
9
+
type search_result = { repo : repo; metadata : Opam_file.metadata }
12
10
13
11
val find_package :
14
12
repos:Unpac.Config.repo_config list ->
···
16
14
?version:string ->
17
15
unit ->
18
16
search_result option
19
-
(** [find_package ~repos ~name ?version ()] searches for a package in repositories.
20
-
Returns the first match found. *)
17
+
(** [find_package ~repos ~name ?version ()] searches for a package in
18
+
repositories. Returns the first match found. *)
21
19
22
20
val list_versions :
23
21
repos:Unpac.Config.repo_config list ->
···
26
24
(** [list_versions ~repos ~name] lists all versions across repositories. *)
27
25
28
26
val search_packages :
29
-
repos:Unpac.Config.repo_config list ->
30
-
pattern:string ->
31
-
(repo * string) list
32
-
(** [search_packages ~repos ~pattern] searches for packages matching a pattern. *)
27
+
repos:Unpac.Config.repo_config list -> pattern:string -> (repo * string) list
28
+
(** [search_packages ~repos ~pattern] searches for packages matching a pattern.
29
+
*)
+72
-60
lib/opam/solver.ml
+72
-60
lib/opam/solver.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Dependency solver using 0install algorithm. *)
2
7
3
8
let ( / ) = Filename.concat
4
9
5
10
(** List directory entries, returns empty list if directory doesn't exist. *)
6
11
let list_dir path =
7
-
try Sys.readdir path |> Array.to_list
8
-
with Sys_error _ -> []
12
+
try Sys.readdir path |> Array.to_list with Sys_error _ -> []
9
13
10
14
(** Known compiler packages to filter out. *)
11
15
let is_compiler_package name =
12
16
let s = OpamPackage.Name.to_string name in
13
-
String.starts_with ~prefix:"ocaml-base-compiler" s ||
14
-
String.starts_with ~prefix:"ocaml-variants" s ||
15
-
String.starts_with ~prefix:"ocaml-system" s ||
16
-
String.starts_with ~prefix:"ocaml-config" s ||
17
-
s = "ocaml" ||
18
-
s = "base-unix" ||
19
-
s = "base-threads" ||
20
-
s = "base-bigarray" ||
21
-
s = "base-domains" ||
22
-
s = "base-nnp"
17
+
String.starts_with ~prefix:"ocaml-base-compiler" s
18
+
|| String.starts_with ~prefix:"ocaml-variants" s
19
+
|| String.starts_with ~prefix:"ocaml-system" s
20
+
|| String.starts_with ~prefix:"ocaml-config" s
21
+
|| s = "ocaml" || s = "base-unix" || s = "base-threads" || s = "base-bigarray"
22
+
|| s = "base-domains" || s = "base-nnp"
23
23
24
24
(** Check if a package has the compiler flag. *)
25
25
let has_compiler_flag opam =
···
34
34
?constraints:OpamFormula.version_constraint OpamTypes.name_map ->
35
35
repos:string list ->
36
36
ocaml_version:string ->
37
-
unit -> t
37
+
unit ->
38
+
t
38
39
end = struct
39
40
type rejection =
40
41
| UserConstraint of OpamFormula.atom
···
42
43
| CompilerPackage
43
44
44
45
let pp_rejection f = function
45
-
| UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
46
+
| UserConstraint x ->
47
+
Fmt.pf f "Rejected by user-specified constraint %s"
48
+
(OpamFormula.string_of_atom x)
46
49
| Unavailable -> Fmt.pf f "Availability condition not satisfied"
47
50
| CompilerPackage -> Fmt.pf f "Compiler package (filtered out)"
48
51
49
52
type t = {
50
-
repos : string list; (* List of packages/ directories *)
53
+
repos : string list; (* List of packages/ directories *)
51
54
constraints : OpamFormula.version_constraint OpamTypes.name_map;
52
55
ocaml_version : string;
53
56
}
···
67
70
let filter_deps t pkg f =
68
71
f
69
72
|> OpamFilter.partial_filter_formula (env t pkg)
70
-
|> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false ~dev:false ~dev_setup:false ~default:false
73
+
|> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false
74
+
~dev:false ~dev_setup:false ~default:false
71
75
72
76
let user_restrictions t name =
73
77
OpamPackage.Name.Map.find_opt name t.constraints
···
78
82
with _ -> None
79
83
80
84
(** Create a minimal virtual opam file for base packages. *)
81
-
let virtual_opam () =
82
-
OpamFile.OPAM.empty
85
+
let virtual_opam () = OpamFile.OPAM.empty
83
86
84
87
(** Find all versions of a package across all repos. *)
85
88
let find_versions t name =
86
89
let name_str = OpamPackage.Name.to_string name in
87
90
(* Collect versions from all repos, first repo wins for duplicates *)
88
91
let seen = Hashtbl.create 16 in
89
-
List.iter (fun packages_dir ->
90
-
let pkg_dir = packages_dir / name_str in
91
-
list_dir pkg_dir |> List.iter (fun entry ->
92
-
match OpamPackage.of_string_opt entry with
93
-
| Some pkg when OpamPackage.name pkg = name ->
94
-
let v = OpamPackage.version pkg in
95
-
if not (Hashtbl.mem seen v) then begin
96
-
let opam_path = pkg_dir / entry / "opam" in
97
-
Hashtbl.add seen v opam_path
98
-
end
99
-
| _ -> ()
100
-
)
101
-
) t.repos;
92
+
List.iter
93
+
(fun packages_dir ->
94
+
let pkg_dir = packages_dir / name_str in
95
+
list_dir pkg_dir
96
+
|> List.iter (fun entry ->
97
+
match OpamPackage.of_string_opt entry with
98
+
| Some pkg when OpamPackage.name pkg = name ->
99
+
let v = OpamPackage.version pkg in
100
+
if not (Hashtbl.mem seen v) then begin
101
+
let opam_path = pkg_dir / entry / "opam" in
102
+
Hashtbl.add seen v opam_path
103
+
end
104
+
| _ -> ()))
105
+
t.repos;
102
106
Hashtbl.fold (fun v path acc -> (v, path) :: acc) seen []
103
107
104
108
let candidates t name =
···
106
110
(* Provide virtual packages for compiler/base packages at the configured version *)
107
111
if name_str = "ocaml" then
108
112
let v = OpamPackage.Version.of_string t.ocaml_version in
109
-
[v, Ok (virtual_opam ())]
110
-
else if name_str = "base-unix" || name_str = "base-threads" ||
111
-
name_str = "base-bigarray" || name_str = "base-domains" ||
112
-
name_str = "base-nnp" then
113
+
[ (v, Ok (virtual_opam ())) ]
114
+
else if
115
+
name_str = "base-unix" || name_str = "base-threads"
116
+
|| name_str = "base-bigarray" || name_str = "base-domains"
117
+
|| name_str = "base-nnp"
118
+
then
113
119
let v = OpamPackage.Version.of_string "base" in
114
-
[v, Ok (virtual_opam ())]
120
+
[ (v, Ok (virtual_opam ())) ]
115
121
else if is_compiler_package name then
116
122
(* Other compiler packages - not available *)
117
123
[]
118
124
else
119
125
let user_constraints = user_restrictions t name in
120
126
find_versions t name
121
-
|> List.sort (fun (v1, _) (v2, _) -> OpamPackage.Version.compare v2 v1) (* Prefer newest *)
127
+
|> List.sort (fun (v1, _) (v2, _) -> OpamPackage.Version.compare v2 v1)
128
+
(* Prefer newest *)
122
129
|> List.map (fun (v, opam_path) ->
123
130
match user_constraints with
124
-
| Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) ->
125
-
v, Error (UserConstraint (name, Some test))
126
-
| _ ->
131
+
| Some test
132
+
when not
133
+
(OpamFormula.check_version_formula (OpamFormula.Atom test) v)
134
+
->
135
+
(v, Error (UserConstraint (name, Some test)))
136
+
| _ -> (
127
137
match load_opam opam_path with
128
-
| None -> v, Error Unavailable
129
-
| Some opam ->
130
-
(* Check flags:compiler *)
131
-
if has_compiler_flag opam then
132
-
v, Error CompilerPackage
138
+
| None -> (v, Error Unavailable)
139
+
| Some opam -> (
140
+
if
141
+
(* Check flags:compiler *)
142
+
has_compiler_flag opam
143
+
then (v, Error CompilerPackage)
133
144
else
134
145
(* Check available filter *)
135
146
let pkg = OpamPackage.create name v in
136
147
let available = OpamFile.OPAM.available opam in
137
-
match OpamFilter.eval ~default:(OpamTypes.B false) (env t pkg) available with
138
-
| B true -> v, Ok opam
139
-
| _ -> v, Error Unavailable
140
-
)
148
+
match
149
+
OpamFilter.eval ~default:(OpamTypes.B false) (env t pkg)
150
+
available
151
+
with
152
+
| B true -> (v, Ok opam)
153
+
| _ -> (v, Error Unavailable))))
141
154
142
-
let create ?(constraints=OpamPackage.Name.Map.empty) ~repos ~ocaml_version () =
155
+
let create ?(constraints = OpamPackage.Name.Map.empty) ~repos ~ocaml_version
156
+
() =
143
157
(* Convert repo roots to packages/ directories *)
144
158
let packages_dirs = List.map (fun r -> r / "packages") repos in
145
159
{ repos = packages_dirs; constraints; ocaml_version }
146
160
end
147
161
148
-
module Solver = Opam_0install.Solver.Make(Multi_context)
162
+
module Solver = Opam_0install.Solver.Make (Multi_context)
149
163
150
-
type solve_result = {
151
-
packages : OpamPackage.t list;
152
-
}
153
-
164
+
type solve_result = { packages : OpamPackage.t list }
154
165
type solve_error = string
155
166
156
167
(** Solve dependencies for a list of package names. *)
···
161
172
| Ok selections ->
162
173
let pkgs = Solver.packages_of_result selections in
163
174
(* Filter out compiler packages from result *)
164
-
let pkgs = List.filter (fun pkg ->
165
-
not (is_compiler_package (OpamPackage.name pkg))
166
-
) pkgs in
175
+
let pkgs =
176
+
List.filter
177
+
(fun pkg -> not (is_compiler_package (OpamPackage.name pkg)))
178
+
pkgs
179
+
in
167
180
Ok { packages = pkgs }
168
-
| Error diagnostics ->
169
-
Error (Solver.diagnostics diagnostics)
181
+
| Error diagnostics -> Error (Solver.diagnostics diagnostics)
+9
-3
lib/opam/solver.mli
+9
-3
lib/opam/solver.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Dependency solver using 0install algorithm.
2
7
3
8
Solves package dependencies across multiple configured opam repositories,
···
5
10
6
11
type solve_result = {
7
12
packages : OpamPackage.t list;
8
-
(** List of packages that need to be installed, including transitive deps. *)
13
+
(** List of packages that need to be installed, including transitive deps.
14
+
*)
9
15
}
10
16
11
17
type solve_error = string
···
29
35
filtered out since they are assumed to be pre-installed. *)
30
36
31
37
val is_compiler_package : OpamPackage.Name.t -> bool
32
-
(** [is_compiler_package name] returns true if [name] is a known compiler
33
-
or base package that should be filtered out. *)
38
+
(** [is_compiler_package name] returns true if [name] is a known compiler or
39
+
base package that should be filtered out. *)
+5
lib/unpac.ml
+5
lib/unpac.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Unpac - Multi-backend vendoring library using git worktrees. *)
2
7
3
8
(** {1 Core Modules} *)
+44
-40
lib/vendor_cache.ml
+44
-40
lib/vendor_cache.ml
···
1
-
(** Vendor cache - a persistent bare git repository for caching upstream fetches.
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Vendor cache - a persistent bare git repository for caching upstream
7
+
fetches.
2
8
3
9
The cache stores fetched repositories as remotes/branches, allowing multiple
4
10
unpac projects to share fetched content without re-downloading. *)
···
14
20
let cache_home =
15
21
match Sys.getenv_opt "XDG_CACHE_HOME" with
16
22
| Some dir -> dir
17
-
| None ->
23
+
| None -> (
18
24
match Sys.getenv_opt "HOME" with
19
25
| Some home -> Filename.concat home ".cache"
20
-
| None -> "/tmp"
26
+
| None -> "/tmp")
21
27
in
22
28
Filename.concat cache_home "unpac/vendor-cache"
23
29
24
30
(** {1 Initialization} *)
25
31
26
32
let init ~proc_mgr ~fs ?path () =
27
-
let cache_path = match path with
28
-
| Some p -> p
29
-
| None -> default_path ()
30
-
in
33
+
let cache_path = match path with Some p -> p | None -> default_path () in
31
34
let cache = Eio.Path.(fs / cache_path) in
32
35
33
36
(* Check if already initialized *)
34
-
if Eio.Path.is_directory cache then
35
-
cache
37
+
if Eio.Path.is_directory cache then cache
36
38
else begin
37
39
(* Create parent directories *)
38
40
let parent = Filename.dirname cache_path in
···
41
43
42
44
(* Initialize bare repository *)
43
45
Eio.Path.mkdirs ~exists_ok:false ~perm:0o755 cache;
44
-
Git.run_exn ~proc_mgr ~cwd:cache ["init"; "--bare"] |> ignore;
46
+
Git.run_exn ~proc_mgr ~cwd:cache [ "init"; "--bare" ] |> ignore;
45
47
cache
46
48
end
47
49
48
50
(** {1 Remote Naming}
49
51
50
-
We use URL-based remote names to avoid conflicts.
51
-
e.g., "github.com/dbuenzli/astring" for https://github.com/dbuenzli/astring.git *)
52
+
We use URL-based remote names to avoid conflicts. e.g.,
53
+
"github.com/dbuenzli/astring" for https://github.com/dbuenzli/astring.git *)
52
54
53
55
let url_to_remote_name url =
54
56
(* Strip protocol and .git suffix *)
55
57
let url =
56
-
let prefixes = ["https://"; "http://"; "git://"; "ssh://"; "git@"] in
57
-
List.fold_left (fun u prefix ->
58
-
if String.starts_with ~prefix u then
59
-
String.sub u (String.length prefix) (String.length u - String.length prefix)
60
-
else u
61
-
) url prefixes
58
+
let prefixes = [ "https://"; "http://"; "git://"; "ssh://"; "git@" ] in
59
+
List.fold_left
60
+
(fun u prefix ->
61
+
if String.starts_with ~prefix u then
62
+
String.sub u (String.length prefix)
63
+
(String.length u - String.length prefix)
64
+
else u)
65
+
url prefixes
62
66
in
63
67
let url =
64
68
if String.ends_with ~suffix:".git" url then
···
68
72
(* Replace : with / for git@ style URLs *)
69
73
String.map (fun c -> if c = ':' then '/' else c) url
70
74
71
-
let branch_name ~remote ~branch =
72
-
remote ^ "/" ^ branch
75
+
let branch_name ~remote ~branch = remote ^ "/" ^ branch
73
76
74
77
(** {1 Cache Operations} *)
75
78
···
80
83
81
84
let ensure_remote ~proc_mgr cache ~url =
82
85
let remote_name = url_to_remote_name url in
83
-
if has_remote ~proc_mgr cache remote_name then
84
-
remote_name
86
+
if has_remote ~proc_mgr cache remote_name then remote_name
85
87
else begin
86
-
Git.run_exn ~proc_mgr ~cwd:cache
87
-
["remote"; "add"; remote_name; url] |> ignore;
88
+
Git.run_exn ~proc_mgr ~cwd:cache [ "remote"; "add"; remote_name; url ]
89
+
|> ignore;
88
90
remote_name
89
91
end
90
92
···
104
106
let fetch_to_project ~proc_mgr ~cache ~project_git ~url ~branch =
105
107
(* First, fetch to cache (include tags, force update to avoid conflicts) *)
106
108
let remote_name = ensure_remote ~proc_mgr cache ~url in
107
-
Git.run_exn ~proc_mgr ~cwd:cache
108
-
["fetch"; "--tags"; "--force"; remote_name] |> ignore;
109
+
Git.run_exn ~proc_mgr ~cwd:cache [ "fetch"; "--tags"; "--force"; remote_name ]
110
+
|> ignore;
109
111
110
112
(* Determine if this is a branch or tag *)
111
113
let branch_ref = branch_name ~remote:remote_name ~branch in
···
115
117
let cache_ref =
116
118
match Git.rev_parse ~proc_mgr ~cwd:cache branch_ref with
117
119
| Some _ -> branch_ref
118
-
| None ->
120
+
| None -> (
119
121
(* Try as a tag *)
120
122
match Git.rev_parse ~proc_mgr ~cwd:cache tag_ref with
121
123
| Some _ -> tag_ref
122
-
| None -> failwith (Printf.sprintf "Ref not found: %s (tried branch %s and tag %s)"
123
-
branch branch_ref tag_ref)
124
+
| None ->
125
+
failwith
126
+
(Printf.sprintf "Ref not found: %s (tried branch %s and tag %s)"
127
+
branch branch_ref tag_ref))
124
128
in
125
129
126
130
(* Now fetch from cache into project *)
···
129
133
(* Add cache as a remote in project if not exists *)
130
134
let cache_remote = "vendor-cache" in
131
135
(match Git.remote_url ~proc_mgr ~cwd:project_git cache_remote with
132
-
| None ->
133
-
Git.run_exn ~proc_mgr ~cwd:project_git
134
-
["remote"; "add"; cache_remote; cache_path] |> ignore
135
-
| Some _ -> ());
136
+
| None ->
137
+
Git.run_exn ~proc_mgr ~cwd:project_git
138
+
[ "remote"; "add"; cache_remote; cache_path ]
139
+
|> ignore
140
+
| Some _ -> ());
136
141
137
142
(* Fetch the specific ref from cache *)
138
143
Git.run_exn ~proc_mgr ~cwd:project_git
139
-
["fetch"; cache_remote; cache_ref ^ ":" ^ cache_ref] |> ignore;
144
+
[ "fetch"; cache_remote; cache_ref ^ ":" ^ cache_ref ]
145
+
|> ignore;
140
146
141
147
cache_ref
142
148
143
149
(** {1 Listing} *)
144
150
145
151
let list_remotes ~proc_mgr cache =
146
-
Git.run_lines ~proc_mgr ~cwd:cache ["remote"]
152
+
Git.run_lines ~proc_mgr ~cwd:cache [ "remote" ]
147
153
148
154
let list_branches ~proc_mgr cache =
149
-
Git.run_lines ~proc_mgr ~cwd:cache ["branch"; "-a"]
155
+
Git.run_lines ~proc_mgr ~cwd:cache [ "branch"; "-a" ]
150
156
|> List.filter_map (fun line ->
151
157
let line = String.trim line in
152
158
if String.starts_with ~prefix:"* " line then
153
159
Some (String.sub line 2 (String.length line - 2))
154
-
else if line <> "" then
155
-
Some line
156
-
else
157
-
None)
160
+
else if line <> "" then Some line
161
+
else None)
+27
-12
lib/vendor_cache.mli
+27
-12
lib/vendor_cache.mli
···
1
-
(** Vendor cache - a persistent bare git repository for caching upstream fetches.
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Vendor cache - a persistent bare git repository for caching upstream
7
+
fetches.
2
8
3
9
The cache stores fetched repositories as remotes/branches, allowing multiple
4
10
unpac projects to share fetched content without re-downloading. *)
···
15
21
16
22
(** {1 Initialization} *)
17
23
18
-
val init : proc_mgr:Git.proc_mgr -> fs:Eio.Fs.dir_ty Eio.Path.t -> ?path:string -> unit -> t
19
-
(** [init ~proc_mgr ~fs ?path ()] initializes and returns the cache.
20
-
Creates the bare repository if it doesn't exist.
24
+
val init :
25
+
proc_mgr:Git.proc_mgr ->
26
+
fs:Eio.Fs.dir_ty Eio.Path.t ->
27
+
?path:string ->
28
+
unit ->
29
+
t
30
+
(** [init ~proc_mgr ~fs ?path ()] initializes and returns the cache. Creates the
31
+
bare repository if it doesn't exist.
21
32
@param path Optional custom cache path. Uses default if not provided. *)
22
33
23
34
(** {1 Remote Naming} *)
24
35
25
36
val url_to_remote_name : string -> string
26
-
(** [url_to_remote_name url] converts a git URL to a remote name.
27
-
e.g., "https://github.com/dbuenzli/astring.git" -> "github.com/dbuenzli/astring" *)
37
+
(** [url_to_remote_name url] converts a git URL to a remote name. e.g.,
38
+
"https://github.com/dbuenzli/astring.git" -> "github.com/dbuenzli/astring"
39
+
*)
28
40
29
41
val branch_name : remote:string -> branch:string -> string
30
42
(** [branch_name ~remote ~branch] returns the full branch name in cache. *)
···
35
47
(** [has_remote ~proc_mgr cache name] checks if a remote exists in cache. *)
36
48
37
49
val ensure_remote : proc_mgr:Git.proc_mgr -> t -> url:string -> string
38
-
(** [ensure_remote ~proc_mgr cache ~url] adds remote if needed, returns remote name. *)
50
+
(** [ensure_remote ~proc_mgr cache ~url] adds remote if needed, returns remote
51
+
name. *)
39
52
40
53
val fetch : proc_mgr:Git.proc_mgr -> t -> url:string -> string
41
-
(** [fetch ~proc_mgr cache ~url] fetches from URL into cache, returns remote name. *)
54
+
(** [fetch ~proc_mgr cache ~url] fetches from URL into cache, returns remote
55
+
name. *)
42
56
43
-
val get_ref : proc_mgr:Git.proc_mgr -> t -> url:string -> branch:string -> string option
57
+
val get_ref :
58
+
proc_mgr:Git.proc_mgr -> t -> url:string -> branch:string -> string option
44
59
(** [get_ref ~proc_mgr cache ~url ~branch] returns the SHA for a cached ref. *)
45
60
46
61
val fetch_to_project :
···
50
65
url:string ->
51
66
branch:string ->
52
67
string
53
-
(** [fetch_to_project ~proc_mgr ~cache ~project_git ~url ~branch]
54
-
fetches from upstream to cache, then from cache to project's bare repo.
55
-
Returns the cache ref name. *)
68
+
(** [fetch_to_project ~proc_mgr ~cache ~project_git ~url ~branch] fetches from
69
+
upstream to cache, then from cache to project's bare repo. Returns the cache
70
+
ref name. *)
56
71
57
72
(** {1 Listing} *)
58
73
+43
-27
lib/worktree.ml
+43
-27
lib/worktree.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Git worktree lifecycle management for unpac.
2
7
3
-
Manages creation, cleanup, and paths of worktrees within the unpac
4
-
directory structure. All branch operations happen in isolated worktrees. *)
8
+
Manages creation, cleanup, and paths of worktrees within the unpac directory
9
+
structure. All branch operations happen in isolated worktrees. *)
5
10
6
11
(** {1 Types} *)
7
12
···
13
18
| Project of string
14
19
| Opam_upstream of string
15
20
| Opam_vendor of string
16
-
| Opam_patches of string
17
-
(** Worktree kinds with their associated names. *)
21
+
| Opam_patches of string (** Worktree kinds with their associated names. *)
18
22
19
23
(** {1 Path and Branch Helpers} *)
20
24
21
-
let git_dir root = Eio.Path.(root / "git")
22
25
(** Path to the bare git repository. *)
26
+
let git_dir root = Eio.Path.(root / "git")
23
27
24
28
let path root = function
25
29
| Main -> Eio.Path.(root / "main")
···
59
63
else begin
60
64
let git = git_dir root in
61
65
let wt_path = path root kind in
62
-
let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
66
+
let rel_path = "../" ^ relative_path kind in
67
+
(* Relative to git/ dir *)
63
68
let br = branch kind in
64
69
65
70
(* Ensure parent directories exist *)
···
67
72
Option.iter (fun p -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p) parent;
68
73
69
74
(* Create worktree *)
70
-
Git.run_exn ~proc_mgr ~cwd:git
71
-
["worktree"; "add"; rel_path; br] |> ignore
75
+
Git.run_exn ~proc_mgr ~cwd:git [ "worktree"; "add"; rel_path; br ] |> ignore
72
76
end
73
77
74
78
let ensure_orphan ~proc_mgr root kind =
···
76
80
else begin
77
81
let git = git_dir root in
78
82
let wt_path = path root kind in
79
-
let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
83
+
let rel_path = "../" ^ relative_path kind in
84
+
(* Relative to git/ dir *)
80
85
let br = branch kind in
81
86
82
87
(* Ensure parent directories exist *)
···
84
89
Option.iter (fun p -> Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p) parent;
85
90
86
91
(* Create a detached worktree from main branch, then make it an orphan *)
87
-
let start_commit = Git.run_exn ~proc_mgr ~cwd:git ["rev-parse"; "main"] |> String.trim in
92
+
let start_commit =
93
+
Git.run_exn ~proc_mgr ~cwd:git [ "rev-parse"; "main" ] |> String.trim
94
+
in
88
95
Git.run_exn ~proc_mgr ~cwd:git
89
-
["worktree"; "add"; "--detach"; rel_path; start_commit] |> ignore;
96
+
[ "worktree"; "add"; "--detach"; rel_path; start_commit ]
97
+
|> ignore;
90
98
91
99
(* Now in the worktree, create an orphan branch and clear files *)
92
-
Git.run_exn ~proc_mgr ~cwd:wt_path ["checkout"; "--orphan"; br] |> ignore;
100
+
Git.run_exn ~proc_mgr ~cwd:wt_path [ "checkout"; "--orphan"; br ] |> ignore;
93
101
(* Remove all tracked files from index *)
94
-
Git.run_exn ~proc_mgr ~cwd:wt_path ["rm"; "-rf"; "--cached"; "."] |> ignore;
102
+
Git.run_exn ~proc_mgr ~cwd:wt_path [ "rm"; "-rf"; "--cached"; "." ]
103
+
|> ignore;
95
104
(* Clean the working directory *)
96
-
Git.run_exn ~proc_mgr ~cwd:wt_path ["clean"; "-fd"] |> ignore
105
+
Git.run_exn ~proc_mgr ~cwd:wt_path [ "clean"; "-fd" ] |> ignore
97
106
end
98
107
99
108
let ensure_detached ~proc_mgr root kind ~commit =
···
101
110
else begin
102
111
let git = git_dir root in
103
112
let wt_path = path root kind in
104
-
let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
113
+
let rel_path = "../" ^ relative_path kind in
114
+
(* Relative to git/ dir *)
105
115
106
116
(* Ensure parent directories exist *)
107
117
let parent = Eio.Path.split wt_path |> Option.map fst in
···
109
119
110
120
(* Create detached worktree at commit *)
111
121
Git.run_exn ~proc_mgr ~cwd:git
112
-
["worktree"; "add"; "--detach"; rel_path; commit] |> ignore
122
+
[ "worktree"; "add"; "--detach"; rel_path; commit ]
123
+
|> ignore
113
124
end
114
125
115
126
let remove ~proc_mgr root kind =
116
127
if not (exists root kind) then ()
117
128
else begin
118
129
let git = git_dir root in
119
-
let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
120
-
Git.run_exn ~proc_mgr ~cwd:git
121
-
["worktree"; "remove"; rel_path] |> ignore
130
+
let rel_path = "../" ^ relative_path kind in
131
+
(* Relative to git/ dir *)
132
+
Git.run_exn ~proc_mgr ~cwd:git [ "worktree"; "remove"; rel_path ] |> ignore
122
133
end
123
134
124
135
let remove_force ~proc_mgr root kind =
125
136
if not (exists root kind) then ()
126
137
else begin
127
138
let git = git_dir root in
128
-
let rel_path = "../" ^ relative_path kind in (* Relative to git/ dir *)
129
-
Git.run_exn ~proc_mgr ~cwd:git
130
-
["worktree"; "remove"; "--force"; rel_path] |> ignore
139
+
let rel_path = "../" ^ relative_path kind in
140
+
(* Relative to git/ dir *)
141
+
Git.run_exn ~proc_mgr ~cwd:git [ "worktree"; "remove"; "--force"; rel_path ]
142
+
|> ignore
131
143
end
132
144
133
145
let with_temp ~proc_mgr root kind f =
···
146
158
147
159
let list_worktrees ~proc_mgr root =
148
160
let git = git_dir root in
149
-
Git.run_lines ~proc_mgr ~cwd:git ["worktree"; "list"; "--porcelain"]
161
+
Git.run_lines ~proc_mgr ~cwd:git [ "worktree"; "list"; "--porcelain" ]
150
162
|> List.filter_map (fun line ->
151
163
if String.starts_with ~prefix:"worktree " line then
152
164
Some (String.sub line 9 (String.length line - 9))
···
154
166
155
167
let list_projects ~proc_mgr root =
156
168
let git = git_dir root in
157
-
Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--list"; "project/*"]
169
+
Git.run_lines ~proc_mgr ~cwd:git [ "branch"; "--list"; "project/*" ]
158
170
|> List.filter_map (fun line ->
159
171
let line = String.trim line in
160
172
(* Strip "* " (current) or "+ " (linked worktree) prefix *)
161
173
let line =
162
-
if String.starts_with ~prefix:"* " line || String.starts_with ~prefix:"+ " line
174
+
if
175
+
String.starts_with ~prefix:"* " line
176
+
|| String.starts_with ~prefix:"+ " line
163
177
then String.sub line 2 (String.length line - 2)
164
178
else line
165
179
in
···
169
183
170
184
let list_opam_packages ~proc_mgr root =
171
185
let git = git_dir root in
172
-
Git.run_lines ~proc_mgr ~cwd:git ["branch"; "--list"; "opam/patches/*"]
186
+
Git.run_lines ~proc_mgr ~cwd:git [ "branch"; "--list"; "opam/patches/*" ]
173
187
|> List.filter_map (fun line ->
174
188
let line = String.trim line in
175
189
(* Strip "* " (current) or "+ " (linked worktree) prefix *)
176
190
let line =
177
-
if String.starts_with ~prefix:"* " line || String.starts_with ~prefix:"+ " line
191
+
if
192
+
String.starts_with ~prefix:"* " line
193
+
|| String.starts_with ~prefix:"+ " line
178
194
then String.sub line 2 (String.length line - 2)
179
195
else line
180
196
in
+34
-19
lib/worktree.mli
+34
-19
lib/worktree.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Git worktree lifecycle management for unpac.
2
7
3
-
Manages creation, cleanup, and paths of worktrees within the unpac
4
-
directory structure. All branch operations happen in isolated worktrees.
8
+
Manages creation, cleanup, and paths of worktrees within the unpac directory
9
+
structure. All branch operations happen in isolated worktrees.
5
10
6
11
{2 Directory Structure}
7
12
···
31
36
| Project of string
32
37
| Opam_upstream of string
33
38
| Opam_vendor of string
34
-
| Opam_patches of string
35
-
(** Worktree kinds with their associated names. *)
39
+
| Opam_patches of string (** Worktree kinds with their associated names. *)
36
40
37
41
(** {1 Path and Branch Helpers} *)
38
42
···
56
60
(** {1 Operations} *)
57
61
58
62
val ensure : proc_mgr:Git.proc_mgr -> root -> kind -> unit
59
-
(** [ensure ~proc_mgr root kind] creates the worktree if it doesn't exist.
60
-
The branch must already exist. *)
63
+
(** [ensure ~proc_mgr root kind] creates the worktree if it doesn't exist. The
64
+
branch must already exist. *)
61
65
62
66
val ensure_orphan : proc_mgr:Git.proc_mgr -> root -> kind -> unit
63
-
(** [ensure_orphan ~proc_mgr root kind] creates an orphan worktree.
64
-
Creates a new orphan branch. *)
67
+
(** [ensure_orphan ~proc_mgr root kind] creates an orphan worktree. Creates a
68
+
new orphan branch. *)
65
69
66
-
val ensure_detached : proc_mgr:Git.proc_mgr -> root -> kind -> commit:string -> unit
67
-
(** [ensure_detached ~proc_mgr root kind ~commit] creates a detached worktree
68
-
at the given commit. Does not create a branch. *)
70
+
val ensure_detached :
71
+
proc_mgr:Git.proc_mgr -> root -> kind -> commit:string -> unit
72
+
(** [ensure_detached ~proc_mgr root kind ~commit] creates a detached worktree at
73
+
the given commit. Does not create a branch. *)
69
74
70
75
val remove : proc_mgr:Git.proc_mgr -> root -> kind -> unit
71
76
(** [remove ~proc_mgr root kind] removes the worktree (keeps the branch). *)
···
73
78
val remove_force : proc_mgr:Git.proc_mgr -> root -> kind -> unit
74
79
(** [remove_force ~proc_mgr root kind] forcibly removes the worktree. *)
75
80
76
-
val with_temp : proc_mgr:Git.proc_mgr -> root -> kind -> (Eio.Fs.dir_ty Eio.Path.t -> 'a) -> 'a
77
-
(** [with_temp ~proc_mgr root kind f] creates the worktree, runs [f] with
78
-
the worktree path, then removes the worktree. *)
81
+
val with_temp :
82
+
proc_mgr:Git.proc_mgr ->
83
+
root ->
84
+
kind ->
85
+
(Eio.Fs.dir_ty Eio.Path.t -> 'a) ->
86
+
'a
87
+
(** [with_temp ~proc_mgr root kind f] creates the worktree, runs [f] with the
88
+
worktree path, then removes the worktree. *)
79
89
80
-
val with_temp_orphan : proc_mgr:Git.proc_mgr -> root -> kind -> (Eio.Fs.dir_ty Eio.Path.t -> 'a) -> 'a
81
-
(** [with_temp_orphan ~proc_mgr root kind f] creates an orphan worktree,
82
-
runs [f], then removes the worktree. *)
90
+
val with_temp_orphan :
91
+
proc_mgr:Git.proc_mgr ->
92
+
root ->
93
+
kind ->
94
+
(Eio.Fs.dir_ty Eio.Path.t -> 'a) ->
95
+
'a
96
+
(** [with_temp_orphan ~proc_mgr root kind f] creates an orphan worktree, runs
97
+
[f], then removes the worktree. *)
83
98
84
99
(** {1 Listing} *)
85
100
···
90
105
(** [list_projects ~proc_mgr root] returns names of all project branches. *)
91
106
92
107
val list_opam_packages : proc_mgr:Git.proc_mgr -> root -> string list
93
-
(** [list_opam_packages ~proc_mgr root] returns names of all vendored opam packages
94
-
(packages with opam/patches/* branches). *)
108
+
(** [list_opam_packages ~proc_mgr root] returns names of all vendored opam
109
+
packages (packages with opam/patches/* branches). *)
+5
-1
unpac-opam.opam
+5
-1
unpac-opam.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
3
synopsis: "Opam backend for unpac"
4
-
description: "Opam package vendoring backend for unpac"
4
+
description:
5
+
"Opam package vendoring backend for unpac. Provides opam repository integration for dependency resolution and vendoring."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
5
7
authors: ["Anil Madhavapeddy"]
6
8
license: "ISC"
9
+
homepage: "https://tangled.org/@anil.recoil.org/unpac"
10
+
bug-reports: "https://tangled.org/@anil.recoil.org/unpac/issues"
7
11
depends: [
8
12
"dune" {>= "3.20"}
9
13
"ocaml" {>= "5.1.0"}
+4
-1
unpac.opam
+4
-1
unpac.opam
···
2
2
opam-version: "2.0"
3
3
synopsis: "Monorepo management tool"
4
4
description:
5
-
"A tool for managing OCaml monorepos with opam repository integration"
5
+
"A tool for managing OCaml monorepos with opam repository integration. Unpac handles vendoring dependencies, managing worktrees, and synchronizing packages across a monorepo."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
6
7
authors: ["Anil Madhavapeddy"]
7
8
license: "ISC"
9
+
homepage: "https://tangled.org/@anil.recoil.org/unpac"
10
+
bug-reports: "https://tangled.org/@anil.recoil.org/unpac/issues"
8
11
depends: [
9
12
"dune" {>= "3.20"}
10
13
"ocaml" {>= "5.1.0"}