forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Port monorepo to latest ocaml-wire (opam pin)
Migrate all consumers to the new wire API:
- wire.c library → wire.3d (Wire_c → Wire_3d)
- Wire.struct_/module_ → Wire.Everparse.struct_/module_
- Wire.Codec: record/|+/seal → Codec.v with Field.v and $
- Wire.bf_uint* → Wire.U8/U16/U16be/U32/U32be
- Wire.UInt32 → Wire.Private.UInt32
- Wire.cases → Wire.lookup, Wire.map now uses labeled args
- Wire.Codec.decode now returns result
- Add wire pin to root.opam.template
+197
-61
+4
-1
bin/cmd_diff.ml
+4
-1
bin/cmd_diff.ml
···
10
10
let base, tip =
11
11
if incoming then ("HEAD", "origin/main") else ("origin/main", "HEAD")
12
12
in
13
-
let repo = Git.Repository.open_repo ~fs:fs_t checkout_path in
13
+
let repo =
14
+
Eio.Switch.run @@ fun sw ->
15
+
Git.Repository.open_repo ~sw ~fs:fs_t checkout_path
16
+
in
14
17
match Git.Repository.log_range_refs repo ~base ~tip ~max_count:20 () with
15
18
| Ok [] -> false
16
19
| Ok entries ->
+3
-1
lib/clean.ml
+3
-1
lib/clean.ml
···
34
34
let check_and_fix ~fs_t ~dry_run ~name ~check_fn ~fix_fn path =
35
35
if not (Git.Repository.is_repo ~fs:fs_t path) then None
36
36
else
37
-
let repo = Git.Repository.open_repo ~fs:fs_t path in
37
+
let repo =
38
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs:fs_t path
39
+
in
38
40
match Git.Repository.head repo with
39
41
| None -> None
40
42
| Some head ->
+7
-2
lib/cross_status.ml
+7
-2
lib/cross_status.ml
···
140
140
141
141
(** Get subtree info for a given prefix in a monorepo. *)
142
142
let subtree_info ~fs ~monorepo_path ~prefix () : subtree_info =
143
-
let repo = Git.Repository.open_repo ~fs monorepo_path in
143
+
let repo =
144
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo_path
145
+
in
144
146
let upstream_commit =
145
147
Git.Repository.subtree_last_upstream_commit repo ~prefix
146
148
in
···
157
159
(* Try to compare using checkout if available *)
158
160
if not (Git.Repository.is_repo ~fs checkout_path) then Unknown
159
161
else begin
160
-
let repo = Git.Repository.open_repo ~fs checkout_path in
162
+
let repo =
163
+
Eio.Switch.run @@ fun sw ->
164
+
Git.Repository.open_repo ~sw ~fs checkout_path
165
+
in
161
166
let my_hash = Git.Hash.of_hex my in
162
167
let their_hash = Git.Hash.of_hex their in
163
168
(* Check if either is ancestor of the other *)
+3
-1
lib/ctx.ml
+3
-1
lib/ctx.ml
···
200
200
let branch = branch ~config pkg in
201
201
if not (Git.Repository.is_repo ~fs checkout_dir) then 0
202
202
else
203
-
let repo = Git.Repository.open_repo ~fs checkout_dir in
203
+
let repo =
204
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs checkout_dir
205
+
in
204
206
match Git.Repository.ahead_behind repo ~branch () with
205
207
| Some ab -> ab.behind
206
208
| None -> 0
+15
-4
lib/diff.ml
+15
-4
lib/diff.ml
···
115
115
let checkout_path = Fpath.(checkouts_path / repo_name) in
116
116
if not (Git.Repository.is_repo ~fs checkout_path) then None
117
117
else begin
118
-
let repo = Git.Repository.open_repo ~fs checkout_path in
118
+
let repo =
119
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs checkout_path
120
+
in
119
121
let remote_name = "verse/" ^ handle in
120
122
let my_ref = "origin/main" in
121
123
let their_ref = remote_name ^ "/main" in
···
186
188
let checkout_path = Fpath.(checkouts_path / r.repo_name) in
187
189
if not (Git.Repository.is_repo ~fs checkout_path) then None
188
190
else
189
-
let repo = Git.Repository.open_repo ~fs checkout_path in
191
+
let repo =
192
+
Eio.Switch.run @@ fun sw ->
193
+
Git.Repository.open_repo ~sw ~fs checkout_path
194
+
in
190
195
List.find_map
191
196
(fun (handle, _src, rel) ->
192
197
match rel with
···
246
251
if not (Git.Repository.is_repo ~fs checkout_path) then
247
252
[ Skipped r.repo_name ]
248
253
else begin
249
-
let git_repo = Git.Repository.open_repo ~fs checkout_path in
254
+
let git_repo =
255
+
Eio.Switch.run @@ fun sw ->
256
+
Git.Repository.open_repo ~sw ~fs checkout_path
257
+
in
250
258
match rel with
251
259
| Forks.Same_url | Forks.Same_commit | Forks.I_am_ahead _
252
260
| Forks.Not_fetched | Forks.Unrelated ->
···
311
319
(Ctx.Config_error
312
320
(Fmt.str "No checkout for repository %s" info.commit_repo))
313
321
else begin
314
-
let git_repo = Git.Repository.open_repo ~fs checkout_path in
322
+
let git_repo =
323
+
Eio.Switch.run @@ fun sw ->
324
+
Git.Repository.open_repo ~sw ~fs checkout_path
325
+
in
315
326
match Git.Repository.cherry_pick git_repo ~commit:info.commit_hash with
316
327
| Ok _new_hash ->
317
328
Ok
+12
-4
lib/doctor.ml
+12
-4
lib/doctor.ml
···
369
369
370
370
(** Analyze a single remote for a checkout *)
371
371
let analyze_remote ~fs ~checkout_dir ~remote_name =
372
-
let repo = Git.Repository.open_repo ~fs checkout_dir in
372
+
let repo =
373
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs checkout_dir
374
+
in
373
375
let url =
374
376
Git.Repository.remote_url repo remote_name
375
377
|> Option.value ~default:"(unknown)"
···
403
405
404
406
(** Analyze all remotes for a checkout *)
405
407
let analyze_checkout_remotes ~fs ~checkout_dir =
406
-
let repo = Git.Repository.open_repo ~fs checkout_dir in
408
+
let repo =
409
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs checkout_dir
410
+
in
407
411
let remotes = Git.Repository.list_remotes repo in
408
412
List.map
409
413
(fun remote_name -> analyze_remote ~fs ~checkout_dir ~remote_name)
···
808
812
let warnings = ref [] in
809
813
let opam_repo = Config.Paths.opam_repo config in
810
814
if Git.Repository.is_repo ~fs opam_repo then begin
811
-
let repo = Git.Repository.open_repo ~fs opam_repo in
815
+
let repo =
816
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
817
+
in
812
818
if Git.Repository.is_dirty repo then
813
819
warnings := "opam-repo has uncommitted changes" :: !warnings
814
820
end;
815
821
let monorepo = Config.Paths.monorepo config in
816
822
if Git.Repository.is_repo ~fs monorepo then begin
817
-
let repo = Git.Repository.open_repo ~fs monorepo in
823
+
let repo =
824
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
825
+
in
818
826
if Git.Repository.is_dirty repo then
819
827
warnings := "monorepo has uncommitted changes" :: !warnings
820
828
end;
+9
-3
lib/feature.ml
+9
-3
lib/feature.ml
···
47
47
let mono = Verse_config.mono_path config in
48
48
let work_dir = work_path config in
49
49
let wt_path = path config name in
50
-
let repo = Git.Repository.open_repo ~fs mono in
50
+
let repo =
51
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs mono
52
+
in
51
53
let wt = Git.Repository.worktree repo in
52
54
(* Check if feature already exists *)
53
55
if Git.Worktree.exists wt ~path:wt_path then Error (Feature_exists name)
···
67
69
let remove ~fs ~config ~name ~force () =
68
70
let mono = Verse_config.mono_path config in
69
71
let wt_path = path config name in
70
-
let repo = Git.Repository.open_repo ~fs mono in
72
+
let repo =
73
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs mono
74
+
in
71
75
let wt = Git.Repository.worktree repo in
72
76
(* Check if feature exists *)
73
77
if not (Git.Worktree.exists wt ~path:wt_path) then
···
80
84
let list ~fs ~config () =
81
85
let mono = Verse_config.mono_path config in
82
86
let work_dir = work_path config in
83
-
let repo = Git.Repository.open_repo ~fs mono in
87
+
let repo =
88
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs mono
89
+
in
84
90
let wt = Git.Repository.worktree repo in
85
91
let all_worktrees =
86
92
Git.Worktree.list wt ~head:(Git.Repository.head repo)
+49
-16
lib/fork_join.ml
+49
-16
lib/fork_join.ml
···
391
391
let src_exists = is_directory ~fs src_path in
392
392
let has_subtree_hist =
393
393
if mono_exists then
394
-
let repo = Git.Repository.open_repo ~fs monorepo in
394
+
let repo =
395
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
396
+
in
395
397
Git.Repository.has_subtree_history repo ~prefix
396
398
else false
397
399
in
···
746
748
747
749
(** Execute git config action. *)
748
750
let exec_git_config ~fs ~repo ~key ~value =
749
-
let git_repo = Git.Repository.open_repo ~fs repo in
751
+
let git_repo =
752
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
753
+
in
750
754
let config =
751
755
match Git.Repository.read_config git_repo with
752
756
| Some c -> c
···
763
767
764
768
(** Execute subtree split action. *)
765
769
let exec_subtree_split ~fs ~state ~repo ~prefix =
766
-
let git_repo = Git.Repository.open_repo ~fs repo in
770
+
let git_repo =
771
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
772
+
in
767
773
match Git.Repository.read_ref git_repo "HEAD" with
768
774
| None -> Error (Git_error (Git_cli.Io_error "no HEAD ref found"))
769
775
| Some head -> (
···
779
785
match Git_cli.fetch_url ~proc ~fs ~repo ~url ~branch () with
780
786
| Error e -> Error (Git_error e)
781
787
| Ok hash_hex -> (
782
-
let git_repo = Git.Repository.open_repo ~fs repo in
788
+
let git_repo =
789
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
790
+
in
783
791
let commit = Git.Hash.of_hex hash_hex in
784
792
let user =
785
793
match Git_cli.global_git_user ~fs () with
···
829
837
ensure_dir ~fs path;
830
838
Ok ()
831
839
| Git_init path ->
832
-
let (_ : Git.Repository.t) = Git.Repository.init ~fs path in
840
+
let (_ : Git.Repository.t) =
841
+
Eio.Switch.run @@ fun sw -> Git.Repository.init ~sw ~fs path
842
+
in
833
843
Ok ()
834
844
| Git_config { repo; key; value } -> exec_git_config ~fs ~repo ~key ~value
835
845
| Git_clone { url; dest; branch } ->
···
840
850
| Git_subtree_add { repo; prefix; url; branch } ->
841
851
exec_subtree_add ~proc ~fs ~repo ~prefix ~url ~branch
842
852
| Git_add_remote { repo; name; url } ->
843
-
let git_repo = Git.Repository.open_repo ~fs repo in
853
+
let git_repo =
854
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
855
+
in
844
856
Git.Repository.add_remote git_repo ~name ~url ()
845
857
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
846
858
| Git_push_ref { repo; target; ref_spec } ->
···
848
860
Git_cli.push_ref ~proc ~fs ~repo ~target ~ref_spec ()
849
861
|> Result.map_error (fun e -> Git_error e)
850
862
| Git_checkout { repo; branch } ->
851
-
let git_repo = Git.Repository.open_repo ~fs repo in
863
+
let git_repo =
864
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
865
+
in
852
866
Git.Repository.checkout_ref git_repo branch
853
867
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
854
868
| Git_branch_rename { repo; new_name } ->
855
-
let git_repo = Git.Repository.open_repo ~fs repo in
869
+
let git_repo =
870
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
871
+
in
856
872
Git.Repository.rename_branch git_repo ~new_name
857
873
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
858
874
| Copy_directory { src; dest } ->
859
875
copy_directory ~fs ~src ~dest;
860
876
Ok ()
861
877
| Git_add_all path ->
862
-
let git_repo = Git.Repository.open_repo ~fs path in
878
+
let git_repo =
879
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs path
880
+
in
863
881
Git.Repository.add_all git_repo
864
882
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
865
883
| Git_commit { repo; message } ->
866
-
let git_repo = Git.Repository.open_repo ~fs repo in
884
+
let git_repo =
885
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
886
+
in
867
887
Git.Repository.commit git_repo ~message
868
888
|> Result.map (fun _ -> ())
869
889
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
870
890
| Git_rm { repo; path; recursive } ->
871
-
let git_repo = Git.Repository.open_repo ~fs repo in
891
+
let git_repo =
892
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
893
+
in
872
894
Git.Repository.rm git_repo ~recursive path
873
895
|> Result.map_error (fun (`Msg msg) -> Git_error (Git_cli.Io_error msg))
874
896
| Update_sources_toml { path; name; entry } ->
···
948
970
| None -> ()
949
971
950
972
let fork_add_push_remote ~fs ~src_path ~push_url =
951
-
let checkout_repo = Git.Repository.open_repo ~fs src_path in
973
+
let checkout_repo =
974
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs src_path
975
+
in
952
976
match push_url with
953
977
| Some url ->
954
978
Git.Repository.add_remote checkout_repo ~name:"origin" ~url ()
···
957
981
958
982
let fork_init_and_push ~proc ~fs ~monorepo ~checkouts ~src_path ~split_commit =
959
983
ensure_dir ~fs checkouts;
960
-
let git_repo = Git.Repository.init ~fs src_path in
984
+
let git_repo =
985
+
Eio.Switch.run @@ fun sw -> Git.Repository.init ~sw ~fs src_path
986
+
in
961
987
let mono_str = Fpath.to_string monorepo in
962
988
match Git.Repository.add_remote git_repo ~name:"mono" ~url:mono_str () with
963
989
| Error (`Msg msg) -> Error (Git_error (Git_cli.Io_error msg))
···
969
995
with
970
996
| Error e -> Error (Git_error e)
971
997
| Ok () ->
972
-
let checkout_repo = Git.Repository.open_repo ~fs src_path in
998
+
let checkout_repo =
999
+
Eio.Switch.run @@ fun sw ->
1000
+
Git.Repository.open_repo ~sw ~fs src_path
1001
+
in
973
1002
Git.Repository.checkout_ref checkout_repo "main"
974
1003
|> Result.map_error (fun (`Msg msg) ->
975
1004
Git_error (Git_cli.Io_error msg)))
···
996
1025
packages_created = packages;
997
1026
}
998
1027
else begin
999
-
let git_repo = Git.Repository.open_repo ~fs monorepo in
1028
+
let git_repo =
1029
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
1030
+
in
1000
1031
match Git.Repository.read_ref git_repo "HEAD" with
1001
1032
| None -> Error (Git_error (Git_cli.Io_error "no HEAD ref found"))
1002
1033
| Some head -> (
···
1060
1091
match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with
1061
1092
| Error e -> Error (Git_error e)
1062
1093
| Ok hash_hex ->
1063
-
let git_repo = Git.Repository.open_repo ~fs monorepo in
1094
+
let git_repo =
1095
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
1096
+
in
1064
1097
let commit = Git.Hash.of_hex hash_hex in
1065
1098
let user =
1066
1099
match Git_cli.global_git_user ~fs () with
+12
-4
lib/forks.ml
+12
-4
lib/forks.ml
···
582
582
583
583
(** Check if a remote exists *)
584
584
let remote_exists ~proc:_ ~fs ~repo remote_name =
585
-
let git_repo = Git.Repository.open_repo ~fs repo in
585
+
let git_repo =
586
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
587
+
in
586
588
match Git.Repository.remote_url git_repo remote_name with
587
589
| Some _ -> true
588
590
| None -> false
589
591
590
592
(** Add a git remote *)
591
593
let add_remote ~proc:_ ~fs ~repo ~name ~url () =
592
-
let git_repo = Git.Repository.open_repo ~fs repo in
594
+
let git_repo =
595
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
596
+
in
593
597
Log.debug (fun m ->
594
598
m "Adding remote %s -> %a (in %a)" name Uri.pp url Fpath.pp repo);
595
599
Git.Repository.add_remote git_repo ~name ~url:(Uri.to_string url) ()
···
624
628
625
629
(** Get the commit hash for a ref *)
626
630
let ref_commit ~fs ~repo ref_name =
627
-
let git_repo = Git.Repository.open_repo ~fs repo in
631
+
let git_repo =
632
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
633
+
in
628
634
(* Handle refs like "origin/main" or "verse/handle/main" *)
629
635
let ref_path =
630
636
if String.contains ref_name '/' then "refs/remotes/" ^ ref_name
···
643
649
| Some my_hash, Some their_hash when Git.Hash.equal my_hash their_hash ->
644
650
Same_commit
645
651
| Some my_hash, Some their_hash -> (
646
-
let git_repo = Git.Repository.open_repo ~fs repo in
652
+
let git_repo =
653
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs repo
654
+
in
647
655
let my_is_ancestor =
648
656
Git.Rev_list.is_ancestor git_repo ~ancestor:my_hash
649
657
~descendant:their_hash
+10
-3
lib/import.ml
+10
-3
lib/import.ml
···
91
91
92
92
(** Commit staged changes using ocaml-git with fallback user *)
93
93
let git_commit ~fs ~target ~message =
94
-
let git_repo = Git.Repository.open_repo ~fs target in
94
+
let git_repo =
95
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs target
96
+
in
95
97
let user = git_user ~fs () in
96
98
Git.Repository.commit_index git_repo ~author:user ~committer:user ~message ()
97
99
···
123
125
with
124
126
| Error e -> err_git_fetch_failed e
125
127
| Ok hash_hex -> (
126
-
let git_repo = Git.Repository.open_repo ~fs target in
128
+
let git_repo =
129
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs target
130
+
in
127
131
let commit = Git.Hash.of_hex hash_hex in
128
132
let user = git_user ~fs () in
129
133
let message =
···
308
312
in
309
313
match Sources_registry.save ~fs sources_path sources with
310
314
| Ok () -> (
311
-
let git_repo = Git.Repository.open_repo ~fs target in
315
+
let git_repo =
316
+
Eio.Switch.run @@ fun sw ->
317
+
Git.Repository.open_repo ~sw ~fs target
318
+
in
312
319
match
313
320
Git.Repository.add_to_index git_repo [ "sources.toml" ]
314
321
with
+6
-2
lib/init.ml
+6
-2
lib/init.ml
···
315
315
316
316
let setup_and_commit ~fs ~monorepo ~monorepo_eio =
317
317
Log.info (fun m -> m "Initializing monorepo at %a" Fpath.pp monorepo);
318
-
let (_ : Git.Repository.t) = Git.Repository.init ~fs monorepo in
318
+
let (_ : Git.Repository.t) =
319
+
Eio.Switch.run @@ fun sw -> Git.Repository.init ~sw ~fs monorepo
320
+
in
319
321
let dune_project = Eio.Path.(monorepo_eio / "dune-project") in
320
322
Log.debug (fun m -> m "Creating dune-project file");
321
323
Eio.Path.save ~create:(`Or_truncate 0o644) dune_project "(lang dune 3.20)\n";
···
326
328
Log.debug (fun m -> m "Creating .gitignore");
327
329
Eio.Path.save ~create:(`Or_truncate 0o644) gitignore gitignore_content;
328
330
Log.debug (fun m -> m "Staging and committing initial files");
329
-
let repo = Git.Repository.open_repo ~fs monorepo in
331
+
let repo =
332
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
333
+
in
330
334
Result.bind
331
335
(Git.Repository.add_to_index repo
332
336
[ "dune-project"; "CLAUDE.md"; ".gitignore" ]
+21
-7
lib/opam_sync.ml
+21
-7
lib/opam_sync.ml
···
40
40
| Some c when c = repo_content -> ()
41
41
| _ -> (
42
42
Eio.Path.save ~create:(`Or_truncate 0o644) repo_path repo_content;
43
-
let repo = Git.Repository.open_repo ~fs opam_repo in
43
+
let repo =
44
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
45
+
in
44
46
match Git.Repository.add_to_index repo [ "repo" ] with
45
47
| Ok () -> ()
46
48
| Error (`Msg e) ->
···
63
65
let pkg_dir = Eio.Path.(fs / Fpath.to_string opam_repo / "packages" / name) in
64
66
try
65
67
Eio.Path.rmtree pkg_dir;
66
-
let repo = Git.Repository.open_repo ~fs opam_repo in
68
+
let repo =
69
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
70
+
in
67
71
let rel_path = Fmt.str "packages/%s" name in
68
72
(match Git.Repository.remove_from_index repo rel_path with
69
73
| Ok () -> ()
···
88
92
(try Eio.Path.mkdirs ~perm:0o755 pkg_dir_eio with Eio.Io _ -> ());
89
93
Log.info (fun m -> m "Generating %s.opam in opam-repo" pkg_name);
90
94
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path (Pkg.opam_content pkg);
91
-
let repo = Git.Repository.open_repo ~fs opam_repo in
95
+
let repo =
96
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
97
+
in
92
98
let rel_path = Fmt.str "packages/%s/%s.dev/opam" pkg_name pkg_name in
93
99
(match Git.Repository.add_to_index repo [ rel_path ] with
94
100
| Ok () -> ()
···
163
169
164
170
let commit_sync_result ~fs ~opam_repo result =
165
171
if result.synced <> [] || result.orphaned <> [] then begin
166
-
let repo = Git.Repository.open_repo ~fs opam_repo in
172
+
let repo =
173
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
174
+
in
167
175
let msg = commit_message result in
168
176
match Git_cli.global_git_user ~fs () with
169
177
| Some user -> (
···
355
363
let pkg_dir = Eio.Path.(fs / Fpath.to_string opam_repo / "packages" / name) in
356
364
try
357
365
Eio.Path.rmtree pkg_dir;
358
-
let repo = Git.Repository.open_repo ~fs opam_repo in
366
+
let repo =
367
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
368
+
in
359
369
let rel_path = Fmt.str "packages/%s" name in
360
370
(match Git.Repository.remove_from_index repo rel_path with
361
371
| Ok () -> ()
···
381
391
(try Eio.Path.mkdirs ~perm:0o755 pkg_dir_eio with Eio.Io _ -> ());
382
392
Log.info (fun m -> m "Generating %s.opam in opam-repo" pkg_name);
383
393
Eio.Path.save ~create:(`Or_truncate 0o644) dst_path (Pkg.opam_content pkg);
384
-
let repo = Git.Repository.open_repo ~fs opam_repo in
394
+
let repo =
395
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs opam_repo
396
+
in
385
397
let rel_path = Fmt.str "packages/%s/%s.dev/opam" pkg_name pkg_name in
386
398
(match Git.Repository.add_to_index repo [ rel_path ] with
387
399
| Ok () -> ()
···
402
414
(not no_commit) && (not dry_run)
403
415
&& (result.synced <> [] || result.orphaned <> [])
404
416
then begin
405
-
let repo = Git.Repository.open_repo ~fs target in
417
+
let repo =
418
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs target
419
+
in
406
420
let msg = commit_message result in
407
421
match Git_cli.global_git_user ~fs () with
408
422
| Some user -> (
+7
-2
lib/pull.ml
+7
-2
lib/pull.ml
···
46
46
match Git_cli.fetch_url ~proc ~fs ~repo:monorepo ~url ~branch () with
47
47
| Error e -> Error (Ctx.Git_error e)
48
48
| Ok hash_hex ->
49
-
let git_repo = Git.Repository.open_repo ~fs monorepo in
49
+
let git_repo =
50
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
51
+
in
50
52
let commit = Git.Hash.of_hex hash_hex in
51
53
let user =
52
54
match Git_cli.global_git_user ~fs () with
···
219
221
Log.warn (fun m ->
220
222
m "Failed to fetch %s into monorepo: %a" prefix Git_cli.pp_error e)
221
223
| Ok hash_hex -> (
222
-
let git_repo = Git.Repository.open_repo ~fs:fs_t monorepo in
224
+
let git_repo =
225
+
Eio.Switch.run @@ fun sw ->
226
+
Git.Repository.open_repo ~sw ~fs:fs_t monorepo
227
+
in
223
228
let commit = Git.Hash.of_hex hash_hex in
224
229
let user =
225
230
match Git_cli.global_git_user ~fs:fs_t () with
+20
-6
lib/push.ml
+20
-6
lib/push.ml
···
10
10
(** {1 Single Package Push} *)
11
11
12
12
let checkout_tree_hash ~fs checkout_dir =
13
-
let checkout_repo = Git.Repository.open_repo ~fs checkout_dir in
13
+
let checkout_repo =
14
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs checkout_dir
15
+
in
14
16
match Git.Repository.head checkout_repo with
15
17
| None -> None
16
18
| Some h -> (
···
146
148
else
147
149
let* () = Ok () in
148
150
let checkout_url = Fpath.to_string checkout_dir in
149
-
let git_repo = Git.Repository.open_repo ~fs monorepo in
151
+
let git_repo =
152
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
153
+
in
150
154
let mono_tree =
151
155
Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix
152
156
in
···
184
188
| Some remote_head -> not (Git.Hash.equal local_head remote_head))
185
189
186
190
let commit_pending ~fs path name =
187
-
let repo = Git.Repository.open_repo ~fs path in
191
+
let repo =
192
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs path
193
+
in
188
194
match Git.Repository.add_all repo with
189
195
| Error (`Msg e) ->
190
196
Log.warn (fun m -> m "Failed to stage changes in %s: %s" name e)
···
210
216
let errors = ref [] in
211
217
let push_repo ~commit name path =
212
218
if Git.Repository.is_repo ~fs path then begin
213
-
let repo = Git.Repository.open_repo ~fs path in
219
+
let repo =
220
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs path
221
+
in
214
222
match Git.Repository.remote_url repo "origin" with
215
223
| None -> Log.debug (fun m -> m "%s has no origin remote, skipping" name)
216
224
| Some fetch_url -> (
···
287
295
let fetch_url = resolve_fetch_url ~sources pkg in
288
296
let push_url = Ctx.url_to_push_url ~knot fetch_url in
289
297
Log.info (fun m -> m "Pushing %s to %s" name push_url);
290
-
let repo = Git.Repository.open_repo ~fs checkout_dir in
298
+
let repo =
299
+
Eio.Switch.run @@ fun sw ->
300
+
Git.Repository.open_repo ~sw ~fs checkout_dir
301
+
in
291
302
(match
292
303
Git.Repository.ensure_remote repo ~name:"origin" ~url:fetch_url
293
304
with
···
432
443
Log.info (fun m ->
433
444
m "Processing %d mono entries for inner subtree push"
434
445
(List.length mono));
435
-
let git_repo = Git.Repository.open_repo ~fs:fs_t monorepo in
446
+
let git_repo =
447
+
Eio.Switch.run @@ fun sw ->
448
+
Git.Repository.open_repo ~sw ~fs:fs_t monorepo
449
+
in
436
450
List.iter
437
451
(fun (mono_name, _mono_entry) ->
438
452
mono_inner ~proc ~fs_t ~monorepo ~checkouts_root ~git_repo ~clean
+11
-3
lib/status.ml
+11
-3
lib/status.ml
···
43
43
44
44
(** Pre-compute all subtree hashes from mono repo's HEAD *)
45
45
let subtree_hashes ~fs ~monorepo =
46
-
let mono_repo = Git.Repository.open_repo ~fs monorepo in
46
+
let mono_repo =
47
+
Eio.Switch.run @@ fun sw -> Git.Repository.open_repo ~sw ~fs monorepo
48
+
in
47
49
match Git.Repository.read_ref mono_repo "HEAD" with
48
50
| None -> Hashtbl.create 0
49
51
| Some commit_hash -> (
···
72
74
if not (dir_exists fs checkout_dir) then Missing
73
75
else if not (Git.Repository.is_repo ~fs checkout_dir) then Not_a_repo
74
76
else
75
-
let repo = Git.Repository.open_repo ~fs checkout_dir in
77
+
let repo =
78
+
Eio.Switch.run @@ fun sw ->
79
+
Git.Repository.open_repo ~sw ~fs checkout_dir
80
+
in
76
81
if Git.Repository.is_dirty repo then Dirty
77
82
else
78
83
let branch =
···
91
96
| (Missing | Not_a_repo | Dirty), _ -> Unknown
92
97
| _, Not_added -> Unknown
93
98
| (Clean _ | No_upstream), Present -> (
94
-
let checkout_repo = Git.Repository.open_repo ~fs checkout_dir in
99
+
let checkout_repo =
100
+
Eio.Switch.run @@ fun sw ->
101
+
Git.Repository.open_repo ~sw ~fs checkout_dir
102
+
in
95
103
let subtree_tree = Hashtbl.find_opt subtree_hashes prefix in
96
104
let checkout_tree =
97
105
Git.Repository.tree_hash_at_path checkout_repo ~rev:"HEAD" ~path:""
+4
-1
lib/verse.ml
+4
-1
lib/verse.ml
···
258
258
let cloned = Git.Repository.is_repo ~fs local_path in
259
259
let clean, ahead_behind =
260
260
if cloned then
261
-
let repo = Git.Repository.open_repo ~fs local_path in
261
+
let repo =
262
+
Eio.Switch.run @@ fun sw ->
263
+
Git.Repository.open_repo ~sw ~fs local_path
264
+
in
262
265
let clean = Some (not (Git.Repository.is_dirty repo)) in
263
266
let ahead_behind = Git.Repository.ahead_behind repo () in
264
267
(clean, ahead_behind)
+4
-1
lib/verse_registry.ml
+4
-1
lib/verse_registry.ml
···
170
170
(try Eio.Path.mkdirs ~perm:0o755 registry_eio with Eio.Io _ -> ());
171
171
(* Initialize as git repo *)
172
172
(try
173
-
let (_ : Git.Repository.t) = Git.Repository.init ~fs registry_path in
173
+
let (_ : Git.Repository.t) =
174
+
Eio.Switch.run @@ fun sw ->
175
+
Git.Repository.init ~sw ~fs registry_path
176
+
in
174
177
()
175
178
with Eio.Io _ -> ());
176
179
(* Create empty registry file *)