Monorepo management for opam overlays
monopam: config/registry tweaks from concurrent session
+112
-129
+59
-63
lib/config.ml
+59
-63
lib/config.ml
···
14
14
15
15
let branch t = t.branch
16
16
17
-
let codec : t Toml.t =
18
-
Toml.(
19
-
Table.(
20
-
obj (fun branch -> { branch })
21
-
|> opt_mem "branch" string ~enc:(fun c -> c.branch)
22
-
|> finish))
17
+
let codec : t Toml.codec =
18
+
let open Toml.Codec in
19
+
Table.obj (fun branch -> { branch })
20
+
|> Table.opt_mem "branch" string ~enc:(fun c -> c.branch)
21
+
|> Table.finish
23
22
end
24
23
25
24
(** {1 Paths Configuration} *)
···
130
129
| None -> s
131
130
else s
132
131
133
-
let fpath_codec : Fpath.t Toml.t =
134
-
Toml.map
132
+
let fpath_codec : Fpath.t Toml.codec =
133
+
Toml.Codec.map
135
134
~dec:(fun s ->
136
135
let s = expand_tilde s in
137
136
match Fpath.of_string s with Ok p -> p | Error (`Msg m) -> failwith m)
138
-
~enc:Fpath.to_string Toml.string
137
+
~enc:Fpath.to_string Toml.Codec.string
139
138
140
-
let paths_codec : paths Toml.t =
141
-
Toml.(
142
-
Table.(
143
-
obj (fun mono src verse ->
144
-
{
145
-
mono = Option.value ~default:default_paths.mono mono;
146
-
src = Option.value ~default:default_paths.src src;
147
-
verse = Option.value ~default:default_paths.verse verse;
148
-
})
149
-
|> opt_mem "mono" string ~enc:(fun p -> Some p.mono)
150
-
|> opt_mem "src" string ~enc:(fun p -> Some p.src)
151
-
|> opt_mem "verse" string ~enc:(fun p -> Some p.verse)
152
-
|> finish))
139
+
let paths_codec : paths Toml.codec =
140
+
let open Toml.Codec in
141
+
Table.obj (fun mono src verse ->
142
+
{
143
+
mono = Option.value ~default:default_paths.mono mono;
144
+
src = Option.value ~default:default_paths.src src;
145
+
verse = Option.value ~default:default_paths.verse verse;
146
+
})
147
+
|> Table.opt_mem "mono" string ~enc:(fun p -> Some p.mono)
148
+
|> Table.opt_mem "src" string ~enc:(fun p -> Some p.src)
149
+
|> Table.opt_mem "verse" string ~enc:(fun p -> Some p.verse)
150
+
|> Table.finish
153
151
154
152
(* TOML structure:
155
153
[workspace]
···
170
168
type workspace_section = { w_root : Fpath.t }
171
169
type identity_section = { i_handle : string; i_knot : string }
172
170
173
-
let workspace_codec : workspace_section Toml.t =
174
-
Toml.(
175
-
Table.(
176
-
obj (fun w_root -> { w_root })
177
-
|> mem "root" fpath_codec ~enc:(fun w -> w.w_root)
178
-
|> finish))
171
+
let workspace_codec : workspace_section Toml.codec =
172
+
let open Toml.Codec in
173
+
Table.obj (fun w_root -> { w_root })
174
+
|> Table.mem "root" fpath_codec ~enc:(fun w -> w.w_root)
175
+
|> Table.finish
179
176
180
-
let identity_codec : identity_section Toml.t =
181
-
Toml.(
182
-
Table.(
183
-
obj (fun i_handle i_knot -> { i_handle; i_knot })
184
-
|> mem "handle" string ~enc:(fun i -> i.i_handle)
185
-
|> mem "knot" string ~enc:(fun i -> i.i_knot)
186
-
|> finish))
177
+
let identity_codec : identity_section Toml.codec =
178
+
let open Toml.Codec in
179
+
Table.obj (fun i_handle i_knot -> { i_handle; i_knot })
180
+
|> Table.mem "handle" string ~enc:(fun i -> i.i_handle)
181
+
|> Table.mem "knot" string ~enc:(fun i -> i.i_knot)
182
+
|> Table.finish
187
183
188
184
(* Codec for the [packages] table which contains subtree->override mappings *)
189
-
let packages_table_codec : (string * Package_config.t) list Toml.t =
190
-
Toml.(
191
-
Table.(
192
-
obj (fun pkgs -> pkgs)
193
-
|> keep_unknown ~enc:(fun pkgs -> pkgs) (Mems.assoc Package_config.codec)
194
-
|> finish))
185
+
let packages_table_codec : (string * Package_config.t) list Toml.codec =
186
+
let open Toml.Codec in
187
+
Table.obj (fun pkgs -> pkgs)
188
+
|> Table.keep_unknown
189
+
~enc:(fun pkgs -> pkgs)
190
+
(Table.Mems.assoc Package_config.codec)
191
+
|> Table.finish
195
192
196
-
let codec : t Toml.t =
197
-
Toml.(
198
-
Table.(
199
-
obj (fun workspace identity packages paths ->
200
-
let packages = Option.value ~default:[] packages in
201
-
let paths = Option.value ~default:default_paths paths in
202
-
let knot = identity.i_knot in
203
-
{
204
-
root = workspace.w_root;
205
-
handle = identity.i_handle;
206
-
knot;
207
-
packages;
208
-
paths;
209
-
})
210
-
|> mem "workspace" workspace_codec ~enc:(fun t -> { w_root = t.root })
211
-
|> mem "identity" identity_codec ~enc:(fun t ->
212
-
{ i_handle = t.handle; i_knot = t.knot })
213
-
|> opt_mem "packages" packages_table_codec ~enc:(fun t ->
214
-
if t.packages = [] then None else Some t.packages)
215
-
|> opt_mem "paths" paths_codec ~enc:(fun t ->
216
-
if t.paths = default_paths then None else Some t.paths)
217
-
|> finish))
193
+
let codec : t Toml.codec =
194
+
let open Toml.Codec in
195
+
Table.obj (fun workspace identity packages paths ->
196
+
let packages = Option.value ~default:[] packages in
197
+
let paths = Option.value ~default:default_paths paths in
198
+
let knot = identity.i_knot in
199
+
{
200
+
root = workspace.w_root;
201
+
handle = identity.i_handle;
202
+
knot;
203
+
packages;
204
+
paths;
205
+
})
206
+
|> Table.mem "workspace" workspace_codec ~enc:(fun t -> { w_root = t.root })
207
+
|> Table.mem "identity" identity_codec ~enc:(fun t ->
208
+
{ i_handle = t.handle; i_knot = t.knot })
209
+
|> Table.opt_mem "packages" packages_table_codec ~enc:(fun t ->
210
+
if t.packages = [] then None else Some t.packages)
211
+
|> Table.opt_mem "paths" paths_codec ~enc:(fun t ->
212
+
if t.paths = default_paths then None else Some t.paths)
213
+
|> Table.finish
218
214
219
215
(** {1 Validation} *)
220
216
+21
-31
lib/sources_registry.ml
+21
-31
lib/sources_registry.ml
···
83
83
# presence of a sources.toml file inside open-mono/.
84
84
*)
85
85
86
-
let origin_codec : origin Toml.t =
87
-
Toml.map
86
+
let origin_codec : origin Toml.codec =
87
+
Toml.Codec.map
88
88
~dec:(function
89
89
| "fork" -> Fork
90
90
| "join" -> Join
91
91
| s -> Fmt.failwith "Invalid origin: %s (expected 'fork' or 'join')" s)
92
92
~enc:(function Fork -> "fork" | Join -> "join")
93
-
Toml.string
93
+
Toml.Codec.string
94
94
95
-
let entry_codec : entry Toml.t =
96
-
Toml.(
97
-
Table.(
98
-
obj (fun source upstream branch reason entry_origin ref_ path ->
99
-
{
100
-
source;
101
-
upstream;
102
-
branch;
103
-
reason;
104
-
origin = entry_origin;
105
-
ref_;
106
-
path;
107
-
})
108
-
|> mem "source" string ~enc:(fun (e : entry) -> e.source)
109
-
|> opt_mem "upstream" string ~enc:(fun (e : entry) -> e.upstream)
110
-
|> opt_mem "branch" string ~enc:(fun (e : entry) -> e.branch)
111
-
|> opt_mem "reason" string ~enc:(fun (e : entry) -> e.reason)
112
-
|> opt_mem "origin" origin_codec ~enc:(fun (e : entry) -> e.origin)
113
-
|> opt_mem "ref" string ~enc:(fun (e : entry) -> e.ref_)
114
-
|> opt_mem "path" string ~enc:(fun (e : entry) -> e.path)
115
-
|> finish))
95
+
let entry_codec : entry Toml.codec =
96
+
let open Toml.Codec in
97
+
Table.obj (fun source upstream branch reason entry_origin ref_ path ->
98
+
{ source; upstream; branch; reason; origin = entry_origin; ref_; path })
99
+
|> Table.mem "source" string ~enc:(fun (e : entry) -> e.source)
100
+
|> Table.opt_mem "upstream" string ~enc:(fun (e : entry) -> e.upstream)
101
+
|> Table.opt_mem "branch" string ~enc:(fun (e : entry) -> e.branch)
102
+
|> Table.opt_mem "reason" string ~enc:(fun (e : entry) -> e.reason)
103
+
|> Table.opt_mem "origin" origin_codec ~enc:(fun (e : entry) -> e.origin)
104
+
|> Table.opt_mem "ref" string ~enc:(fun (e : entry) -> e.ref_)
105
+
|> Table.opt_mem "path" string ~enc:(fun (e : entry) -> e.path)
106
+
|> Table.finish
116
107
117
-
let codec : t Toml.t =
118
-
Toml.(
119
-
Table.(
120
-
obj (fun origin entries -> { origin; entries })
121
-
|> opt_mem "origin" string ~enc:(fun t -> t.origin)
122
-
|> keep_unknown ~enc:(fun t -> t.entries) (Mems.assoc entry_codec)
123
-
|> finish))
108
+
let codec : t Toml.codec =
109
+
let open Toml.Codec in
110
+
Table.obj (fun origin entries -> { origin; entries })
111
+
|> Table.opt_mem "origin" string ~enc:(fun t -> t.origin)
112
+
|> Table.keep_unknown ~enc:(fun t -> t.entries) (Table.Mems.assoc entry_codec)
113
+
|> Table.finish
124
114
125
115
let load ~fs path =
126
116
let path_str = Fpath.to_string path in
+32
-35
lib/verse_registry.ml
+32
-35
lib/verse_registry.ml
···
52
52
opamrepo = "https://github.com/alice/opam-repo"
53
53
*)
54
54
55
-
let member_codec : member Toml.t =
56
-
Toml.(
57
-
Table.(
58
-
obj (fun handle name monorepo_raw opamrepo_raw ->
59
-
let monorepo, monorepo_branch = parse_url_with_branch monorepo_raw in
60
-
let opamrepo, opamrepo_branch = parse_url_with_branch opamrepo_raw in
61
-
{ handle; name; monorepo; monorepo_branch; opamrepo; opamrepo_branch })
62
-
|> mem "handle" string ~enc:(fun (m : member) -> m.handle)
63
-
|> opt_mem "name" string ~enc:(fun (m : member) -> m.name)
64
-
|> mem "monorepo" string ~enc:(fun (m : member) ->
65
-
encode_url_with_branch m.monorepo m.monorepo_branch)
66
-
|> mem "opamrepo" string ~enc:(fun (m : member) ->
67
-
encode_url_with_branch m.opamrepo m.opamrepo_branch)
68
-
|> finish))
55
+
let member_codec : member Toml.codec =
56
+
let open Toml.Codec in
57
+
Table.obj (fun handle name monorepo_raw opamrepo_raw ->
58
+
let monorepo, monorepo_branch = parse_url_with_branch monorepo_raw in
59
+
let opamrepo, opamrepo_branch = parse_url_with_branch opamrepo_raw in
60
+
{ handle; name; monorepo; monorepo_branch; opamrepo; opamrepo_branch })
61
+
|> Table.mem "handle" string ~enc:(fun (m : member) -> m.handle)
62
+
|> Table.opt_mem "name" string ~enc:(fun (m : member) -> m.name)
63
+
|> Table.mem "monorepo" string ~enc:(fun (m : member) ->
64
+
encode_url_with_branch m.monorepo m.monorepo_branch)
65
+
|> Table.mem "opamrepo" string ~enc:(fun (m : member) ->
66
+
encode_url_with_branch m.opamrepo m.opamrepo_branch)
67
+
|> Table.finish
69
68
70
69
type registry_info = { r_name : string; r_description : string option }
71
70
72
-
let registry_info_codec : registry_info Toml.t =
73
-
Toml.(
74
-
Table.(
75
-
obj (fun r_name r_description -> { r_name; r_description })
76
-
|> mem "name" string ~enc:(fun r -> r.r_name)
77
-
|> opt_mem "description" string ~enc:(fun r -> r.r_description)
78
-
|> finish))
71
+
let registry_info_codec : registry_info Toml.codec =
72
+
let open Toml.Codec in
73
+
Table.obj (fun r_name r_description -> { r_name; r_description })
74
+
|> Table.mem "name" string ~enc:(fun r -> r.r_name)
75
+
|> Table.opt_mem "description" string ~enc:(fun r -> r.r_description)
76
+
|> Table.finish
79
77
80
-
let codec : t Toml.t =
81
-
Toml.(
82
-
Table.(
83
-
obj (fun registry members ->
84
-
{
85
-
name = registry.r_name;
86
-
description = registry.r_description;
87
-
members = Option.value ~default:[] members;
88
-
})
89
-
|> mem "registry" registry_info_codec ~enc:(fun t ->
90
-
{ r_name = t.name; r_description = t.description })
91
-
|> opt_mem "members" (list member_codec) ~enc:(fun t ->
92
-
match t.members with [] -> None | ms -> Some ms)
93
-
|> finish))
78
+
let codec : t Toml.codec =
79
+
let open Toml.Codec in
80
+
Table.obj (fun registry members ->
81
+
{
82
+
name = registry.r_name;
83
+
description = registry.r_description;
84
+
members = Option.value ~default:[] members;
85
+
})
86
+
|> Table.mem "registry" registry_info_codec ~enc:(fun t ->
87
+
{ r_name = t.name; r_description = t.description })
88
+
|> Table.opt_mem "members" (list member_codec) ~enc:(fun t ->
89
+
match t.members with [] -> None | ms -> Some ms)
90
+
|> Table.finish
94
91
95
92
let empty_registry = { name = "opamverse"; description = None; members = [] }
96
93