Type-safe codecs for dune build files
Regenerate root files
+1572
+17
README.md
+17
README.md
···
1
+
# nox-dune
2
+
3
+
Type-safe codecs for the dune-format file family, built on
4
+
[nox-sexp](https://tangled.org/gazagnaire.org/ocaml-sexp).
5
+
6
+
Each file kind lives in its own submodule:
7
+
8
+
- `Dune.Project` — `dune-project` files
9
+
- `Dune.Workspace` — `dune-workspace` files
10
+
- `Dune.File` — `dune` build files
11
+
- `Dune.Package` — installed `dune-package` metadata
12
+
13
+
Plus the shared field accessors, stanza-kind tagging, dune-style pretty
14
+
printing, and `%{var}` expansion in `Dune.Var`.
15
+
16
+
The split mirrors `nox-sexp` (generic sexp AST + codec primitives) and
17
+
`nox-opam` (opam-format codecs).
+7
dune
+7
dune
+29
dune-project
+29
dune-project
···
1
+
(lang dune 3.21)
2
+
(using mdx 0.4)
3
+
(name nox-dune)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(source (tangled gazagnaire.org/ocaml-dune))
11
+
12
+
(package
13
+
(name nox-dune)
14
+
(synopsis "Type-safe codecs for dune build files")
15
+
(tags (org:blacksun codec.text))
16
+
(description
17
+
"Codec combinators for the dune-format file family: dune build files,
18
+
dune-project, dune-workspace, and the dune-package metadata files dune
19
+
emits for installed libraries. Built on nox-sexp's Codec API. Mirrors
20
+
the ocaml-opam / nox-opam split: nox-sexp owns the generic sexp value
21
+
AST and codec primitives, nox-dune owns dune-format-specific decoders
22
+
and stanza accessors.")
23
+
(depends
24
+
(ocaml (>= 4.14.0))
25
+
(fmt (>= 0.9.0))
26
+
nox-sexp
27
+
(mdx :with-test)
28
+
(alcotest :with-test))
29
+
)
+4
lib/dune
+4
lib/dune
+802
lib/dune.ml
+802
lib/dune.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* ---- Variable expansion ---- *)
7
+
8
+
module Var = struct
9
+
type t = { name : string; default : string option }
10
+
11
+
let v ?default name = { name; default }
12
+
let name v = v.name
13
+
let default v = v.default
14
+
15
+
let pp ppf v =
16
+
match v.default with
17
+
| None -> Fmt.pf ppf "%%{%s}" v.name
18
+
| Some d -> Fmt.pf ppf "%%{%s:%s}" v.name d
19
+
20
+
let to_string v = Fmt.str "%a" pp v
21
+
22
+
let parse_at s pos =
23
+
let len = String.length s in
24
+
if pos + 2 >= len || s.[pos] <> '%' || s.[pos + 1] <> '{' then None
25
+
else
26
+
let start = pos + 2 in
27
+
let rec find_end i =
28
+
if i >= len then None
29
+
else if s.[i] = '}' then Some i
30
+
else find_end (i + 1)
31
+
in
32
+
match find_end start with
33
+
| None -> None
34
+
| Some end_pos ->
35
+
let inner = String.sub s start (end_pos - start) in
36
+
let var =
37
+
match String.index_opt inner ':' with
38
+
| None -> { name = inner; default = None }
39
+
| Some colon ->
40
+
let name = String.sub inner 0 colon in
41
+
let default =
42
+
String.sub inner (colon + 1) (String.length inner - colon - 1)
43
+
in
44
+
{ name; default = Some default }
45
+
in
46
+
Some (var, end_pos + 1)
47
+
end
48
+
49
+
type segment = Text of string | Variable of Var.t
50
+
type text = segment list
51
+
52
+
let text_of_string s =
53
+
let len = String.length s in
54
+
let rec loop acc pos =
55
+
if pos >= len then List.rev acc
56
+
else
57
+
match Var.parse_at s pos with
58
+
| Some (var, next_pos) -> loop (Variable var :: acc) next_pos
59
+
| None ->
60
+
let rec find_next i =
61
+
if i >= len then i
62
+
else if s.[i] = '%' && i + 1 < len && s.[i + 1] = '{' then i
63
+
else find_next (i + 1)
64
+
in
65
+
let next = find_next pos in
66
+
if next - pos = 0 then loop acc next
67
+
else
68
+
let text = String.sub s pos (next - pos) in
69
+
loop (Text text :: acc) next
70
+
in
71
+
loop [] 0
72
+
73
+
let pp_segment ppf = function
74
+
| Text s -> Fmt.string ppf s
75
+
| Variable v -> Var.pp ppf v
76
+
77
+
let pp_text ppf segments = Fmt.(list ~sep:nop pp_segment) ppf segments
78
+
let text_to_string segments = Fmt.str "%a" pp_text segments
79
+
80
+
let expand_text ~env segments =
81
+
let buf = Buffer.create 64 in
82
+
List.iter
83
+
(function
84
+
| Text s -> Buffer.add_string buf s
85
+
| Variable v -> (
86
+
match env v.name with
87
+
| Some value -> Buffer.add_string buf value
88
+
| None -> (
89
+
match v.default with
90
+
| Some d -> Buffer.add_string buf d
91
+
| None -> Buffer.add_string buf (Var.to_string v))))
92
+
segments;
93
+
Buffer.contents buf
94
+
95
+
let expand_atom ~env s =
96
+
let segments = text_of_string s in
97
+
expand_text ~env segments
98
+
99
+
let rec expand ~env = function
100
+
| Sexp.Atom s -> Sexp.Atom (expand_atom ~env s)
101
+
| Sexp.List l -> Sexp.List (List.map (expand ~env) l)
102
+
103
+
let has_variables s =
104
+
let len = String.length s in
105
+
let rec find_close i =
106
+
if i >= len then false else if s.[i] = '}' then true else find_close (i + 1)
107
+
in
108
+
let rec loop i =
109
+
if i + 1 >= len then false
110
+
else if s.[i] = '%' && s.[i + 1] = '{' && find_close (i + 2) then true
111
+
else loop (i + 1)
112
+
in
113
+
loop 0
114
+
115
+
let rec variables = function
116
+
| Sexp.Atom s ->
117
+
let segments = text_of_string s in
118
+
List.filter_map
119
+
(function Text _ -> None | Variable v -> Some v.name)
120
+
segments
121
+
| Sexp.List l -> List.concat_map variables l
122
+
123
+
(* ---- Dune-style pretty printing ---- *)
124
+
125
+
let needs_quoting s =
126
+
String.length s = 0
127
+
|| String.exists
128
+
(fun c ->
129
+
match c with
130
+
| ' ' | '\t' | '\n' | '\r' | '(' | ')' | '"' | ';' -> true
131
+
| _ -> false)
132
+
s
133
+
134
+
let pp_quoted_atom ppf s =
135
+
Fmt.char ppf '"';
136
+
String.iter
137
+
(fun c ->
138
+
match c with
139
+
| '"' -> Fmt.string ppf "\\\""
140
+
| '\\' -> Fmt.string ppf "\\\\"
141
+
| '\n' -> Fmt.string ppf "\\n"
142
+
| '\r' -> Fmt.string ppf "\\r"
143
+
| '\t' -> Fmt.string ppf "\\t"
144
+
| c -> Fmt.char ppf c)
145
+
s;
146
+
Fmt.char ppf '"'
147
+
148
+
let pp_atom ppf s =
149
+
if needs_quoting s then pp_quoted_atom ppf s else Fmt.string ppf s
150
+
151
+
let pp_dune ppf sexp =
152
+
let rec pp_sexp indent ppf = function
153
+
| Sexp.Atom s -> pp_atom ppf s
154
+
| Sexp.List [] -> Fmt.string ppf "()"
155
+
| Sexp.List ((Sexp.Atom _ as head) :: rest) when List.length rest <= 3 ->
156
+
Fmt.char ppf '(';
157
+
pp_sexp indent ppf head;
158
+
List.iter
159
+
(fun item ->
160
+
Fmt.char ppf ' ';
161
+
pp_sexp indent ppf item)
162
+
rest;
163
+
Fmt.char ppf ')'
164
+
| Sexp.List ((Sexp.Atom _ as head) :: rest) ->
165
+
Fmt.char ppf '(';
166
+
pp_sexp indent ppf head;
167
+
let new_indent = indent + 1 in
168
+
List.iter
169
+
(fun item ->
170
+
Fmt.char ppf '\n';
171
+
Fmt.string ppf (String.make new_indent ' ');
172
+
pp_sexp new_indent ppf item)
173
+
rest;
174
+
Fmt.char ppf ')'
175
+
| Sexp.List items ->
176
+
Fmt.char ppf '(';
177
+
let new_indent = indent + 1 in
178
+
(match items with
179
+
| [] -> ()
180
+
| first :: rest ->
181
+
pp_sexp new_indent ppf first;
182
+
List.iter
183
+
(fun item ->
184
+
Fmt.char ppf '\n';
185
+
Fmt.string ppf (String.make new_indent ' ');
186
+
pp_sexp new_indent ppf item)
187
+
rest);
188
+
Fmt.char ppf ')'
189
+
in
190
+
pp_sexp 0 ppf sexp
191
+
192
+
let to_string_dune sexp = Fmt.str "%a" pp_dune sexp
193
+
194
+
let pp_dune_file ppf sexps =
195
+
let rec loop = function
196
+
| [] -> ()
197
+
| [ sexp ] -> pp_dune ppf sexp
198
+
| sexp :: rest ->
199
+
pp_dune ppf sexp;
200
+
Fmt.string ppf "\n\n";
201
+
loop rest
202
+
in
203
+
loop sexps
204
+
205
+
let to_string_dune_file sexps = Fmt.str "%a@." pp_dune_file sexps
206
+
207
+
(* ---- Field accessors ---- *)
208
+
209
+
let field name sexp =
210
+
match sexp with
211
+
| Sexp.List items ->
212
+
List.find_map
213
+
(function
214
+
| Sexp.List (Sexp.Atom n :: rest) when String.equal n name -> (
215
+
match rest with [ v ] -> Some v | _ -> Some (Sexp.List rest))
216
+
| _ -> None)
217
+
items
218
+
| Sexp.Atom _ -> None
219
+
220
+
let fields name sexp =
221
+
match sexp with
222
+
| Sexp.List items ->
223
+
List.filter_map
224
+
(function
225
+
| Sexp.List (Sexp.Atom n :: rest) when String.equal n name -> (
226
+
match rest with [ v ] -> Some v | _ -> Some (Sexp.List rest))
227
+
| _ -> None)
228
+
items
229
+
| Sexp.Atom _ -> []
230
+
231
+
let field_atom name sexp =
232
+
match field name sexp with Some (Sexp.Atom s) -> Some s | _ -> None
233
+
234
+
let field_list name sexp =
235
+
match field name sexp with Some (Sexp.List l) -> Some l | _ -> None
236
+
237
+
let field_atoms name sexp =
238
+
match field_list name sexp with
239
+
| Some items ->
240
+
Some
241
+
(List.filter_map (function Sexp.Atom s -> Some s | _ -> None) items)
242
+
| None -> None
243
+
244
+
let set_field name value sexp =
245
+
match sexp with
246
+
| Sexp.List (head :: items) ->
247
+
let field = Sexp.List [ Sexp.Atom name; value ] in
248
+
let found = ref false in
249
+
let items =
250
+
List.map
251
+
(function
252
+
| Sexp.List (Sexp.Atom n :: _) when String.equal n name ->
253
+
found := true;
254
+
field
255
+
| item -> item)
256
+
items
257
+
in
258
+
let items = if !found then items else items @ [ field ] in
259
+
Sexp.List (head :: items)
260
+
| _ -> sexp
261
+
262
+
let remove_field name sexp =
263
+
match sexp with
264
+
| Sexp.List (head :: items) ->
265
+
let items =
266
+
List.filter
267
+
(function
268
+
| Sexp.List (Sexp.Atom n :: _) -> not (String.equal n name)
269
+
| _ -> true)
270
+
items
271
+
in
272
+
Sexp.List (head :: items)
273
+
| _ -> sexp
274
+
275
+
(* ---- Stanza types ---- *)
276
+
277
+
type stanza_kind =
278
+
| Library
279
+
| Executable
280
+
| Executables
281
+
| Test
282
+
| Tests
283
+
| Rule
284
+
| Install
285
+
| Alias
286
+
| Env
287
+
| Include
288
+
| Other of string
289
+
290
+
let stanza_kind_of_string = function
291
+
| "library" -> Library
292
+
| "executable" -> Executable
293
+
| "executables" -> Executables
294
+
| "test" -> Test
295
+
| "tests" -> Tests
296
+
| "rule" -> Rule
297
+
| "install" -> Install
298
+
| "alias" -> Alias
299
+
| "env" -> Env
300
+
| "include" -> Include
301
+
| s -> Other s
302
+
303
+
let stanza_kind_to_string = function
304
+
| Library -> "library"
305
+
| Executable -> "executable"
306
+
| Executables -> "executables"
307
+
| Test -> "test"
308
+
| Tests -> "tests"
309
+
| Rule -> "rule"
310
+
| Install -> "install"
311
+
| Alias -> "alias"
312
+
| Env -> "env"
313
+
| Include -> "include"
314
+
| Other s -> s
315
+
316
+
let stanza_kind sexp =
317
+
match sexp with
318
+
| Sexp.List (Sexp.Atom name :: _) -> Some (stanza_kind_of_string name)
319
+
| _ -> None
320
+
321
+
(* ---- Common stanza builders ---- *)
322
+
323
+
let library ?public_name ?libraries ?preprocess name =
324
+
let fields = [ Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] ] in
325
+
let fields =
326
+
match public_name with
327
+
| Some pn ->
328
+
fields @ [ Sexp.List [ Sexp.Atom "public_name"; Sexp.Atom pn ] ]
329
+
| None -> fields
330
+
in
331
+
let fields =
332
+
match libraries with
333
+
| Some libs when libs <> [] ->
334
+
fields
335
+
@ [
336
+
Sexp.List
337
+
(Sexp.Atom "libraries" :: List.map (fun s -> Sexp.Atom s) libs);
338
+
]
339
+
| _ -> fields
340
+
in
341
+
let fields =
342
+
match preprocess with
343
+
| Some pp -> fields @ [ Sexp.List [ Sexp.Atom "preprocess"; pp ] ]
344
+
| None -> fields
345
+
in
346
+
Sexp.List (Sexp.Atom "library" :: fields)
347
+
348
+
let executable ?public_name ?libraries ?preprocess name =
349
+
let fields = [ Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] ] in
350
+
let fields =
351
+
match public_name with
352
+
| Some pn ->
353
+
fields @ [ Sexp.List [ Sexp.Atom "public_name"; Sexp.Atom pn ] ]
354
+
| None -> fields
355
+
in
356
+
let fields =
357
+
match libraries with
358
+
| Some libs when libs <> [] ->
359
+
fields
360
+
@ [
361
+
Sexp.List
362
+
(Sexp.Atom "libraries" :: List.map (fun s -> Sexp.Atom s) libs);
363
+
]
364
+
| _ -> fields
365
+
in
366
+
let fields =
367
+
match preprocess with
368
+
| Some pp -> fields @ [ Sexp.List [ Sexp.Atom "preprocess"; pp ] ]
369
+
| None -> fields
370
+
in
371
+
Sexp.List (Sexp.Atom "executable" :: fields)
372
+
373
+
let test ?libraries ?modules name =
374
+
let fields = [ Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] ] in
375
+
let fields =
376
+
match modules with
377
+
| Some mods when mods <> [] ->
378
+
fields
379
+
@ [
380
+
Sexp.List
381
+
(Sexp.Atom "modules" :: List.map (fun s -> Sexp.Atom s) mods);
382
+
]
383
+
| _ -> fields
384
+
in
385
+
let fields =
386
+
match libraries with
387
+
| Some libs when libs <> [] ->
388
+
fields
389
+
@ [
390
+
Sexp.List
391
+
(Sexp.Atom "libraries" :: List.map (fun s -> Sexp.Atom s) libs);
392
+
]
393
+
| _ -> fields
394
+
in
395
+
Sexp.List (Sexp.Atom "test" :: fields)
396
+
397
+
(* ---- dune-project codec ---- *)
398
+
399
+
module Project = struct
400
+
type t = {
401
+
lang : string * string;
402
+
name : string option;
403
+
version : string option;
404
+
generate_opam_files : bool option;
405
+
license : string option;
406
+
authors : string list;
407
+
maintainers : string list;
408
+
source : string option;
409
+
bug_reports : string option;
410
+
homepage : string option;
411
+
documentation : string option;
412
+
packages : Sexp.t list;
413
+
other : Sexp.t list;
414
+
}
415
+
416
+
let empty =
417
+
{
418
+
lang = ("dune", "3.0");
419
+
name = None;
420
+
version = None;
421
+
generate_opam_files = None;
422
+
license = None;
423
+
authors = [];
424
+
maintainers = [];
425
+
source = None;
426
+
bug_reports = None;
427
+
homepage = None;
428
+
documentation = None;
429
+
packages = [];
430
+
other = [];
431
+
}
432
+
433
+
let make ?(dune_version = "3.0") ?name ?version ?generate_opam_files ?license
434
+
?(authors = []) ?(maintainers = []) ?source ?bug_reports ?homepage
435
+
?documentation ?(packages = []) () =
436
+
{
437
+
lang = ("dune", dune_version);
438
+
name;
439
+
version;
440
+
generate_opam_files;
441
+
license;
442
+
authors;
443
+
maintainers;
444
+
source;
445
+
bug_reports;
446
+
homepage;
447
+
documentation;
448
+
packages;
449
+
other = [];
450
+
}
451
+
452
+
let parse sexps =
453
+
let rec loop acc = function
454
+
| [] -> acc
455
+
| Sexp.List [ Sexp.Atom "lang"; Sexp.Atom lang; Sexp.Atom version ]
456
+
:: rest ->
457
+
loop { acc with lang = (lang, version) } rest
458
+
| Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] :: rest ->
459
+
loop { acc with name = Some name } rest
460
+
| Sexp.List [ Sexp.Atom "version"; Sexp.Atom version ] :: rest ->
461
+
loop { acc with version = Some version } rest
462
+
| Sexp.List [ Sexp.Atom "generate_opam_files"; Sexp.Atom b ] :: rest ->
463
+
let b =
464
+
match String.lowercase_ascii b with
465
+
| "true" -> Some true
466
+
| "false" -> Some false
467
+
| _ -> None
468
+
in
469
+
loop { acc with generate_opam_files = b } rest
470
+
| Sexp.List [ Sexp.Atom "license"; Sexp.Atom license ] :: rest ->
471
+
loop { acc with license = Some license } rest
472
+
| Sexp.List (Sexp.Atom "authors" :: authors) :: rest ->
473
+
let authors =
474
+
List.filter_map
475
+
(function Sexp.Atom s -> Some s | _ -> None)
476
+
authors
477
+
in
478
+
loop { acc with authors } rest
479
+
| Sexp.List (Sexp.Atom "maintainers" :: maintainers) :: rest ->
480
+
let maintainers =
481
+
List.filter_map
482
+
(function Sexp.Atom s -> Some s | _ -> None)
483
+
maintainers
484
+
in
485
+
loop { acc with maintainers } rest
486
+
| Sexp.List [ Sexp.Atom "source"; source ] :: rest ->
487
+
let source =
488
+
match source with
489
+
| Sexp.Atom s -> Some s
490
+
| Sexp.List [ Sexp.Atom "github"; Sexp.Atom repo ] ->
491
+
Some ("github:" ^ repo)
492
+
| Sexp.List [ Sexp.Atom "uri"; Sexp.Atom uri ] -> Some uri
493
+
| _ -> None
494
+
in
495
+
loop { acc with source } rest
496
+
| Sexp.List [ Sexp.Atom "bug_reports"; Sexp.Atom url ] :: rest ->
497
+
loop { acc with bug_reports = Some url } rest
498
+
| Sexp.List [ Sexp.Atom "homepage"; Sexp.Atom url ] :: rest ->
499
+
loop { acc with homepage = Some url } rest
500
+
| Sexp.List [ Sexp.Atom "documentation"; Sexp.Atom url ] :: rest ->
501
+
loop { acc with documentation = Some url } rest
502
+
| (Sexp.List (Sexp.Atom "package" :: _) as pkg) :: rest ->
503
+
loop { acc with packages = acc.packages @ [ pkg ] } rest
504
+
| other :: rest -> loop { acc with other = acc.other @ [ other ] } rest
505
+
in
506
+
loop empty sexps
507
+
508
+
let field name value = Sexp.List [ Sexp.Atom name; Sexp.Atom value ]
509
+
let field_opt name = function Some v -> [ field name v ] | None -> []
510
+
511
+
let field_list name values =
512
+
if values = [] then []
513
+
else
514
+
[ Sexp.List (Sexp.Atom name :: List.map (fun s -> Sexp.Atom s) values) ]
515
+
516
+
let source_sexp = function
517
+
| Some s when String.starts_with ~prefix:"github:" s ->
518
+
let repo = String.sub s 7 (String.length s - 7) in
519
+
[
520
+
Sexp.List
521
+
[
522
+
Sexp.Atom "source";
523
+
Sexp.List [ Sexp.Atom "github"; Sexp.Atom repo ];
524
+
];
525
+
]
526
+
| Some uri ->
527
+
[
528
+
Sexp.List
529
+
[ Sexp.Atom "source"; Sexp.List [ Sexp.Atom "uri"; Sexp.Atom uri ] ];
530
+
]
531
+
| None -> []
532
+
533
+
let to_sexps t =
534
+
let lang, version = t.lang in
535
+
[ Sexp.List [ Sexp.Atom "lang"; Sexp.Atom lang; Sexp.Atom version ] ]
536
+
@ field_opt "name" t.name
537
+
@ field_opt "version" t.version
538
+
@ (match t.generate_opam_files with
539
+
| Some b ->
540
+
[ field "generate_opam_files" (if b then "true" else "false") ]
541
+
| None -> [])
542
+
@ field_opt "license" t.license
543
+
@ field_list "authors" t.authors
544
+
@ field_list "maintainers" t.maintainers
545
+
@ source_sexp t.source
546
+
@ field_opt "bug_reports" t.bug_reports
547
+
@ field_opt "homepage" t.homepage
548
+
@ field_opt "documentation" t.documentation
549
+
@ t.packages @ t.other
550
+
551
+
let to_string t = to_string_dune_file (to_sexps t)
552
+
end
553
+
554
+
(* ---- dune-workspace codec ---- *)
555
+
556
+
module Workspace = struct
557
+
type context_kind = Default | Opam of { switch : string } | Other of Sexp.t
558
+
type context = { name : string option; kind : context_kind }
559
+
560
+
type t = {
561
+
lang : string * string;
562
+
contexts : context list;
563
+
env : Sexp.t option;
564
+
other : Sexp.t list;
565
+
}
566
+
567
+
let empty = { lang = ("dune", "3.0"); contexts = []; env = None; other = [] }
568
+
569
+
let parse sexps =
570
+
let rec loop acc = function
571
+
| [] -> acc
572
+
| Sexp.List [ Sexp.Atom "lang"; Sexp.Atom lang; Sexp.Atom version ]
573
+
:: rest ->
574
+
loop { acc with lang = (lang, version) } rest
575
+
| Sexp.List [ Sexp.Atom "context"; Sexp.Atom "default" ] :: rest ->
576
+
loop
577
+
{
578
+
acc with
579
+
contexts = acc.contexts @ [ { name = None; kind = Default } ];
580
+
}
581
+
rest
582
+
| Sexp.List [ Sexp.Atom "context"; Sexp.List ctx_fields ] :: rest ->
583
+
let name = field_atom "name" (Sexp.List ctx_fields) in
584
+
let kind =
585
+
match field "opam" (Sexp.List ctx_fields) with
586
+
| Some (Sexp.List opam_fields) -> (
587
+
match field_atom "switch" (Sexp.List opam_fields) with
588
+
| Some switch -> Opam { switch }
589
+
| None -> Other (Sexp.List ctx_fields))
590
+
| _ -> (
591
+
match field_atom "default" (Sexp.List ctx_fields) with
592
+
| Some _ -> Default
593
+
| None -> Other (Sexp.List ctx_fields))
594
+
in
595
+
loop { acc with contexts = acc.contexts @ [ { name; kind } ] } rest
596
+
| Sexp.List (Sexp.Atom "env" :: env_fields) :: rest ->
597
+
loop { acc with env = Some (Sexp.List env_fields) } rest
598
+
| other :: rest -> loop { acc with other = acc.other @ [ other ] } rest
599
+
in
600
+
loop empty sexps
601
+
602
+
let to_sexps t =
603
+
let sexps = [] in
604
+
let sexps =
605
+
let lang, version = t.lang in
606
+
Sexp.List [ Sexp.Atom "lang"; Sexp.Atom lang; Sexp.Atom version ] :: sexps
607
+
in
608
+
let sexps =
609
+
sexps
610
+
@ List.map
611
+
(fun ctx ->
612
+
let ctx_sexp =
613
+
match ctx.kind with
614
+
| Default -> Sexp.Atom "default"
615
+
| Opam { switch } ->
616
+
let fields =
617
+
[
618
+
Sexp.List
619
+
[
620
+
Sexp.Atom "opam";
621
+
Sexp.List [ Sexp.Atom "switch"; Sexp.Atom switch ];
622
+
];
623
+
]
624
+
in
625
+
let fields =
626
+
match ctx.name with
627
+
| Some name ->
628
+
Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] :: fields
629
+
| None -> fields
630
+
in
631
+
Sexp.List fields
632
+
| Other sexp -> sexp
633
+
in
634
+
Sexp.List [ Sexp.Atom "context"; ctx_sexp ])
635
+
t.contexts
636
+
in
637
+
let sexps =
638
+
match t.env with
639
+
| Some (Sexp.List env_fields) ->
640
+
sexps @ [ Sexp.List (Sexp.Atom "env" :: env_fields) ]
641
+
| Some env -> sexps @ [ Sexp.List [ Sexp.Atom "env"; env ] ]
642
+
| None -> sexps
643
+
in
644
+
sexps @ t.other
645
+
646
+
let to_string t = to_string_dune_file (to_sexps t)
647
+
end
648
+
649
+
(* ---- dune file codec ---- *)
650
+
651
+
module File = struct
652
+
type t = Sexp.t list
653
+
654
+
let parse = Fun.id
655
+
let to_sexps = Fun.id
656
+
let to_string = to_string_dune_file
657
+
658
+
let find_stanza kind stanzas =
659
+
List.find_opt (fun s -> stanza_kind s = Some kind) stanzas
660
+
661
+
let find_stanzas kind stanzas =
662
+
List.filter (fun s -> stanza_kind s = Some kind) stanzas
663
+
664
+
let library_names stanzas =
665
+
find_stanzas Library stanzas |> List.filter_map (field_atom "name")
666
+
667
+
let private_library_names stanzas =
668
+
find_stanzas Library stanzas
669
+
|> List.filter_map (fun s ->
670
+
match (field_atom "name" s, field_atom "public_name" s) with
671
+
| Some n, None -> Some n
672
+
| _ -> None)
673
+
674
+
let executable_names stanzas =
675
+
find_stanzas Executable stanzas @ find_stanzas Executables stanzas
676
+
|> List.filter_map (fun s ->
677
+
match field_atom "name" s with
678
+
| Some n -> Some n
679
+
| None -> (
680
+
match field_atoms "names" s with
681
+
| Some names -> Some (String.concat "," names)
682
+
| None -> None))
683
+
684
+
let test_names stanzas =
685
+
find_stanzas Test stanzas @ find_stanzas Tests stanzas
686
+
|> List.filter_map (fun s ->
687
+
match field_atom "name" s with
688
+
| Some n -> Some n
689
+
| None -> (
690
+
match field_atoms "names" s with
691
+
| Some names -> Some (String.concat "," names)
692
+
| None -> None))
693
+
end
694
+
695
+
module Package = struct
696
+
module Library = struct
697
+
type t = {
698
+
name : string;
699
+
main_module_name : string option;
700
+
modules : string list;
701
+
implements : string option;
702
+
}
703
+
704
+
let capitalize s =
705
+
if s = "" then s
706
+
else
707
+
String.uppercase_ascii (String.sub s 0 1)
708
+
^ String.sub s 1 (String.length s - 1)
709
+
710
+
let rec gather_obj_names acc = function
711
+
| Sexp.List (Sexp.Atom "module" :: fs) as m ->
712
+
let kind = field_atom "kind" m in
713
+
if kind = Some "alias" then List.fold_left gather_obj_names acc fs
714
+
else
715
+
let acc =
716
+
match field_atom "obj_name" m with
717
+
| Some n -> capitalize n :: acc
718
+
| None -> acc
719
+
in
720
+
List.fold_left gather_obj_names acc fs
721
+
| Sexp.List xs -> List.fold_left gather_obj_names acc xs
722
+
| _ -> acc
723
+
724
+
let modules_codec : string list Sexp.Codec.t =
725
+
Sexp.Codec.map ~kind:"modules"
726
+
~dec:(fun v -> List.rev (gather_obj_names [] v))
727
+
~enc:(fun _ -> Sexp.List [])
728
+
Sexp.Codec.value
729
+
730
+
let record_codec : t Sexp.Codec.t =
731
+
Sexp.Codec.Record.(
732
+
obj ~kind:"library" (fun name main_module_name modules implements ->
733
+
let modules =
734
+
match main_module_name with
735
+
| Some m when not (List.mem m modules) -> m :: modules
736
+
| _ -> modules
737
+
in
738
+
{ name; main_module_name; modules; implements })
739
+
|> mem "name" Sexp.Codec.string ~enc:(fun l -> l.name)
740
+
|> opt_mem "main_module_name" Sexp.Codec.string ~enc:(fun l ->
741
+
l.main_module_name)
742
+
|> mem "modules" modules_codec ~dec_absent:[] ~enc:(fun l -> l.modules)
743
+
|> opt_mem "implements" Sexp.Codec.string ~enc:(fun l -> l.implements)
744
+
|> skip_unknown |> finish)
745
+
746
+
let codec : t Sexp.Codec.t =
747
+
Sexp.Codec.Variant.(
748
+
variant ~kind:"library"
749
+
[ case "library" record_codec (fun l -> l) (fun l -> Some l) ])
750
+
end
751
+
end
752
+
753
+
module Lib_index = struct
754
+
module String_set = Set.Make (String)
755
+
756
+
type t = {
757
+
modules : (string, String_set.t) Hashtbl.t;
758
+
virtual_impls : (string, unit) Hashtbl.t;
759
+
}
760
+
761
+
let empty () =
762
+
{ modules = Hashtbl.create 256; virtual_impls = Hashtbl.create 16 }
763
+
764
+
let merge_modules t name mods =
765
+
if mods = [] then ()
766
+
else
767
+
let existing =
768
+
try Hashtbl.find t.modules name with Not_found -> String_set.empty
769
+
in
770
+
Hashtbl.replace t.modules name
771
+
(String_set.union existing (String_set.of_list mods))
772
+
773
+
(* Stream stanzas one at a time through Library.codec — no intermediate
774
+
[Library.t list]. Non-library stanzas (e.g. [(lang dune 3.0)]) and any
775
+
that fail to decode are skipped silently; this is metadata discovery,
776
+
not validation. *)
777
+
let add_dune_package t content =
778
+
(match Sexp.Value.parse_string_many content with
779
+
| Error _ -> ()
780
+
| Ok stanzas ->
781
+
List.iter
782
+
(fun s ->
783
+
match Sexp.Codec.decode_value Package.Library.codec s with
784
+
| Error _ -> ()
785
+
| Ok (lib : Package.Library.t) ->
786
+
if lib.implements <> None then
787
+
Hashtbl.replace t.virtual_impls lib.name ();
788
+
merge_modules t lib.name lib.modules)
789
+
stanzas);
790
+
t
791
+
792
+
let add_cmi_modules t ~pkg ~modules =
793
+
merge_modules t pkg modules;
794
+
t
795
+
796
+
let modules t lib =
797
+
match Hashtbl.find_opt t.modules lib with
798
+
| None -> []
799
+
| Some s -> String_set.elements s
800
+
801
+
let is_virtual_implementation t lib = Hashtbl.mem t.virtual_impls lib
802
+
end
+343
lib/dune.mli
+343
lib/dune.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Type-safe codecs for the dune-format file family.
7
+
8
+
Built on {!Sexp.Codec}; one submodule per file kind plus shared helpers for
9
+
variable expansion, dune-style pretty printing, field accessors, and
10
+
stanza-kind tagging.
11
+
12
+
{2 File kinds}
13
+
14
+
- {!module:File} - [dune] build files (libraries, executables, tests)
15
+
- {!module:Project} - [dune-project] files with project metadata
16
+
- {!module:Workspace} - [dune-workspace] files for multi-context builds
17
+
- {!module:Package} - installed [dune-package] metadata files
18
+
19
+
{2 Variable expansion}
20
+
21
+
Dune supports variable references like [%{name}] / [%{name:default}].
22
+
{!module:Var} parses and expands them. *)
23
+
24
+
(** {1 Variable Expansion} *)
25
+
26
+
module Var : sig
27
+
type t
28
+
(** Dune variable reference like [%{name}] or [%{name:default}]. *)
29
+
30
+
val v : ?default:string -> string -> t
31
+
(** [v ?default name] creates a variable reference. *)
32
+
33
+
val name : t -> string
34
+
(** [name v] is the variable name. *)
35
+
36
+
val default : t -> string option
37
+
(** [default v] is the optional default value. *)
38
+
39
+
val pp : Format.formatter -> t -> unit
40
+
(** [pp fmt v] prints the variable in Dune syntax. *)
41
+
42
+
val to_string : t -> string
43
+
(** [to_string v] converts to Dune variable syntax. *)
44
+
end
45
+
46
+
(** Text segments that may contain variable references. *)
47
+
type segment = Text of string | Variable of Var.t
48
+
49
+
type text = segment list
50
+
(** Text with embedded variable references. *)
51
+
52
+
val text_of_string : string -> text
53
+
(** [text_of_string s] parses a string into text segments. *)
54
+
55
+
val text_to_string : text -> string
56
+
(** [text_to_string t] converts text back to a string. *)
57
+
58
+
val pp_text : Format.formatter -> text -> unit
59
+
(** [pp_text fmt t] prints text with variables. *)
60
+
61
+
val expand_text : env:(string -> string option) -> text -> string
62
+
(** [expand_text ~env t] expands variables using [env] lookup. *)
63
+
64
+
val expand_atom : env:(string -> string option) -> string -> string
65
+
(** [expand_atom ~env s] expands variables in a string. *)
66
+
67
+
val expand : env:(string -> string option) -> Sexp.t -> Sexp.t
68
+
(** [expand ~env sexp] recursively expands all variables in atoms. *)
69
+
70
+
val has_variables : string -> bool
71
+
(** [has_variables s] is [true] if [s] contains variable references. *)
72
+
73
+
val variables : Sexp.t -> string list
74
+
(** [variables sexp] extracts all variable names from an S-expression. *)
75
+
76
+
(** {1 Dune-style Pretty Printing} *)
77
+
78
+
val pp_dune : Format.formatter -> Sexp.t -> unit
79
+
(** [pp_dune fmt sexp] prints an S-expression in Dune style. *)
80
+
81
+
val to_string_dune : Sexp.t -> string
82
+
(** [to_string_dune sexp] converts to a Dune-formatted string. *)
83
+
84
+
val pp_dune_file : Format.formatter -> Sexp.t list -> unit
85
+
(** [pp_dune_file fmt sexps] prints multiple stanzas with blank lines. *)
86
+
87
+
val to_string_dune_file : Sexp.t list -> string
88
+
(** [to_string_dune_file sexps] converts stanzas to a dune file string. *)
89
+
90
+
(** {1 Field Accessors} *)
91
+
92
+
val field : string -> Sexp.t -> Sexp.t option
93
+
(** [field name sexp] gets a field value from a stanza. *)
94
+
95
+
val fields : string -> Sexp.t -> Sexp.t list
96
+
(** [fields name sexp] gets all values for a repeated field. *)
97
+
98
+
val field_atom : string -> Sexp.t -> string option
99
+
(** [field_atom name sexp] gets a field's atom value. *)
100
+
101
+
val field_list : string -> Sexp.t -> Sexp.t list option
102
+
(** [field_list name sexp] gets a field's list value. *)
103
+
104
+
val field_atoms : string -> Sexp.t -> string list option
105
+
(** [field_atoms name sexp] gets atoms from a list field. *)
106
+
107
+
val set_field : string -> Sexp.t -> Sexp.t -> Sexp.t
108
+
(** [set_field name value sexp] sets or adds a field. *)
109
+
110
+
val remove_field : string -> Sexp.t -> Sexp.t
111
+
(** [remove_field name sexp] removes a field from a stanza. *)
112
+
113
+
(** {1 Stanza Types} *)
114
+
115
+
type stanza_kind =
116
+
| Library
117
+
| Executable
118
+
| Executables
119
+
| Test
120
+
| Tests
121
+
| Rule
122
+
| Install
123
+
| Alias
124
+
| Env
125
+
| Include
126
+
| Other of string
127
+
128
+
val stanza_kind_of_string : string -> stanza_kind
129
+
(** [stanza_kind_of_string s] converts a string to a stanza kind. *)
130
+
131
+
val stanza_kind_to_string : stanza_kind -> string
132
+
(** [stanza_kind_to_string k] converts a stanza kind to string. *)
133
+
134
+
val stanza_kind : Sexp.t -> stanza_kind option
135
+
(** [stanza_kind sexp] extracts the kind from a stanza. *)
136
+
137
+
(** {1 Stanza Builders} *)
138
+
139
+
val library :
140
+
?public_name:string ->
141
+
?libraries:string list ->
142
+
?preprocess:Sexp.t ->
143
+
string ->
144
+
Sexp.t
145
+
(** [library name] builds a [(library ...)] stanza. *)
146
+
147
+
val executable :
148
+
?public_name:string ->
149
+
?libraries:string list ->
150
+
?preprocess:Sexp.t ->
151
+
string ->
152
+
Sexp.t
153
+
(** [executable name] builds an [(executable ...)] stanza. *)
154
+
155
+
val test : ?libraries:string list -> ?modules:string list -> string -> Sexp.t
156
+
(** [test name] builds a [(test ...)] stanza. *)
157
+
158
+
(** {1 dune-project Files} *)
159
+
160
+
module Project : sig
161
+
type t = {
162
+
lang : string * string;
163
+
name : string option;
164
+
version : string option;
165
+
generate_opam_files : bool option;
166
+
license : string option;
167
+
authors : string list;
168
+
maintainers : string list;
169
+
source : string option;
170
+
bug_reports : string option;
171
+
homepage : string option;
172
+
documentation : string option;
173
+
packages : Sexp.t list;
174
+
other : Sexp.t list;
175
+
}
176
+
(** Parsed dune-project file. *)
177
+
178
+
val empty : t
179
+
(** [empty] is an empty dune-project with default lang. *)
180
+
181
+
val make :
182
+
?dune_version:string ->
183
+
?name:string ->
184
+
?version:string ->
185
+
?generate_opam_files:bool ->
186
+
?license:string ->
187
+
?authors:string list ->
188
+
?maintainers:string list ->
189
+
?source:string ->
190
+
?bug_reports:string ->
191
+
?homepage:string ->
192
+
?documentation:string ->
193
+
?packages:Sexp.t list ->
194
+
unit ->
195
+
t
196
+
(** [make ()] creates a dune-project with the given fields. *)
197
+
198
+
val parse : Sexp.t list -> t
199
+
(** [parse sexps] parses S-expressions into a dune-project. *)
200
+
201
+
val to_sexps : t -> Sexp.t list
202
+
(** [to_sexps t] converts to S-expressions. *)
203
+
204
+
val to_string : t -> string
205
+
(** [to_string t] converts to a dune-project file string. *)
206
+
end
207
+
208
+
(** {1 dune-workspace Files} *)
209
+
210
+
module Workspace : sig
211
+
type context_kind = Default | Opam of { switch : string } | Other of Sexp.t
212
+
type context = { name : string option; kind : context_kind }
213
+
214
+
type t = {
215
+
lang : string * string;
216
+
contexts : context list;
217
+
env : Sexp.t option;
218
+
other : Sexp.t list;
219
+
}
220
+
(** Parsed dune-workspace file. *)
221
+
222
+
val empty : t
223
+
(** [empty] is an empty dune-workspace. *)
224
+
225
+
val parse : Sexp.t list -> t
226
+
(** [parse sexps] parses S-expressions into a dune-workspace. *)
227
+
228
+
val to_sexps : t -> Sexp.t list
229
+
(** [to_sexps t] converts to S-expressions. *)
230
+
231
+
val to_string : t -> string
232
+
(** [to_string t] converts to a dune-workspace file string. *)
233
+
end
234
+
235
+
(** {1 dune Files} *)
236
+
237
+
module File : sig
238
+
type t = Sexp.t list
239
+
(** A dune file is a list of stanzas. *)
240
+
241
+
val parse : Sexp.t list -> t
242
+
(** [parse sexps] parses S-expressions as a dune file. *)
243
+
244
+
val to_sexps : t -> Sexp.t list
245
+
(** [to_sexps t] converts to S-expressions. *)
246
+
247
+
val to_string : t -> string
248
+
(** [to_string t] converts to a dune file string. *)
249
+
250
+
val find_stanza : stanza_kind -> t -> Sexp.t option
251
+
(** [find_stanza kind t] finds the first stanza of the given kind. *)
252
+
253
+
val find_stanzas : stanza_kind -> t -> Sexp.t list
254
+
(** [find_stanzas kind t] finds all stanzas of the given kind. *)
255
+
256
+
val library_names : t -> string list
257
+
(** [library_names t] extracts all library names. *)
258
+
259
+
val private_library_names : t -> string list
260
+
(** [private_library_names t] extracts the names of [(library (name X))]
261
+
stanzas that have no [(public_name ...)]. These are workspace-private
262
+
libraries: sibling stanzas can [(libraries X)] them, but they ship nowhere
263
+
and must not appear in opam depends. *)
264
+
265
+
val executable_names : t -> string list
266
+
(** [executable_names t] extracts all executable names. *)
267
+
268
+
val test_names : t -> string list
269
+
(** [test_names t] extracts all test names. *)
270
+
end
271
+
272
+
(** {1 dune-package Files} *)
273
+
274
+
module Package : sig
275
+
(** Parsed [_opam/lib/<pkg>/dune-package] / [_build/install/.../dune-package]
276
+
metadata. Dune writes one of these per installed package; it lists every
277
+
sub-library along with its exposed module names. *)
278
+
279
+
module Library : sig
280
+
type t = {
281
+
name : string;
282
+
(** Public library name, e.g. [helix.jx.jsoo]. May contain dots. *)
283
+
main_module_name : string option;
284
+
(** Top-level wrapper module when the library is wrapped. *)
285
+
modules : string list;
286
+
(** All exposed module names (capitalised, [obj_name] form). Includes
287
+
[main_module_name] when present. *)
288
+
implements : string option;
289
+
(** When present, this library is the concrete implementation of the
290
+
named virtual library. Such libraries are link-time live even if
291
+
none of their modules appear in source code. *)
292
+
}
293
+
(** A single [(library ...)] sub-stanza of a dune-package file. *)
294
+
295
+
val codec : t Sexp.codec
296
+
(** Codec for a single [(library ...)] stanza. Decoding any other stanza
297
+
shape returns an error. *)
298
+
end
299
+
end
300
+
301
+
(** {1 Library Index} *)
302
+
303
+
module Lib_index : sig
304
+
(** Aggregate index keyed by library name across many installed packages.
305
+
306
+
Build it incrementally: feed each package directory in via either
307
+
{!add_dune_package} (precise — uses the [dune-package] metadata) or
308
+
{!add_cmi_modules} (fallback — for packages installed without
309
+
[dune-package], the convention is to enumerate [*.cmi] basenames in the
310
+
install directory).
311
+
312
+
I/O is the caller's job. Pass {!add_dune_package} the {e contents} of a
313
+
[dune-package] file you already read, and {!add_cmi_modules} the list of
314
+
[*.cmi] basenames you already enumerated. The index then knows which
315
+
top-level modules each library exposes and which libraries are concrete
316
+
implementations of virtual libraries. *)
317
+
318
+
type t
319
+
320
+
val empty : unit -> t
321
+
(** [empty ()] is a fresh, mutable index with no libraries. *)
322
+
323
+
val add_dune_package : t -> string -> t
324
+
(** [add_dune_package t content] parses [content] as a [dune-package] file and
325
+
folds every library it declares into [t]. Updates the virtual-impl set for
326
+
any [(implements X)] entries and unions modules under each library's
327
+
public name. *)
328
+
329
+
val add_cmi_modules : t -> pkg:string -> modules:string list -> t
330
+
(** [add_cmi_modules t ~pkg ~modules] records [pkg]'s exposed top-level
331
+
modules, used as a fallback when no [dune-package] file is present. The
332
+
caller has already filtered out wrapped-private modules (basenames
333
+
containing [__]) and capitalised the remainder. *)
334
+
335
+
val modules : t -> string -> string list
336
+
(** [modules t lib] is the list of top-level module names exposed by [lib], or
337
+
[[]] if [lib] is unknown. *)
338
+
339
+
val is_virtual_implementation : t -> string -> bool
340
+
(** [is_virtual_implementation t lib] is [true] iff [lib] has an
341
+
[(implements X)] entry in its [dune-package]. Such libraries are link-time
342
+
live even when none of their modules appear in source. *)
343
+
end
+41
nox-dune.opam
+41
nox-dune.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Type-safe codecs for dune build files"
4
+
description: """
5
+
Codec combinators for the dune-format file family: dune build files,
6
+
dune-project, dune-workspace, and the dune-package metadata files dune
7
+
emits for installed libraries. Built on nox-sexp's Codec API. Mirrors
8
+
the ocaml-opam / nox-opam split: nox-sexp owns the generic sexp value
9
+
AST and codec primitives, nox-dune owns dune-format-specific decoders
10
+
and stanza accessors."""
11
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
12
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
13
+
license: "ISC"
14
+
tags: ["org:blacksun" "codec.text"]
15
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-dune"
16
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-dune/issues"
17
+
depends: [
18
+
"dune" {>= "3.21"}
19
+
"ocaml" {>= "4.14.0"}
20
+
"fmt" {>= "0.9.0"}
21
+
"nox-sexp"
22
+
"mdx" {with-test}
23
+
"alcotest" {with-test}
24
+
"odoc" {with-doc}
25
+
]
26
+
build: [
27
+
["dune" "subst"] {dev}
28
+
[
29
+
"dune"
30
+
"build"
31
+
"-p"
32
+
name
33
+
"-j"
34
+
jobs
35
+
"@install"
36
+
"@runtest" {with-test}
37
+
"@doc" {with-doc}
38
+
]
39
+
]
40
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-dune"
41
+
x-maintenance-intent: ["(latest)"]
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "nox-dune" [ Test_dune.suite ]
+323
test/test_dune.ml
+323
test/test_dune.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Dune
7
+
8
+
(* ---- Test helpers ---- *)
9
+
10
+
let sexp = Alcotest.testable Sexp.pp Sexp.equal
11
+
12
+
let parse s =
13
+
match Sexp.Value.parse_string s with
14
+
| Ok v -> v
15
+
| Error e -> Alcotest.fail (Sexp.Error.to_string e)
16
+
17
+
let parse_many s =
18
+
match Sexp.Value.parse_string_many s with
19
+
| Ok v -> v
20
+
| Error e -> Alcotest.fail (Sexp.Error.to_string e)
21
+
22
+
(* ---- Variable tests ---- *)
23
+
24
+
let test_var_simple () =
25
+
let v = Var.v "name" in
26
+
Alcotest.(check string) "name" "name" (Var.name v);
27
+
Alcotest.(check (option string)) "no default" None (Var.default v);
28
+
Alcotest.(check string) "to_string" "%{name}" (Var.to_string v)
29
+
30
+
let test_var_with_default () =
31
+
let v = Var.v ~default:"foo" "name" in
32
+
Alcotest.(check string) "name" "name" (Var.name v);
33
+
Alcotest.(check (option string)) "default" (Some "foo") (Var.default v);
34
+
Alcotest.(check string) "to_string" "%{name:foo}" (Var.to_string v)
35
+
36
+
let test_text_parsing () =
37
+
let text = text_of_string "hello %{world} and %{name:default}" in
38
+
(* 4 segments: "hello ", %{world}, " and ", %{name:default} *)
39
+
Alcotest.(check int) "4 segments" 4 (List.length text);
40
+
Alcotest.(check string)
41
+
"roundtrip" "hello %{world} and %{name:default}" (text_to_string text)
42
+
43
+
let test_has_variables () =
44
+
Alcotest.(check bool) "has vars" true (has_variables "%{foo}");
45
+
Alcotest.(check bool) "has vars with text" true (has_variables "x%{foo}y");
46
+
Alcotest.(check bool) "no vars" false (has_variables "hello");
47
+
Alcotest.(check bool) "incomplete" false (has_variables "%{")
48
+
49
+
let test_expand () =
50
+
let env = function "name" -> Some "Alice" | _ -> None in
51
+
let input = parse "(hello %{name})" in
52
+
let expected = parse "(hello Alice)" in
53
+
Alcotest.(check sexp) "expanded" expected (expand ~env input)
54
+
55
+
let test_expand_default () =
56
+
let env = function _ -> None in
57
+
let input = parse "(hello %{name:World})" in
58
+
let expected = parse "(hello World)" in
59
+
Alcotest.(check sexp) "use default" expected (expand ~env input)
60
+
61
+
let test_variables () =
62
+
let input = parse "(foo %{bar} (baz %{qux:default}))" in
63
+
let vars = variables input in
64
+
Alcotest.(check (list string)) "variables" [ "bar"; "qux" ] vars
65
+
66
+
(* ---- Field accessor tests ---- *)
67
+
68
+
let test_find_field () =
69
+
let stanza = parse "(library (name foo) (libraries bar baz))" in
70
+
Alcotest.(check (option string))
71
+
"name" (Some "foo") (field_atom "name" stanza);
72
+
Alcotest.(check (option (list string)))
73
+
"libraries"
74
+
(Some [ "bar"; "baz" ])
75
+
(field_atoms "libraries" stanza);
76
+
Alcotest.(check (option string))
77
+
"missing" None
78
+
(field_atom "public_name" stanza)
79
+
80
+
let test_set_field () =
81
+
let stanza = parse "(library (name foo))" in
82
+
let updated = set_field "public_name" (Sexp.Atom "my-lib") stanza in
83
+
Alcotest.(check (option string))
84
+
"added" (Some "my-lib")
85
+
(field_atom "public_name" updated);
86
+
let updated2 = set_field "name" (Sexp.Atom "bar") updated in
87
+
Alcotest.(check (option string))
88
+
"replaced" (Some "bar")
89
+
(field_atom "name" updated2)
90
+
91
+
let test_remove_field () =
92
+
let stanza = parse "(library (name foo) (public_name bar))" in
93
+
let updated = remove_field "public_name" stanza in
94
+
Alcotest.(check (option string))
95
+
"removed" None
96
+
(field_atom "public_name" updated);
97
+
Alcotest.(check (option string))
98
+
"kept" (Some "foo")
99
+
(field_atom "name" updated)
100
+
101
+
(* ---- Stanza kind tests ---- *)
102
+
103
+
let test_stanza_kind () =
104
+
Alcotest.(check (option string))
105
+
"library" (Some "library")
106
+
(Option.map stanza_kind_to_string
107
+
(stanza_kind (parse "(library (name foo))")));
108
+
Alcotest.(check (option string))
109
+
"executable" (Some "executable")
110
+
(Option.map stanza_kind_to_string
111
+
(stanza_kind (parse "(executable (name main))")));
112
+
Alcotest.(check (option string))
113
+
"test" (Some "test")
114
+
(Option.map stanza_kind_to_string
115
+
(stanza_kind (parse "(test (name test_foo))")))
116
+
117
+
(* ---- Stanza builder tests ---- *)
118
+
119
+
let test_library_builder () =
120
+
let lib = library ~public_name:"my-lib" ~libraries:[ "fmt"; "logs" ] "foo" in
121
+
Alcotest.(check (option string)) "name" (Some "foo") (field_atom "name" lib);
122
+
Alcotest.(check (option string))
123
+
"public_name" (Some "my-lib")
124
+
(field_atom "public_name" lib);
125
+
Alcotest.(check (option (list string)))
126
+
"libraries"
127
+
(Some [ "fmt"; "logs" ])
128
+
(field_atoms "libraries" lib)
129
+
130
+
let test_executable_builder () =
131
+
let exe = executable ~public_name:"my-exe" ~libraries:[ "cmdliner" ] "main" in
132
+
Alcotest.(check (option string)) "name" (Some "main") (field_atom "name" exe);
133
+
Alcotest.(check (option string))
134
+
"public_name" (Some "my-exe")
135
+
(field_atom "public_name" exe)
136
+
137
+
let test_test_builder () =
138
+
let t =
139
+
test ~modules:[ "test_foo"; "test_bar" ] ~libraries:[ "alcotest" ]
140
+
"test_main"
141
+
in
142
+
Alcotest.(check (option string))
143
+
"name" (Some "test_main") (field_atom "name" t);
144
+
Alcotest.(check (option (list string)))
145
+
"modules"
146
+
(Some [ "test_foo"; "test_bar" ])
147
+
(field_atoms "modules" t)
148
+
149
+
(* ---- Dune file tests ---- *)
150
+
151
+
let test_dune_find_stanzas () =
152
+
let dune_content =
153
+
{|
154
+
(library (name foo))
155
+
(library (name bar))
156
+
(executable (name main))
157
+
(test (name test_foo))
158
+
|}
159
+
in
160
+
let stanzas = File.parse (parse_many dune_content) in
161
+
Alcotest.(check (list string))
162
+
"library names" [ "foo"; "bar" ]
163
+
(File.library_names stanzas);
164
+
Alcotest.(check (list string))
165
+
"executable names" [ "main" ]
166
+
(File.executable_names stanzas);
167
+
Alcotest.(check (list string))
168
+
"test names" [ "test_foo" ] (File.test_names stanzas)
169
+
170
+
(* ---- Dune-project tests ---- *)
171
+
172
+
let test_dune_project_parse () =
173
+
let content =
174
+
{|
175
+
(lang dune 3.17)
176
+
(name my-project)
177
+
(version 1.0.0)
178
+
(license ISC)
179
+
(authors "Alice" "Bob")
180
+
(source (github owner/repo))
181
+
|}
182
+
in
183
+
let proj = Project.parse (parse_many content) in
184
+
Alcotest.(check (pair string string)) "lang" ("dune", "3.17") proj.lang;
185
+
Alcotest.(check (option string)) "name" (Some "my-project") proj.name;
186
+
Alcotest.(check (option string)) "version" (Some "1.0.0") proj.version;
187
+
Alcotest.(check (option string)) "license" (Some "ISC") proj.license;
188
+
Alcotest.(check (list string)) "authors" [ "Alice"; "Bob" ] proj.authors;
189
+
Alcotest.(check (option string))
190
+
"source" (Some "github:owner/repo") proj.source
191
+
192
+
let test_dune_project_roundtrip () =
193
+
let proj =
194
+
Project.make ~dune_version:"3.17" ~name:"test" ~version:"0.1" ~license:"MIT"
195
+
~authors:[ "Test Author" ] ~source:"github:test/repo" ()
196
+
in
197
+
let sexps = Project.to_sexps proj in
198
+
let proj2 = Project.parse sexps in
199
+
Alcotest.(check (option string)) "name preserved" proj.name proj2.name;
200
+
Alcotest.(check (option string))
201
+
"version preserved" proj.version proj2.version
202
+
203
+
(* ---- Dune-workspace tests ---- *)
204
+
205
+
let test_dune_workspace_parse () =
206
+
let content = {|
207
+
(lang dune 3.17)
208
+
(context default)
209
+
|} in
210
+
let ws = Workspace.parse (parse_many content) in
211
+
Alcotest.(check (pair string string)) "lang" ("dune", "3.17") ws.lang;
212
+
Alcotest.(check int) "one context" 1 (List.length ws.contexts)
213
+
214
+
(* ---- Pretty printing tests ---- *)
215
+
216
+
let test_pp_dune () =
217
+
let lib = library ~libraries:[ "a"; "b"; "c"; "d"; "e" ] "foo" in
218
+
let s = to_string_dune lib in
219
+
(* Should have newlines for long list *)
220
+
Alcotest.(check bool) "has newlines" true (String.contains s '\n')
221
+
222
+
let contains_substring sub s =
223
+
let sub_len = String.length sub in
224
+
let s_len = String.length s in
225
+
if sub_len > s_len then false
226
+
else
227
+
let rec check i =
228
+
if i > s_len - sub_len then false
229
+
else if String.sub s i sub_len = sub then true
230
+
else check (i + 1)
231
+
in
232
+
check 0
233
+
234
+
let test_pp_dune_file () =
235
+
let stanzas = [ library "foo"; executable "main" ] in
236
+
let s = to_string_dune_file stanzas in
237
+
(* Should have blank lines between stanzas *)
238
+
Alcotest.(check bool) "has blank lines" true (contains_substring "\n\n" s)
239
+
240
+
(* ---- Package tests ---- *)
241
+
242
+
(* Trimmed sample mirroring an installed dune-package: a wrapped library with
243
+
one nested module plus a virtual implementation that has [(implements X)]
244
+
and an empty module list. *)
245
+
let dune_package_sample =
246
+
{|
247
+
(lang dune 3.0)
248
+
(library
249
+
(name helix.jx)
250
+
(kind virtual)
251
+
(main_module_name Jx))
252
+
(library
253
+
(name helix.jx.jsoo)
254
+
(kind normal)
255
+
(implements helix.jx)
256
+
(main_module_name Jx)
257
+
(modules
258
+
(wrapped
259
+
(group
260
+
(alias
261
+
(obj_name jx__jx_jsoo__))
262
+
(name Jx)
263
+
(modules
264
+
(module
265
+
(obj_name jx__Jx_ffi)))))))
266
+
|}
267
+
268
+
let test_dune_package_libraries () =
269
+
(* The codec only decodes (library ...) stanzas; everything else (lang,
270
+
etc) is rejected. Filter via decode_value attempts. *)
271
+
let libs =
272
+
parse_many dune_package_sample
273
+
|> List.filter_map (fun s ->
274
+
Sexp.Codec.decode_value Package.Library.codec s |> Result.to_option)
275
+
in
276
+
Alcotest.(check int) "two libraries" 2 (List.length libs);
277
+
let virt = List.nth libs 0 in
278
+
Alcotest.(check string) "virtual name" "helix.jx" virt.Package.Library.name;
279
+
Alcotest.(check (option string))
280
+
"virtual not implementing" None virt.implements;
281
+
let impl = List.nth libs 1 in
282
+
Alcotest.(check string) "impl name" "helix.jx.jsoo" impl.Package.Library.name;
283
+
Alcotest.(check (option string))
284
+
"impl implements virtual" (Some "helix.jx") impl.implements;
285
+
Alcotest.(check (option string))
286
+
"main_module_name" (Some "Jx") impl.main_module_name;
287
+
(* Modules pulled from each [(module (obj_name X))] descendant, plus the
288
+
[main_module_name] itself. The synthetic [(alias (obj_name X__))]
289
+
wrapper is not a module the user can name — skip it. Order doesn't
290
+
matter. *)
291
+
let sorted = List.sort String.compare impl.modules in
292
+
Alcotest.(check (list string))
293
+
"modules harvested" [ "Jx"; "Jx__Jx_ffi" ] sorted
294
+
295
+
(* ---- Test suite ---- *)
296
+
297
+
let suite =
298
+
( "dune",
299
+
[
300
+
Alcotest.test_case "var simple" `Quick test_var_simple;
301
+
Alcotest.test_case "var with default" `Quick test_var_with_default;
302
+
Alcotest.test_case "text parsing" `Quick test_text_parsing;
303
+
Alcotest.test_case "has_variables" `Quick test_has_variables;
304
+
Alcotest.test_case "expand" `Quick test_expand;
305
+
Alcotest.test_case "expand default" `Quick test_expand_default;
306
+
Alcotest.test_case "extract variables" `Quick test_variables;
307
+
Alcotest.test_case "find_field" `Quick test_find_field;
308
+
Alcotest.test_case "set_field" `Quick test_set_field;
309
+
Alcotest.test_case "remove_field" `Quick test_remove_field;
310
+
Alcotest.test_case "stanza kinds" `Quick test_stanza_kind;
311
+
Alcotest.test_case "library builder" `Quick test_library_builder;
312
+
Alcotest.test_case "executable builder" `Quick test_executable_builder;
313
+
Alcotest.test_case "test builder" `Quick test_test_builder;
314
+
Alcotest.test_case "find stanzas" `Quick test_dune_find_stanzas;
315
+
Alcotest.test_case "dune_project parse" `Quick test_dune_project_parse;
316
+
Alcotest.test_case "dune_project roundtrip" `Quick
317
+
test_dune_project_roundtrip;
318
+
Alcotest.test_case "dune_workspace parse" `Quick test_dune_workspace_parse;
319
+
Alcotest.test_case "pp_dune" `Quick test_pp_dune;
320
+
Alcotest.test_case "pp_dune_file" `Quick test_pp_dune_file;
321
+
Alcotest.test_case "dune_package libraries" `Quick
322
+
test_dune_package_libraries;
323
+
] )