My working unpac space for OCaml projects in development
Merge opam/patches/tomlt
+11612
+1
vendor/opam/tomlt/.gitignore
+1
vendor/opam/tomlt/.gitignore
···
1
+
_build
+1
vendor/opam/tomlt/.ocamlformat
+1
vendor/opam/tomlt/.ocamlformat
···
1
+
version=0.28.1
+57
vendor/opam/tomlt/README.md
+57
vendor/opam/tomlt/README.md
···
1
+
# Tomlt
2
+
3
+
Tomlt is a type-safe [TOML 1.1](https://toml.io/en/v1.1.0) codec library for OCaml.
4
+
5
+
## Design
6
+
7
+
Tomlt provides bidirectional encoding and decoding using a combinator-based
8
+
approach inspired by [Jsont](https://erratique.ch/software/jsont). The design
9
+
is based on the [paper](https://github.com/dbuenzli/jsont/tree/main/paper):
10
+
11
+
> Daniel Bünzli. *An alphabet for your data soups*, 2024.
12
+
> Available at: https://github.com/dbuenzli/jsont/tree/main/paper
13
+
14
+
Each codec `'a t` defines both a decoder (`Toml.t -> ('a, error) result`) and
15
+
an encoder (`'a -> Toml.t`), composing through combinators to build complex
16
+
types from simple primitives.
17
+
18
+
## Quick Start
19
+
20
+
Define a codec for your OCaml types:
21
+
22
+
```ocaml
23
+
type config = { host : string; port : int; debug : bool }
24
+
25
+
let config_codec =
26
+
Tomlt.(Table.(
27
+
obj (fun host port debug -> { host; port; debug })
28
+
|> mem "host" string ~enc:(fun c -> c.host)
29
+
|> mem "port" int ~enc:(fun c -> c.port)
30
+
|> mem "debug" bool ~enc:(fun c -> c.debug) ~dec_absent:false
31
+
|> finish
32
+
))
33
+
```
34
+
35
+
For I/O operations (parsing strings, reading files), use `Tomlt_bytesrw`:
36
+
37
+
```ocaml
38
+
let () =
39
+
match Tomlt_bytesrw.decode_string config_codec {|
40
+
host = "localhost"
41
+
port = 8080
42
+
|} with
43
+
| Ok config -> Printf.printf "Host: %s\n" config.host
44
+
| Error e -> prerr_endline (Toml.Error.to_string e)
45
+
```
46
+
47
+
## Packages
48
+
49
+
- `tomlt` - Core library with value types and codec combinators
50
+
- `tomlt.bytesrw` - Streaming parser/encoder using Bytesrw
51
+
- `tomlt.eio` - Eio integration with system clock
52
+
- `tomlt.unix` - Unix I/O with system clock
53
+
- `tomlt.jsont` - Jsont codecs for toml-test JSON format
54
+
55
+
## License
56
+
57
+
ISC
+18
vendor/opam/tomlt/bin/dune
+18
vendor/opam/tomlt/bin/dune
···
1
+
(executable
2
+
(name toml_test_decoder)
3
+
(public_name toml-test-decoder)
4
+
(package tomlt)
5
+
(optional)
6
+
(libraries tomlt tomlt.bytesrw))
7
+
8
+
(executable
9
+
(name toml_test_encoder)
10
+
(public_name toml-test-encoder)
11
+
(package tomlt)
12
+
(optional)
13
+
(libraries tomlt tomlt.bytesrw))
14
+
15
+
(executable
16
+
(name run_tests)
17
+
(optional)
18
+
(libraries tomlt tomlt.bytesrw))
+359
vendor/opam/tomlt/bin/run_tests.ml
+359
vendor/opam/tomlt/bin/run_tests.ml
···
1
+
(* Test runner for toml-test suite *)
2
+
3
+
let test_dir = "../toml-test/tests"
4
+
5
+
(* Simple JSON comparison - normalizes whitespace and order *)
6
+
let normalize_json s =
7
+
(* Remove all whitespace outside of strings *)
8
+
let buf = Buffer.create (String.length s) in
9
+
let in_string = ref false in
10
+
let escaped = ref false in
11
+
String.iter (fun c ->
12
+
if !escaped then begin
13
+
Buffer.add_char buf c;
14
+
escaped := false
15
+
end else if !in_string then begin
16
+
Buffer.add_char buf c;
17
+
if c = '\\' then escaped := true
18
+
else if c = '"' then in_string := false
19
+
end else begin
20
+
if c = '"' then begin
21
+
in_string := true;
22
+
Buffer.add_char buf c
23
+
end else if c <> ' ' && c <> '\n' && c <> '\r' && c <> '\t' then
24
+
Buffer.add_char buf c
25
+
end
26
+
) s;
27
+
Buffer.contents buf
28
+
29
+
let parse_json_string s pos =
30
+
if s.[pos] <> '"' then failwith "Expected string";
31
+
let buf = Buffer.create 64 in
32
+
let p = ref (pos + 1) in
33
+
let len = String.length s in
34
+
while !p < len && s.[!p] <> '"' do
35
+
if s.[!p] = '\\' then begin
36
+
incr p;
37
+
if !p >= len then failwith "Unexpected end in string";
38
+
match s.[!p] with
39
+
| '"' -> Buffer.add_char buf '"'; incr p
40
+
| '\\' -> Buffer.add_char buf '\\'; incr p
41
+
| 'n' -> Buffer.add_char buf '\n'; incr p
42
+
| 'r' -> Buffer.add_char buf '\r'; incr p
43
+
| 't' -> Buffer.add_char buf '\t'; incr p
44
+
| 'b' -> Buffer.add_char buf '\b'; incr p
45
+
| 'f' -> Buffer.add_char buf (Char.chr 0x0C); incr p
46
+
| 'u' ->
47
+
incr p;
48
+
if !p + 4 > len then failwith "Invalid unicode escape";
49
+
let hex = String.sub s !p 4 in
50
+
let cp = int_of_string ("0x" ^ hex) in
51
+
(* Convert codepoint to UTF-8 *)
52
+
if cp <= 0x7F then
53
+
Buffer.add_char buf (Char.chr cp)
54
+
else if cp <= 0x7FF then begin
55
+
Buffer.add_char buf (Char.chr (0xC0 lor (cp lsr 6)));
56
+
Buffer.add_char buf (Char.chr (0x80 lor (cp land 0x3F)))
57
+
end else begin
58
+
Buffer.add_char buf (Char.chr (0xE0 lor (cp lsr 12)));
59
+
Buffer.add_char buf (Char.chr (0x80 lor ((cp lsr 6) land 0x3F)));
60
+
Buffer.add_char buf (Char.chr (0x80 lor (cp land 0x3F)))
61
+
end;
62
+
p := !p + 4
63
+
| c -> failwith (Printf.sprintf "Invalid escape: \\%c" c)
64
+
end else begin
65
+
Buffer.add_char buf s.[!p];
66
+
incr p
67
+
end
68
+
done;
69
+
if !p >= len then failwith "Unclosed string";
70
+
(Buffer.contents buf, !p + 1)
71
+
72
+
(* Semantic comparison for tagged JSON values *)
73
+
type json_value =
74
+
| JString of string
75
+
| JNumber of string
76
+
| JBool of bool
77
+
| JNull
78
+
| JArray of json_value list
79
+
| JObject of (string * json_value) list
80
+
81
+
let rec parse_json_value s pos =
82
+
let len = String.length s in
83
+
let skip_ws pos =
84
+
let p = ref pos in
85
+
while !p < len && (s.[!p] = ' ' || s.[!p] = '\t' || s.[!p] = '\n' || s.[!p] = '\r') do
86
+
incr p
87
+
done;
88
+
!p
89
+
in
90
+
let pos = skip_ws pos in
91
+
if pos >= len then failwith "Unexpected end of JSON";
92
+
match s.[pos] with
93
+
| '{' ->
94
+
let pos = ref (skip_ws (pos + 1)) in
95
+
let pairs = ref [] in
96
+
while !pos < len && s.[!pos] <> '}' do
97
+
if !pairs <> [] then begin
98
+
if s.[!pos] <> ',' then failwith "Expected comma";
99
+
pos := skip_ws (!pos + 1)
100
+
end;
101
+
let (key, p) = parse_json_string s !pos in
102
+
pos := skip_ws p;
103
+
if s.[!pos] <> ':' then failwith "Expected colon";
104
+
pos := skip_ws (!pos + 1);
105
+
let (value, p) = parse_json_value s !pos in
106
+
pairs := (key, value) :: !pairs;
107
+
pos := skip_ws p
108
+
done;
109
+
if !pos >= len then failwith "Unclosed object";
110
+
(JObject (List.rev !pairs), !pos + 1)
111
+
| '[' ->
112
+
let pos = ref (skip_ws (pos + 1)) in
113
+
let items = ref [] in
114
+
while !pos < len && s.[!pos] <> ']' do
115
+
if !items <> [] then begin
116
+
if s.[!pos] <> ',' then failwith "Expected comma";
117
+
pos := skip_ws (!pos + 1)
118
+
end;
119
+
let (value, p) = parse_json_value s !pos in
120
+
items := value :: !items;
121
+
pos := skip_ws p
122
+
done;
123
+
if !pos >= len then failwith "Unclosed array";
124
+
(JArray (List.rev !items), !pos + 1)
125
+
| '"' ->
126
+
let (str, p) = parse_json_string s pos in
127
+
(JString str, p)
128
+
| c when c >= '0' && c <= '9' || c = '-' ->
129
+
let start = pos in
130
+
let p = ref pos in
131
+
while !p < len && (let c = s.[!p] in c >= '0' && c <= '9' || c = '-' || c = '+' || c = '.' || c = 'e' || c = 'E') do
132
+
incr p
133
+
done;
134
+
(JNumber (String.sub s start (!p - start)), !p)
135
+
| 't' ->
136
+
if pos + 4 <= len && String.sub s pos 4 = "true" then (JBool true, pos + 4)
137
+
else failwith "Invalid JSON"
138
+
| 'f' ->
139
+
if pos + 5 <= len && String.sub s pos 5 = "false" then (JBool false, pos + 5)
140
+
else failwith "Invalid JSON"
141
+
| 'n' ->
142
+
if pos + 4 <= len && String.sub s pos 4 = "null" then (JNull, pos + 4)
143
+
else failwith "Invalid JSON"
144
+
| _ -> failwith (Printf.sprintf "Invalid JSON character: %c" s.[pos])
145
+
146
+
(* Normalize datetime fractional seconds: remove trailing zeros *)
147
+
let normalize_datetime_frac s =
148
+
(* Find the fractional part and normalize it *)
149
+
let len = String.length s in
150
+
let buf = Buffer.create len in
151
+
let i = ref 0 in
152
+
while !i < len do
153
+
let c = s.[!i] in
154
+
if c = '.' then begin
155
+
(* Found decimal point - collect digits and normalize *)
156
+
Buffer.add_char buf '.';
157
+
incr i;
158
+
let frac_start = Buffer.length buf in
159
+
while !i < len && s.[!i] >= '0' && s.[!i] <= '9' do
160
+
Buffer.add_char buf s.[!i];
161
+
incr i
162
+
done;
163
+
(* Remove trailing zeros from fractional part *)
164
+
let contents = Buffer.contents buf in
165
+
let frac_end = ref (String.length contents - 1) in
166
+
while !frac_end >= frac_start && contents.[!frac_end] = '0' do
167
+
decr frac_end
168
+
done;
169
+
(* If only the dot remains, remove it too *)
170
+
if !frac_end = frac_start - 1 then
171
+
decr frac_end;
172
+
Buffer.clear buf;
173
+
Buffer.add_substring buf contents 0 (!frac_end + 1);
174
+
(* Add rest of string *)
175
+
while !i < len do
176
+
Buffer.add_char buf s.[!i];
177
+
incr i
178
+
done
179
+
end else begin
180
+
Buffer.add_char buf c;
181
+
incr i
182
+
end
183
+
done;
184
+
Buffer.contents buf
185
+
186
+
(* Semantic comparison of tagged JSON values *)
187
+
let rec json_values_equal expected actual =
188
+
match expected, actual with
189
+
| JNull, JNull -> true
190
+
| JBool a, JBool b -> a = b
191
+
| JNumber a, JNumber b -> a = b
192
+
| JString a, JString b -> a = b
193
+
| JArray a, JArray b ->
194
+
List.length a = List.length b &&
195
+
List.for_all2 json_values_equal a b
196
+
| JObject pairs_e, JObject pairs_a ->
197
+
(* Check if this is a tagged value {"type": ..., "value": ...} *)
198
+
let get_tagged pairs =
199
+
match List.assoc_opt "type" pairs, List.assoc_opt "value" pairs with
200
+
| Some (JString typ), Some (JString value) when List.length pairs = 2 ->
201
+
Some (typ, value)
202
+
| _ -> None
203
+
in
204
+
(match get_tagged pairs_e, get_tagged pairs_a with
205
+
| Some (type_e, value_e), Some (type_a, value_a) ->
206
+
(* Tagged value comparison *)
207
+
if type_e <> type_a then false
208
+
else begin
209
+
match type_e with
210
+
| "float" ->
211
+
(* Compare floats numerically *)
212
+
(try
213
+
let f_e = float_of_string value_e in
214
+
let f_a = float_of_string value_a in
215
+
f_e = f_a || (Float.is_nan f_e && Float.is_nan f_a)
216
+
with _ -> value_e = value_a)
217
+
| "datetime" | "datetime-local" | "date-local" | "time-local" ->
218
+
(* Normalize fractional seconds *)
219
+
normalize_datetime_frac value_e = normalize_datetime_frac value_a
220
+
| _ ->
221
+
(* String comparison for other types *)
222
+
value_e = value_a
223
+
end
224
+
| _ ->
225
+
(* Regular object comparison - sort by keys *)
226
+
let sorted_e = List.sort (fun (a, _) (b, _) -> String.compare a b) pairs_e in
227
+
let sorted_a = List.sort (fun (a, _) (b, _) -> String.compare a b) pairs_a in
228
+
List.length sorted_e = List.length sorted_a &&
229
+
List.for_all2 (fun (ke, ve) (ka, va) -> ke = ka && json_values_equal ve va) sorted_e sorted_a)
230
+
| _ -> false
231
+
232
+
let json_equal a b =
233
+
try
234
+
let (va, _) = parse_json_value a 0 in
235
+
let (vb, _) = parse_json_value b 0 in
236
+
json_values_equal va vb
237
+
with _ -> false
238
+
239
+
let run_valid_test toml_file json_file =
240
+
let toml_content = In_channel.with_open_bin toml_file In_channel.input_all in
241
+
match Tomlt_bytesrw.of_string toml_content with
242
+
| Error e -> `Fail (Printf.sprintf "Decode error: %s" (Tomlt.Toml.Error.to_string e))
243
+
| Ok toml ->
244
+
let actual_json = Tomlt_bytesrw.Tagged_json.encode toml in
245
+
let expected_json = In_channel.with_open_bin json_file In_channel.input_all in
246
+
if json_equal actual_json expected_json then
247
+
`Pass
248
+
else
249
+
`Fail (Printf.sprintf "JSON mismatch.\nExpected: %s\nActual: %s"
250
+
(normalize_json expected_json) (normalize_json actual_json))
251
+
252
+
let run_invalid_test toml_file =
253
+
let toml_content = In_channel.with_open_bin toml_file In_channel.input_all in
254
+
match Tomlt_bytesrw.of_string toml_content with
255
+
| Error _ -> `Pass (* Should fail *)
256
+
| Ok _ -> `Fail "Should have failed but parsed successfully"
257
+
258
+
(* Encoder test: JSON -> TOML -> JSON round-trip *)
259
+
let run_encoder_test json_file =
260
+
let json_content = In_channel.with_open_bin json_file In_channel.input_all in
261
+
(* First, encode JSON to TOML *)
262
+
match Tomlt_bytesrw.Tagged_json.decode_and_encode_toml json_content with
263
+
| Error msg -> `Fail (Printf.sprintf "Encode error: %s" msg)
264
+
| Ok toml_output ->
265
+
(* Then decode the TOML back to check round-trip *)
266
+
match Tomlt_bytesrw.of_string toml_output with
267
+
| Error e -> `Fail (Printf.sprintf "Round-trip decode error: %s\nTOML was:\n%s" (Tomlt.Toml.Error.to_string e) toml_output)
268
+
| Ok decoded_toml ->
269
+
(* Compare the decoded result with original JSON *)
270
+
let actual_json = Tomlt_bytesrw.Tagged_json.encode decoded_toml in
271
+
if json_equal actual_json json_content then
272
+
`Pass
273
+
else
274
+
`Fail (Printf.sprintf "Round-trip mismatch.\nOriginal JSON: %s\nEncoded TOML:\n%s\nDecoded JSON: %s"
275
+
(normalize_json json_content) toml_output (normalize_json actual_json))
276
+
277
+
let read_file_list filename =
278
+
let ic = open_in filename in
279
+
let rec loop acc =
280
+
match input_line ic with
281
+
| line -> loop (String.trim line :: acc)
282
+
| exception End_of_file -> close_in ic; List.rev acc
283
+
in
284
+
loop []
285
+
286
+
let () =
287
+
let valid_passed = ref 0 in
288
+
let valid_failed = ref 0 in
289
+
let encoder_passed = ref 0 in
290
+
let encoder_failed = ref 0 in
291
+
let invalid_passed = ref 0 in
292
+
let invalid_failed = ref 0 in
293
+
let failures = ref [] in
294
+
295
+
(* Read the file list for TOML 1.1.0 *)
296
+
let files = read_file_list (test_dir ^ "/files-toml-1.1.0") in
297
+
298
+
List.iter (fun file ->
299
+
if String.length file > 0 then begin
300
+
let full_path = test_dir ^ "/" ^ file in
301
+
if Sys.file_exists full_path then begin
302
+
if String.length file >= 6 && String.sub file 0 6 = "valid/" then begin
303
+
(* Valid test - needs both .toml and .json *)
304
+
if Filename.check_suffix file ".toml" then begin
305
+
let json_file = (Filename.chop_suffix full_path ".toml") ^ ".json" in
306
+
if Sys.file_exists json_file then begin
307
+
(* Decoder test: TOML -> JSON *)
308
+
(match run_valid_test full_path json_file with
309
+
| `Pass -> incr valid_passed
310
+
| `Fail msg ->
311
+
incr valid_failed;
312
+
failures := (file ^ " (decode)", msg) :: !failures);
313
+
(* Encoder test: JSON -> TOML -> JSON round-trip *)
314
+
(match run_encoder_test json_file with
315
+
| `Pass -> incr encoder_passed
316
+
| `Fail msg ->
317
+
incr encoder_failed;
318
+
failures := (file ^ " (encode)", msg) :: !failures)
319
+
end
320
+
end
321
+
end else if String.length file >= 8 && String.sub file 0 8 = "invalid/" then begin
322
+
(* Invalid test - only .toml *)
323
+
if Filename.check_suffix file ".toml" then begin
324
+
match run_invalid_test full_path with
325
+
| `Pass -> incr invalid_passed
326
+
| `Fail msg ->
327
+
incr invalid_failed;
328
+
failures := (file, msg) :: !failures
329
+
end
330
+
end
331
+
end
332
+
end
333
+
) files;
334
+
335
+
Printf.printf "\n=== Test Results ===\n";
336
+
Printf.printf "Decoder tests: %d passed, %d failed\n" !valid_passed !valid_failed;
337
+
Printf.printf "Encoder tests: %d passed, %d failed\n" !encoder_passed !encoder_failed;
338
+
Printf.printf "Invalid tests: %d passed, %d failed\n" !invalid_passed !invalid_failed;
339
+
Printf.printf "Total: %d passed, %d failed\n"
340
+
(!valid_passed + !encoder_passed + !invalid_passed)
341
+
(!valid_failed + !encoder_failed + !invalid_failed);
342
+
343
+
if !failures <> [] then begin
344
+
Printf.printf "\n=== Failures (first 30) ===\n";
345
+
List.iter (fun (file, msg) ->
346
+
Printf.printf "\n%s:\n %s\n" file msg
347
+
) (List.rev !failures |> List.filteri (fun i _ -> i < 30))
348
+
end;
349
+
350
+
(* Show some valid test failures specifically *)
351
+
let valid_failures = List.filter (fun (f, _) -> String.sub f 0 6 = "valid/") (List.rev !failures) in
352
+
if valid_failures <> [] then begin
353
+
Printf.printf "\n=== Valid Test Failures (first 20) ===\n";
354
+
List.iter (fun (file, msg) ->
355
+
Printf.printf "\n%s:\n %s\n" file (String.sub msg 0 (min 200 (String.length msg)))
356
+
) (List.filteri (fun i _ -> i < 20) valid_failures)
357
+
end;
358
+
359
+
if !valid_failed + !invalid_failed > 0 then exit 1
+1
vendor/opam/tomlt/bin/run_tests.mli
+1
vendor/opam/tomlt/bin/run_tests.mli
···
1
+
(* empty *)
+12
vendor/opam/tomlt/bin/toml_test_decoder.ml
+12
vendor/opam/tomlt/bin/toml_test_decoder.ml
···
1
+
(* TOML test decoder - reads TOML from stdin, outputs tagged JSON to stdout *)
2
+
3
+
let () =
4
+
let input = In_channel.input_all In_channel.stdin in
5
+
match Tomlt_bytesrw.of_string input with
6
+
| Ok toml ->
7
+
let json = Tomlt_bytesrw.Tagged_json.encode toml in
8
+
print_string json;
9
+
print_newline ()
10
+
| Error e ->
11
+
Printf.eprintf "Error: %s\n" (Tomlt.Toml.Error.to_string e);
12
+
exit 1
+1
vendor/opam/tomlt/bin/toml_test_decoder.mli
+1
vendor/opam/tomlt/bin/toml_test_decoder.mli
···
1
+
(* empty *)
+10
vendor/opam/tomlt/bin/toml_test_encoder.ml
+10
vendor/opam/tomlt/bin/toml_test_encoder.ml
···
1
+
(* TOML test encoder - reads tagged JSON from stdin, outputs TOML to stdout *)
2
+
3
+
let () =
4
+
let input = In_channel.input_all In_channel.stdin in
5
+
match Tomlt_bytesrw.Tagged_json.decode_and_encode_toml input with
6
+
| Ok toml ->
7
+
print_string toml
8
+
| Error msg ->
9
+
Printf.eprintf "Error: %s\n" msg;
10
+
exit 1
+1
vendor/opam/tomlt/bin/toml_test_encoder.mli
+1
vendor/opam/tomlt/bin/toml_test_encoder.mli
···
1
+
(* empty *)
+819
vendor/opam/tomlt/doc/cookbook.mld
+819
vendor/opam/tomlt/doc/cookbook.mld
···
1
+
{0 Cookbook}
2
+
3
+
This cookbook provides patterns and recipes for common TOML tasks.
4
+
Each section includes both conceptual explanation and working code
5
+
examples. See {!module:Tomlt} for the full API reference.
6
+
7
+
{1:conventions Conventions}
8
+
9
+
Throughout this cookbook, we use the following conventions:
10
+
11
+
- Codec values are named after their OCaml type (e.g., [config_codec]
12
+
for a [config] type)
13
+
- The [~enc] parameter always extracts the field from the record
14
+
- Codecs are defined using the applicative-style {!Tomlt.Table} builder
15
+
16
+
{1:config_files Parsing Configuration Files}
17
+
18
+
The most common use case: parsing a TOML configuration file into an
19
+
OCaml record.
20
+
21
+
{2 Basic Configuration}
22
+
23
+
{[
24
+
type database_config = {
25
+
host : string;
26
+
port : int;
27
+
name : string;
28
+
}
29
+
30
+
let database_config_codec =
31
+
Tomlt.(Table.(
32
+
obj (fun host port name -> { host; port; name })
33
+
|> mem "host" string ~enc:(fun c -> c.host)
34
+
|> mem "port" int ~enc:(fun c -> c.port)
35
+
|> mem "name" string ~enc:(fun c -> c.name)
36
+
|> finish
37
+
))
38
+
]}
39
+
40
+
This handles TOML like:
41
+
42
+
{v
43
+
host = "localhost"
44
+
port = 5432
45
+
name = "myapp"
46
+
v}
47
+
48
+
{2 Nested Configuration}
49
+
50
+
For nested tables, compose codecs:
51
+
52
+
{[
53
+
type server_config = {
54
+
host : string;
55
+
port : int;
56
+
}
57
+
58
+
type app_config = {
59
+
name : string;
60
+
server : server_config;
61
+
debug : bool;
62
+
}
63
+
64
+
let server_config_codec =
65
+
Tomlt.(Table.(
66
+
obj (fun host port -> { host; port })
67
+
|> mem "host" string ~enc:(fun s -> s.host)
68
+
|> mem "port" int ~enc:(fun s -> s.port)
69
+
|> finish
70
+
))
71
+
72
+
let app_config_codec =
73
+
Tomlt.(Table.(
74
+
obj (fun name server debug -> { name; server; debug })
75
+
|> mem "name" string ~enc:(fun c -> c.name)
76
+
|> mem "server" server_config_codec ~enc:(fun c -> c.server)
77
+
|> mem "debug" bool ~enc:(fun c -> c.debug)
78
+
|> finish
79
+
))
80
+
]}
81
+
82
+
This handles:
83
+
84
+
{v
85
+
name = "My Application"
86
+
debug = false
87
+
88
+
[server]
89
+
host = "0.0.0.0"
90
+
port = 8080
91
+
v}
92
+
93
+
{2 Multi-Environment Configuration}
94
+
95
+
A pattern for dev/staging/prod configurations:
96
+
97
+
{[
98
+
type env_config = {
99
+
database_url : string;
100
+
log_level : string;
101
+
cache_ttl : int;
102
+
}
103
+
104
+
type config = {
105
+
app_name : string;
106
+
development : env_config;
107
+
production : env_config;
108
+
}
109
+
110
+
let env_config_codec =
111
+
Tomlt.(Table.(
112
+
obj (fun database_url log_level cache_ttl ->
113
+
{ database_url; log_level; cache_ttl })
114
+
|> mem "database_url" string ~enc:(fun e -> e.database_url)
115
+
|> mem "log_level" string ~enc:(fun e -> e.log_level)
116
+
|> mem "cache_ttl" int ~enc:(fun e -> e.cache_ttl)
117
+
|> finish
118
+
))
119
+
120
+
let config_codec =
121
+
Tomlt.(Table.(
122
+
obj (fun app_name development production ->
123
+
{ app_name; development; production })
124
+
|> mem "app_name" string ~enc:(fun c -> c.app_name)
125
+
|> mem "development" env_config_codec ~enc:(fun c -> c.development)
126
+
|> mem "production" env_config_codec ~enc:(fun c -> c.production)
127
+
|> finish
128
+
))
129
+
]}
130
+
131
+
{1:optional_values Optional and Absent Values}
132
+
133
+
TOML tables may have optional members. Tomlt provides several ways
134
+
to handle missing values.
135
+
136
+
{2 Default Values with dec_absent}
137
+
138
+
Use [~dec_absent] to provide a default when a key is missing:
139
+
140
+
{[
141
+
type settings = {
142
+
theme : string;
143
+
font_size : int;
144
+
show_line_numbers : bool;
145
+
}
146
+
147
+
let settings_codec =
148
+
Tomlt.(Table.(
149
+
obj (fun theme font_size show_line_numbers ->
150
+
{ theme; font_size; show_line_numbers })
151
+
|> mem "theme" string ~enc:(fun s -> s.theme)
152
+
~dec_absent:"default"
153
+
|> mem "font_size" int ~enc:(fun s -> s.font_size)
154
+
~dec_absent:12
155
+
|> mem "show_line_numbers" bool ~enc:(fun s -> s.show_line_numbers)
156
+
~dec_absent:true
157
+
|> finish
158
+
))
159
+
]}
160
+
161
+
{v
162
+
# All of these work:
163
+
theme = "dark"
164
+
165
+
# Or with defaults:
166
+
# (empty table uses all defaults)
167
+
v}
168
+
169
+
{2 Option Types with opt_mem}
170
+
171
+
Use {!Tomlt.Table.opt_mem} when the absence of a value is meaningful:
172
+
173
+
{[
174
+
type user = {
175
+
name : string;
176
+
email : string option;
177
+
phone : string option;
178
+
}
179
+
180
+
let user_codec =
181
+
Tomlt.(Table.(
182
+
obj (fun name email phone -> { name; email; phone })
183
+
|> mem "name" string ~enc:(fun u -> u.name)
184
+
|> opt_mem "email" string ~enc:(fun u -> u.email)
185
+
|> opt_mem "phone" string ~enc:(fun u -> u.phone)
186
+
|> finish
187
+
))
188
+
]}
189
+
190
+
On encoding, [None] values are omitted from the output:
191
+
192
+
{[
193
+
(* This user: *)
194
+
let user = { name = "Alice"; email = Some "alice@example.com"; phone = None }
195
+
196
+
(* Encodes to: *)
197
+
(* name = "Alice"
198
+
email = "alice@example.com"
199
+
# phone is omitted *)
200
+
]}
201
+
202
+
{2 Conditional Omission with enc_omit}
203
+
204
+
Use [~enc_omit] to omit values that match a predicate:
205
+
206
+
{[
207
+
type config = {
208
+
name : string;
209
+
retries : int; (* omit if 0 *)
210
+
}
211
+
212
+
let config_codec =
213
+
Tomlt.(Table.(
214
+
obj (fun name retries -> { name; retries })
215
+
|> mem "name" string ~enc:(fun c -> c.name)
216
+
|> mem "retries" int ~enc:(fun c -> c.retries)
217
+
~dec_absent:0
218
+
~enc_omit:(fun r -> r = 0)
219
+
|> finish
220
+
))
221
+
]}
222
+
223
+
{1:datetimes Working with Datetimes}
224
+
225
+
TOML 1.1 supports four datetime formats. Tomlt provides Ptime-based
226
+
codecs that handle all of them.
227
+
228
+
{2 TOML Datetime Formats}
229
+
230
+
{v
231
+
# Offset datetime - full timestamp with timezone (unambiguous)
232
+
published = 2024-01-15T10:30:00Z
233
+
published = 2024-01-15T10:30:00-05:00
234
+
235
+
# Local datetime - no timezone (wall clock time)
236
+
meeting = 2024-01-15T10:30:00
237
+
238
+
# Local date - date only
239
+
birthday = 1979-05-27
240
+
241
+
# Local time - time only
242
+
alarm = 07:30:00
243
+
v}
244
+
245
+
{2 Basic Datetime Handling}
246
+
247
+
Use {!Tomlt.ptime} to accept any datetime format and normalize to
248
+
[Ptime.t]:
249
+
250
+
{[
251
+
type event = { name : string; timestamp : Ptime.t }
252
+
253
+
let event_codec =
254
+
Tomlt.(Table.(
255
+
obj (fun name timestamp -> { name; timestamp })
256
+
|> mem "name" string ~enc:(fun e -> e.name)
257
+
|> mem "when" (ptime ()) ~enc:(fun e -> e.timestamp)
258
+
|> finish
259
+
))
260
+
261
+
(* All of these decode successfully: *)
262
+
(* when = 2024-01-15T10:30:00Z -> offset datetime *)
263
+
(* when = 2024-01-15T10:30:00 -> local datetime *)
264
+
(* when = 2024-01-15 -> date only (midnight) *)
265
+
(* when = 10:30:00 -> time only (today) *)
266
+
]}
267
+
268
+
{2 Strict Timestamp Validation}
269
+
270
+
Use {!Tomlt.ptime_opt} when you require explicit timezone information:
271
+
272
+
{[
273
+
type audit_log = { action : string; timestamp : Ptime.t }
274
+
275
+
let audit_codec =
276
+
Tomlt.(Table.(
277
+
obj (fun action timestamp -> { action; timestamp })
278
+
|> mem "action" string ~enc:(fun a -> a.action)
279
+
|> mem "timestamp" (ptime_opt ()) ~enc:(fun a -> a.timestamp)
280
+
|> finish
281
+
))
282
+
283
+
(* Valid: timestamp = 2024-01-15T10:30:00Z *)
284
+
(* Valid: timestamp = 2024-01-15T10:30:00+05:30 *)
285
+
(* Invalid: timestamp = 2024-01-15T10:30:00 (no timezone) *)
286
+
(* Invalid: timestamp = 2024-01-15 (date only) *)
287
+
]}
288
+
289
+
{2 Date-Only Fields}
290
+
291
+
Use {!Tomlt.ptime_date} for fields that should only contain dates:
292
+
293
+
{[
294
+
type person = { name : string; birthday : Ptime.date }
295
+
296
+
let person_codec =
297
+
Tomlt.(Table.(
298
+
obj (fun name birthday -> { name; birthday })
299
+
|> mem "name" string ~enc:(fun p -> p.name)
300
+
|> mem "birthday" ptime_date ~enc:(fun p -> p.birthday)
301
+
|> finish
302
+
))
303
+
304
+
(* birthday = 1979-05-27 -> (1979, 5, 27) *)
305
+
]}
306
+
307
+
{2 Time-Only Fields}
308
+
309
+
Use {!Tomlt.ptime_span} for recurring times (as duration from midnight):
310
+
311
+
{[
312
+
type alarm = { label : string; time : Ptime.Span.t }
313
+
314
+
let alarm_codec =
315
+
Tomlt.(Table.(
316
+
obj (fun label time -> { label; time })
317
+
|> mem "label" string ~enc:(fun a -> a.label)
318
+
|> mem "time" ptime_span ~enc:(fun a -> a.time)
319
+
|> finish
320
+
))
321
+
322
+
(* time = 07:30:00 -> 27000 seconds (7.5 hours from midnight) *)
323
+
]}
324
+
325
+
{2 Preserving Datetime Format}
326
+
327
+
Use {!Tomlt.ptime_full} to preserve the exact datetime variant for
328
+
roundtripping:
329
+
330
+
{[
331
+
type flexible_event = {
332
+
name : string;
333
+
when_ : Toml.ptime_datetime;
334
+
}
335
+
336
+
let flexible_codec =
337
+
Tomlt.(Table.(
338
+
obj (fun name when_ -> { name; when_ })
339
+
|> mem "name" string ~enc:(fun e -> e.name)
340
+
|> mem "when" (ptime_full ()) ~enc:(fun e -> e.when_)
341
+
|> finish
342
+
))
343
+
344
+
(* Decoding preserves the variant:
345
+
when = 2024-01-15T10:30:00Z -> `Datetime (ptime, Some 0)
346
+
when = 2024-01-15T10:30:00 -> `Datetime_local ptime
347
+
when = 2024-01-15 -> `Date (2024, 1, 15)
348
+
when = 10:30:00 -> `Time (10, 30, 0, 0)
349
+
350
+
Encoding reproduces the original format. *)
351
+
]}
352
+
353
+
{2 Timezone Handling}
354
+
355
+
For local datetimes without explicit timezone, you can specify how
356
+
to interpret them:
357
+
358
+
{[
359
+
(* Force UTC interpretation *)
360
+
let utc_codec = Tomlt.ptime ~tz_offset_s:0 ()
361
+
362
+
(* Force Eastern Time (-05:00 = -18000 seconds) *)
363
+
let eastern_codec = Tomlt.ptime ~tz_offset_s:(-18000) ()
364
+
365
+
(* Use system timezone (requires Tomlt_unix) *)
366
+
let system_codec =
367
+
Tomlt.ptime ~get_tz:Tomlt_unix.current_tz_offset_s ()
368
+
]}
369
+
370
+
{1:arrays Working with Arrays}
371
+
372
+
TOML 1.1 supports heterogeneous arrays, but most use cases involve
373
+
homogeneous arrays of a single type.
374
+
375
+
{2 Basic Arrays}
376
+
377
+
{[
378
+
type config = {
379
+
name : string;
380
+
ports : int list;
381
+
hosts : string list;
382
+
}
383
+
384
+
let config_codec =
385
+
Tomlt.(Table.(
386
+
obj (fun name ports hosts -> { name; ports; hosts })
387
+
|> mem "name" string ~enc:(fun c -> c.name)
388
+
|> mem "ports" (list int) ~enc:(fun c -> c.ports)
389
+
|> mem "hosts" (list string) ~enc:(fun c -> c.hosts)
390
+
|> finish
391
+
))
392
+
]}
393
+
394
+
{v
395
+
name = "load-balancer"
396
+
ports = [80, 443, 8080]
397
+
hosts = ["web1.example.com", "web2.example.com"]
398
+
v}
399
+
400
+
{2 Arrays of Tables}
401
+
402
+
Use {!Tomlt.array_of_tables} for TOML's [[[name]]] syntax:
403
+
404
+
{[
405
+
type product = { name : string; price : float }
406
+
type catalog = { products : product list }
407
+
408
+
let product_codec =
409
+
Tomlt.(Table.(
410
+
obj (fun name price -> { name; price })
411
+
|> mem "name" string ~enc:(fun p -> p.name)
412
+
|> mem "price" float ~enc:(fun p -> p.price)
413
+
|> finish
414
+
))
415
+
416
+
let catalog_codec =
417
+
Tomlt.(Table.(
418
+
obj (fun products -> { products })
419
+
|> mem "products" (array_of_tables product_codec)
420
+
~enc:(fun c -> c.products)
421
+
|> finish
422
+
))
423
+
]}
424
+
425
+
{v
426
+
[[products]]
427
+
name = "Widget"
428
+
price = 9.99
429
+
430
+
[[products]]
431
+
name = "Gadget"
432
+
price = 19.99
433
+
v}
434
+
435
+
{2 Nested Arrays}
436
+
437
+
Arrays can contain other arrays:
438
+
439
+
{[
440
+
type matrix = { rows : int list list }
441
+
442
+
let matrix_codec =
443
+
Tomlt.(Table.(
444
+
obj (fun rows -> { rows })
445
+
|> mem "rows" (list (list int)) ~enc:(fun m -> m.rows)
446
+
|> finish
447
+
))
448
+
]}
449
+
450
+
{v
451
+
rows = [[1, 2, 3], [4, 5, 6], [7, 8, 9]]
452
+
v}
453
+
454
+
{2 Custom Array Types}
455
+
456
+
Use {!val:Tomlt.Array.map} to decode into custom collection types:
457
+
458
+
{[
459
+
module IntSet = Set.Make(Int)
460
+
461
+
let int_set_codec =
462
+
Tomlt.Array.(
463
+
map int
464
+
~dec_empty:(fun () -> IntSet.empty)
465
+
~dec_add:(fun x acc -> IntSet.add x acc)
466
+
~dec_finish:(fun acc -> acc)
467
+
~enc:{ fold = (fun f acc set -> IntSet.fold (fun x a -> f a x) set acc) }
468
+
|> finish
469
+
)
470
+
]}
471
+
472
+
{1:tables Nested Tables and Objects}
473
+
474
+
{2 Inline Tables}
475
+
476
+
Use {!Tomlt.Table.inline} to encode as inline tables:
477
+
478
+
{[
479
+
type point = { x : int; y : int }
480
+
481
+
let point_codec =
482
+
Tomlt.(Table.(
483
+
obj (fun x y -> { x; y })
484
+
|> mem "x" int ~enc:(fun p -> p.x)
485
+
|> mem "y" int ~enc:(fun p -> p.y)
486
+
|> inline (* <- produces inline table *)
487
+
))
488
+
489
+
(* Encodes as: point = { x = 10, y = 20 } *)
490
+
(* Instead of:
491
+
[point]
492
+
x = 10
493
+
y = 20 *)
494
+
]}
495
+
496
+
{2 Deeply Nested Structures}
497
+
498
+
{[
499
+
type address = { street : string; city : string }
500
+
type company = { name : string; address : address }
501
+
type employee = { name : string; company : company }
502
+
503
+
let address_codec =
504
+
Tomlt.(Table.(
505
+
obj (fun street city -> { street; city })
506
+
|> mem "street" string ~enc:(fun a -> a.street)
507
+
|> mem "city" string ~enc:(fun a -> a.city)
508
+
|> finish
509
+
))
510
+
511
+
let company_codec =
512
+
Tomlt.(Table.(
513
+
obj (fun name address -> { name; address })
514
+
|> mem "name" string ~enc:(fun c -> c.name)
515
+
|> mem "address" address_codec ~enc:(fun c -> c.address)
516
+
|> finish
517
+
))
518
+
519
+
let employee_codec =
520
+
Tomlt.(Table.(
521
+
obj (fun name company -> { name; company })
522
+
|> mem "name" string ~enc:(fun e -> e.name)
523
+
|> mem "company" company_codec ~enc:(fun e -> e.company)
524
+
|> finish
525
+
))
526
+
]}
527
+
528
+
{v
529
+
name = "Alice"
530
+
531
+
[company]
532
+
name = "Acme Corp"
533
+
534
+
[company.address]
535
+
street = "123 Main St"
536
+
city = "Springfield"
537
+
v}
538
+
539
+
{1:unknown_members Unknown Member Handling}
540
+
541
+
By default, unknown members in TOML tables are ignored. You can
542
+
change this behavior.
543
+
544
+
{2 Ignoring Unknown Members (Default)}
545
+
546
+
{[
547
+
let config_codec =
548
+
Tomlt.(Table.(
549
+
obj (fun host -> host)
550
+
|> mem "host" string ~enc:Fun.id
551
+
|> skip_unknown (* default, can be omitted *)
552
+
|> finish
553
+
))
554
+
555
+
(* This works even with extra keys: *)
556
+
(* host = "localhost"
557
+
unknown_key = "ignored" *)
558
+
]}
559
+
560
+
{2 Rejecting Unknown Members}
561
+
562
+
Use {!Tomlt.Table.error_unknown} for strict parsing:
563
+
564
+
{[
565
+
let strict_config_codec =
566
+
Tomlt.(Table.(
567
+
obj (fun host port -> (host, port))
568
+
|> mem "host" string ~enc:fst
569
+
|> mem "port" int ~enc:snd
570
+
|> error_unknown (* <- rejects unknown keys *)
571
+
|> finish
572
+
))
573
+
574
+
(* Error on: host = "localhost"
575
+
port = 8080
576
+
typo = "oops" <- causes error *)
577
+
]}
578
+
579
+
{2 Collecting Unknown Members}
580
+
581
+
Use {!Tomlt.Table.keep_unknown} to preserve unknown members:
582
+
583
+
{[
584
+
type config = {
585
+
name : string;
586
+
extra : (string * Toml.t) list;
587
+
}
588
+
589
+
let config_codec =
590
+
Tomlt.(Table.(
591
+
obj (fun name extra -> { name; extra })
592
+
|> mem "name" string ~enc:(fun c -> c.name)
593
+
|> keep_unknown (Mems.assoc value) ~enc:(fun c -> c.extra)
594
+
|> finish
595
+
))
596
+
597
+
(* Decoding:
598
+
name = "app"
599
+
foo = 42
600
+
bar = "hello"
601
+
602
+
Results in:
603
+
{ name = "app"; extra = [("foo", Int 42L); ("bar", String "hello")] }
604
+
*)
605
+
]}
606
+
607
+
{2 Typed Unknown Members}
608
+
609
+
Collect unknown members with a specific type:
610
+
611
+
{[
612
+
module StringMap = Map.Make(String)
613
+
614
+
type translations = {
615
+
default_lang : string;
616
+
strings : string StringMap.t;
617
+
}
618
+
619
+
let translations_codec =
620
+
Tomlt.(Table.(
621
+
obj (fun default_lang strings -> { default_lang; strings })
622
+
|> mem "default_lang" string ~enc:(fun t -> t.default_lang)
623
+
|> keep_unknown (Mems.string_map string) ~enc:(fun t -> t.strings)
624
+
|> finish
625
+
))
626
+
627
+
(* Decoding:
628
+
default_lang = "en"
629
+
hello = "Hello"
630
+
goodbye = "Goodbye"
631
+
thanks = "Thank you"
632
+
633
+
All string keys except default_lang go into the strings map.
634
+
*)
635
+
]}
636
+
637
+
{1:validation Validation and Constraints}
638
+
639
+
{2 Range Validation with iter}
640
+
641
+
Use {!Tomlt.iter} to add validation:
642
+
643
+
{[
644
+
let port_codec =
645
+
Tomlt.(iter int
646
+
~dec:(fun p ->
647
+
if p < 0 || p > 65535 then
648
+
failwith "port must be between 0 and 65535"))
649
+
650
+
let percentage_codec =
651
+
Tomlt.(iter float
652
+
~dec:(fun p ->
653
+
if p < 0.0 || p > 100.0 then
654
+
failwith "percentage must be between 0 and 100"))
655
+
]}
656
+
657
+
{2 String Enumerations}
658
+
659
+
Use {!Tomlt.enum} for fixed string values:
660
+
661
+
{[
662
+
type log_level = Debug | Info | Warning | Error
663
+
664
+
let log_level_codec =
665
+
Tomlt.enum [
666
+
"debug", Debug;
667
+
"info", Info;
668
+
"warning", Warning;
669
+
"error", Error;
670
+
]
671
+
672
+
type config = { level : log_level }
673
+
674
+
let config_codec =
675
+
Tomlt.(Table.(
676
+
obj (fun level -> { level })
677
+
|> mem "level" log_level_codec ~enc:(fun c -> c.level)
678
+
|> finish
679
+
))
680
+
]}
681
+
682
+
{2 Custom Transformations with map}
683
+
684
+
Use {!Tomlt.map} to transform between representations:
685
+
686
+
{[
687
+
(* Store URI as string in TOML *)
688
+
let uri_codec =
689
+
Tomlt.(map string
690
+
~dec:Uri.of_string
691
+
~enc:Uri.to_string)
692
+
693
+
(* Parse comma-separated tags *)
694
+
let tags_codec =
695
+
Tomlt.(map string
696
+
~dec:(String.split_on_char ',')
697
+
~enc:(String.concat ","))
698
+
]}
699
+
700
+
{1:roundtripping Roundtripping TOML}
701
+
702
+
{2 Preserving Raw Values}
703
+
704
+
Use {!Tomlt.value} to preserve parts of a document unchanged:
705
+
706
+
{[
707
+
type partial_config = {
708
+
version : int;
709
+
rest : Toml.t; (* preserve everything else *)
710
+
}
711
+
712
+
(* This requires a different approach - extract version,
713
+
keep the rest as raw TOML *)
714
+
]}
715
+
716
+
{2 Preserving Datetime Variants}
717
+
718
+
Use {!Tomlt.ptime_full} to roundtrip datetime formats:
719
+
720
+
{[
721
+
type event = {
722
+
name : string;
723
+
when_ : Toml.ptime_datetime;
724
+
}
725
+
726
+
let event_codec =
727
+
Tomlt.(Table.(
728
+
obj (fun name when_ -> { name; when_ })
729
+
|> mem "name" string ~enc:(fun e -> e.name)
730
+
|> mem "when" (ptime_full ()) ~enc:(fun e -> e.when_)
731
+
|> finish
732
+
))
733
+
734
+
(* Input: when = 2024-01-15
735
+
Output: when = 2024-01-15 (not 2024-01-15T00:00:00Z) *)
736
+
]}
737
+
738
+
{1:error_handling Error Handling}
739
+
740
+
{2 Result-Based Decoding}
741
+
742
+
Always use {!Tomlt.decode} in production code:
743
+
744
+
{[
745
+
let load_config path =
746
+
match Tomlt_unix.decode_file config_codec path with
747
+
| Ok config -> config
748
+
| Error e ->
749
+
Printf.eprintf "Configuration error: %s\n"
750
+
(Toml.Error.to_string e);
751
+
exit 1
752
+
]}
753
+
754
+
{2 Decoding with Context}
755
+
756
+
Errors include path information for nested structures:
757
+
758
+
{[
759
+
(* For deeply nested errors like:
760
+
[database]
761
+
port = "not an int"
762
+
763
+
The error will indicate:
764
+
"at database.port: expected int, got string" *)
765
+
]}
766
+
767
+
{2 Multiple Validation Errors}
768
+
769
+
For collecting multiple errors, decode fields individually:
770
+
771
+
{[
772
+
let validate_config toml =
773
+
let errors = ref [] in
774
+
let get_field name codec =
775
+
match Tomlt.(decode (mem name codec) toml) with
776
+
| Ok v -> Some v
777
+
| Error e ->
778
+
errors := (name, e) :: !errors;
779
+
None
780
+
in
781
+
let host = get_field "host" Tomlt.string in
782
+
let port = get_field "port" Tomlt.int in
783
+
match !errors with
784
+
| [] -> Ok { host = Option.get host; port = Option.get port }
785
+
| errs -> Error errs
786
+
]}
787
+
788
+
{1:recursion Recursive Types}
789
+
790
+
Use {!Tomlt.rec'} for self-referential types:
791
+
792
+
{[
793
+
type tree = Node of int * tree list
794
+
795
+
let rec tree_codec = lazy Tomlt.(
796
+
Table.(
797
+
obj (fun value children -> Node (value, children))
798
+
|> mem "value" int ~enc:(function Node (v, _) -> v)
799
+
|> mem "children" (list (rec' tree_codec))
800
+
~enc:(function Node (_, cs) -> cs)
801
+
~dec_absent:[]
802
+
|> finish
803
+
))
804
+
805
+
let tree_codec = Lazy.force tree_codec
806
+
]}
807
+
808
+
{v
809
+
value = 1
810
+
811
+
[[children]]
812
+
value = 2
813
+
814
+
[[children]]
815
+
value = 3
816
+
817
+
[[children.children]]
818
+
value = 4
819
+
v}
+3
vendor/opam/tomlt/doc/dune
+3
vendor/opam/tomlt/doc/dune
+71
vendor/opam/tomlt/doc/index.mld
+71
vendor/opam/tomlt/doc/index.mld
···
1
+
{0 Tomlt}
2
+
3
+
{1 TOML 1.1 Codec Library}
4
+
5
+
Tomlt is a bidirectional codec library for {{:https://toml.io/en/v1.1.0}TOML 1.1}
6
+
configuration files. It provides type-safe encoding and decoding between
7
+
OCaml types and TOML values.
8
+
9
+
{2 Quick Start}
10
+
11
+
Define a codec for your configuration type:
12
+
13
+
{[
14
+
type config = { host : string; port : int; debug : bool }
15
+
16
+
let config_codec =
17
+
Tomlt.(Table.(
18
+
obj (fun host port debug -> { host; port; debug })
19
+
|> mem "host" string ~enc:(fun c -> c.host)
20
+
|> mem "port" int ~enc:(fun c -> c.port)
21
+
|> mem "debug" bool ~enc:(fun c -> c.debug) ~dec_absent:false
22
+
|> finish
23
+
))
24
+
]}
25
+
26
+
Parse and use it:
27
+
28
+
{[
29
+
let () =
30
+
match Tomlt_bytesrw.decode_string config_codec {|
31
+
host = "localhost"
32
+
port = 8080
33
+
|} with
34
+
| Ok config -> Printf.printf "Host: %s\n" config.host
35
+
| Error e -> prerr_endline (Toml.Error.to_string e)
36
+
]}
37
+
38
+
{2 Library Structure}
39
+
40
+
- {!Tomlt.Toml} - Core TOML value types and operations
41
+
- {!Tomlt} - Codec combinators for bidirectional TOML encoding/decoding
42
+
- {!Tomlt_bytesrw} - Streaming parser and encoder
43
+
- {!Tomlt_eio} - Eio-native I/O integration
44
+
- {!Tomlt_unix} - Unix I/O integration
45
+
- {!Tomlt_jsont} - JSON codec for toml-test format
46
+
47
+
{2 Cookbook}
48
+
49
+
The {{!page-cookbook}cookbook} provides patterns and recipes for common
50
+
TOML scenarios:
51
+
52
+
- {{!page-cookbook.config_files}Parsing configuration files}
53
+
- {{!page-cookbook.optional_values}Optional and absent values}
54
+
- {{!page-cookbook.datetimes}Working with datetimes}
55
+
- {{!page-cookbook.arrays}Working with arrays}
56
+
- {{!page-cookbook.tables}Nested tables and objects}
57
+
- {{!page-cookbook.unknown_members}Unknown member handling}
58
+
- {{!page-cookbook.validation}Validation and constraints}
59
+
- {{!page-cookbook.roundtripping}Roundtripping TOML}
60
+
- {{!page-cookbook.error_handling}Error handling}
61
+
62
+
{2 Design}
63
+
64
+
Tomlt is inspired by {{:https://erratique.ch/software/jsont}Jsont}'s approach
65
+
to JSON codecs. Each codec ['a Tomlt.t] defines both:
66
+
67
+
- A decoder: [Toml.t -> ('a, error) result]
68
+
- An encoder: ['a -> Toml.t]
69
+
70
+
Codecs compose through combinators, allowing complex types to be built
71
+
from simple primitives while maintaining bidirectionality.
+32
vendor/opam/tomlt/dune-project
+32
vendor/opam/tomlt/dune-project
···
1
+
(lang dune 3.0)
2
+
(name tomlt)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(license ISC)
7
+
(authors "Anil Madhavapeddy <anil@recoil.org>")
8
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
9
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-tomlt")
10
+
(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-tomlt/issues")
11
+
12
+
(package
13
+
(name tomlt)
14
+
(synopsis "TOML 1.1 codec library for OCaml")
15
+
(description
16
+
"Tomlt is a type-safe TOML 1.1 codec library for OCaml, providing
17
+
bidirectional encoding and decoding using a combinator-based approach
18
+
inspired by Jsont. The core library provides value types and codec
19
+
combinators. Optional subpackages provide I/O support:
20
+
- tomlt.bytesrw: Streaming parser/encoder using Bytesrw
21
+
- tomlt.eio: Eio integration with system clock
22
+
- tomlt.unix: Unix I/O with system clock
23
+
- tomlt.jsont: Jsont codecs for toml-test JSON format")
24
+
(depends
25
+
(ocaml (>= 4.14.0))
26
+
(ptime (>= 1.0.0))
27
+
(alcotest :with-test))
28
+
(depopts
29
+
(bytesrw (>= 0.1.0))
30
+
(uutf (>= 1.0.0))
31
+
eio
32
+
jsont))
+5
vendor/opam/tomlt/lib/dune
+5
vendor/opam/tomlt/lib/dune
+485
vendor/opam/tomlt/lib/toml.ml
+485
vendor/opam/tomlt/lib/toml.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* TOML value representation *)
7
+
8
+
type t =
9
+
| String of string
10
+
| Int of int64
11
+
| Float of float
12
+
| Bool of bool
13
+
| Datetime of string (* Offset datetime *)
14
+
| Datetime_local of string (* Local datetime *)
15
+
| Date_local of string (* Local date *)
16
+
| Time_local of string (* Local time *)
17
+
| Array of t list
18
+
| Table of (string * t) list
19
+
20
+
(* ============================================
21
+
Value Constructors
22
+
============================================ *)
23
+
24
+
let string s = String s
25
+
let int i = Int i
26
+
let int_of_int i = Int (Int64.of_int i)
27
+
let float f = Float f
28
+
let bool b = Bool b
29
+
let array vs = Array vs
30
+
let table pairs = Table pairs
31
+
let datetime s = Datetime s
32
+
let datetime_local s = Datetime_local s
33
+
let date_local s = Date_local s
34
+
let time_local s = Time_local s
35
+
36
+
(* ============================================
37
+
Ptime Conversions
38
+
============================================ *)
39
+
40
+
let datetime_of_ptime ?(tz_offset_s = 0) ?(frac_s = 0) ptime =
41
+
Datetime (Ptime.to_rfc3339 ~tz_offset_s ~frac_s ptime)
42
+
43
+
let date_of_ptime ?(tz_offset_s = 0) ptime =
44
+
let (year, month, day) = Ptime.to_date ~tz_offset_s ptime in
45
+
Date_local (Printf.sprintf "%04d-%02d-%02d" year month day)
46
+
47
+
(* Helper to normalize TOML datetime for ptime parsing.
48
+
TOML 1.1 allows optional seconds (e.g., "1979-05-27T07:32Z"),
49
+
but ptime requires seconds. We add ":00" when missing. *)
50
+
let normalize_datetime_for_ptime s =
51
+
let len = String.length s in
52
+
if len < 16 then s (* Too short, let ptime handle the error *)
53
+
else
54
+
(* Check if we have HH:MM followed by timezone or end without seconds *)
55
+
(* Format: YYYY-MM-DDTHH:MM... position 16 would be after HH:MM *)
56
+
let has_t = len > 10 && (s.[10] = 'T' || s.[10] = 't' || s.[10] = ' ') in
57
+
if not has_t then s
58
+
else if len >= 17 && s.[16] = ':' then s (* Already has seconds *)
59
+
else if len = 16 then
60
+
(* YYYY-MM-DDTHH:MM - local datetime without seconds, add :00 *)
61
+
s ^ ":00"
62
+
else
63
+
let c16 = s.[16] in
64
+
if c16 = 'Z' || c16 = 'z' || c16 = '+' || c16 = '-' then
65
+
(* YYYY-MM-DDTHH:MMZ or YYYY-MM-DDTHH:MM+... - insert :00 before tz *)
66
+
String.sub s 0 16 ^ ":00" ^ String.sub s 16 (len - 16)
67
+
else if c16 = '.' then
68
+
(* YYYY-MM-DDTHH:MM.fraction - unusual but handle it *)
69
+
s
70
+
else
71
+
s
72
+
73
+
let to_ptime_tz = function
74
+
| Datetime s ->
75
+
let normalized = normalize_datetime_for_ptime s in
76
+
(match Ptime.of_rfc3339 ~strict:false normalized with
77
+
| Ok (t, tz, _) -> Some (t, tz)
78
+
| Error _ -> None)
79
+
| _ -> None
80
+
81
+
let to_ptime_opt = function
82
+
| Datetime s ->
83
+
let normalized = normalize_datetime_for_ptime s in
84
+
(match Ptime.of_rfc3339 ~strict:false normalized with
85
+
| Ok (t, _, _) -> Some t
86
+
| Error _ -> None)
87
+
| _ -> None
88
+
89
+
let to_ptime t =
90
+
match to_ptime_opt t with
91
+
| Some ptime -> ptime
92
+
| None ->
93
+
match t with
94
+
| Datetime _ -> invalid_arg "Toml.to_ptime: cannot parse datetime"
95
+
| Datetime_local _ -> invalid_arg "Toml.to_ptime: local datetime has no timezone"
96
+
| Date_local _ -> invalid_arg "Toml.to_ptime: date_local is not a datetime"
97
+
| Time_local _ -> invalid_arg "Toml.to_ptime: time_local is not a datetime"
98
+
| _ -> invalid_arg "Toml.to_ptime: not a datetime"
99
+
100
+
let to_date_opt = function
101
+
| Date_local s when String.length s >= 10 ->
102
+
(try
103
+
let year = int_of_string (String.sub s 0 4) in
104
+
let month = int_of_string (String.sub s 5 2) in
105
+
let day = int_of_string (String.sub s 8 2) in
106
+
(* Validate using Ptime.of_date *)
107
+
match Ptime.of_date (year, month, day) with
108
+
| Some _ -> Some (year, month, day)
109
+
| None -> None
110
+
with _ -> None)
111
+
| _ -> None
112
+
113
+
let to_date t =
114
+
match to_date_opt t with
115
+
| Some date -> date
116
+
| None ->
117
+
match t with
118
+
| Date_local _ -> invalid_arg "Toml.to_date: cannot parse date"
119
+
| _ -> invalid_arg "Toml.to_date: not a date_local"
120
+
121
+
(* Unified ptime datetime type *)
122
+
123
+
type ptime_datetime = [
124
+
| `Datetime of Ptime.t * Ptime.tz_offset_s option
125
+
| `Datetime_local of Ptime.t
126
+
| `Date of Ptime.date
127
+
| `Time of int * int * int * int (* hour, minute, second, nanoseconds *)
128
+
]
129
+
130
+
(* Parse local datetime string to ptime using given timezone offset *)
131
+
let parse_local_datetime_with_tz tz_offset_s s =
132
+
let normalized = normalize_datetime_for_ptime s in
133
+
(* Append timezone to make it parseable by ptime *)
134
+
let tz_str =
135
+
if tz_offset_s = 0 then "Z"
136
+
else
137
+
let sign = if tz_offset_s >= 0 then '+' else '-' in
138
+
let abs_offset = abs tz_offset_s in
139
+
let hours = abs_offset / 3600 in
140
+
let minutes = (abs_offset mod 3600) / 60 in
141
+
Printf.sprintf "%c%02d:%02d" sign hours minutes
142
+
in
143
+
let with_tz = normalized ^ tz_str in
144
+
match Ptime.of_rfc3339 ~strict:false with_tz with
145
+
| Ok (t, _, _) -> Some t
146
+
| Error _ -> None
147
+
148
+
(* Parse local time string to (hour, minute, second, nanoseconds) *)
149
+
let parse_local_time s =
150
+
let len = String.length s in
151
+
if len < 5 then None
152
+
else
153
+
try
154
+
let hour = int_of_string (String.sub s 0 2) in
155
+
let minute = int_of_string (String.sub s 3 2) in
156
+
let second, frac =
157
+
if len >= 8 then
158
+
let sec = int_of_string (String.sub s 6 2) in
159
+
let frac =
160
+
if len > 9 && s.[8] = '.' then
161
+
let frac_str = String.sub s 9 (len - 9) in
162
+
(* Pad or truncate to 9 digits for nanoseconds *)
163
+
let padded =
164
+
if String.length frac_str >= 9 then String.sub frac_str 0 9
165
+
else frac_str ^ String.make (9 - String.length frac_str) '0'
166
+
in
167
+
int_of_string padded
168
+
else 0
169
+
in
170
+
(sec, frac)
171
+
else
172
+
(* TOML 1.1: optional seconds *)
173
+
(0, 0)
174
+
in
175
+
if hour >= 0 && hour <= 23 &&
176
+
minute >= 0 && minute <= 59 &&
177
+
second >= 0 && second <= 60 then (* 60 for leap second *)
178
+
Some (hour, minute, second, frac)
179
+
else
180
+
None
181
+
with _ -> None
182
+
183
+
let to_ptime_datetime ?tz_offset_s t =
184
+
let get_tz () =
185
+
match tz_offset_s with
186
+
| Some tz -> tz
187
+
| None -> 0 (* Default to UTC when no timezone provided *)
188
+
in
189
+
match t with
190
+
| Datetime s ->
191
+
let normalized = normalize_datetime_for_ptime s in
192
+
(match Ptime.of_rfc3339 ~strict:false normalized with
193
+
| Ok (ptime, tz, _) -> Some (`Datetime (ptime, tz))
194
+
| Error _ -> None)
195
+
| Datetime_local s ->
196
+
let tz = get_tz () in
197
+
(match parse_local_datetime_with_tz tz s with
198
+
| Some ptime -> Some (`Datetime_local ptime)
199
+
| None -> None)
200
+
| Date_local _ ->
201
+
(match to_date_opt t with
202
+
| Some date -> Some (`Date date)
203
+
| None -> None)
204
+
| Time_local s ->
205
+
(match parse_local_time s with
206
+
| Some time -> Some (`Time time)
207
+
| None -> None)
208
+
| _ -> None
209
+
210
+
let ptime_datetime_to_toml = function
211
+
| `Datetime (ptime, tz) ->
212
+
let tz_offset_s = Option.value ~default:0 tz in
213
+
Datetime (Ptime.to_rfc3339 ~tz_offset_s ptime)
214
+
| `Datetime_local ptime ->
215
+
(* Convert to local time string without timezone *)
216
+
let ((year, month, day), ((hour, minute, second), _)) =
217
+
Ptime.to_date_time ptime
218
+
in
219
+
Datetime_local (Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02d"
220
+
year month day hour minute second)
221
+
| `Date (year, month, day) ->
222
+
Date_local (Printf.sprintf "%04d-%02d-%02d" year month day)
223
+
| `Time (hour, minute, second, ns) ->
224
+
if ns = 0 then
225
+
Time_local (Printf.sprintf "%02d:%02d:%02d" hour minute second)
226
+
else
227
+
(* Format nanoseconds, trimming trailing zeros *)
228
+
let ns_str = Printf.sprintf "%09d" ns in
229
+
let rec trim_end i =
230
+
if i <= 0 then 1
231
+
else if ns_str.[i] <> '0' then i + 1
232
+
else trim_end (i - 1)
233
+
in
234
+
let ns_trimmed = String.sub ns_str 0 (trim_end 8) in
235
+
Time_local (Printf.sprintf "%02d:%02d:%02d.%s" hour minute second ns_trimmed)
236
+
237
+
let pp_ptime_datetime fmt = function
238
+
| `Datetime (ptime, tz) ->
239
+
let tz_offset_s = Option.value ~default:0 tz in
240
+
Format.fprintf fmt "`Datetime %s" (Ptime.to_rfc3339 ~tz_offset_s ptime)
241
+
| `Datetime_local ptime ->
242
+
Format.fprintf fmt "`Datetime_local %s" (Ptime.to_rfc3339 ~tz_offset_s:0 ptime)
243
+
| `Date (year, month, day) ->
244
+
Format.fprintf fmt "`Date %04d-%02d-%02d" year month day
245
+
| `Time (hour, minute, second, ns) ->
246
+
if ns = 0 then
247
+
Format.fprintf fmt "`Time %02d:%02d:%02d" hour minute second
248
+
else
249
+
Format.fprintf fmt "`Time %02d:%02d:%02d.%09d" hour minute second ns
250
+
251
+
(* ============================================
252
+
Value Accessors
253
+
============================================ *)
254
+
255
+
let to_string = function
256
+
| String s -> s
257
+
| _ -> invalid_arg "Toml.to_string: not a string"
258
+
259
+
let to_string_opt = function
260
+
| String s -> Some s
261
+
| _ -> None
262
+
263
+
let to_int = function
264
+
| Int i -> i
265
+
| _ -> invalid_arg "Toml.to_int: not an integer"
266
+
267
+
let to_int_opt = function
268
+
| Int i -> Some i
269
+
| _ -> None
270
+
271
+
let to_float = function
272
+
| Float f -> f
273
+
| _ -> invalid_arg "Toml.to_float: not a float"
274
+
275
+
let to_float_opt = function
276
+
| Float f -> Some f
277
+
| _ -> None
278
+
279
+
let to_bool = function
280
+
| Bool b -> b
281
+
| _ -> invalid_arg "Toml.to_bool: not a boolean"
282
+
283
+
let to_bool_opt = function
284
+
| Bool b -> Some b
285
+
| _ -> None
286
+
287
+
let to_array = function
288
+
| Array vs -> vs
289
+
| _ -> invalid_arg "Toml.to_array: not an array"
290
+
291
+
let to_array_opt = function
292
+
| Array vs -> Some vs
293
+
| _ -> None
294
+
295
+
let to_table = function
296
+
| Table pairs -> pairs
297
+
| _ -> invalid_arg "Toml.to_table: not a table"
298
+
299
+
let to_table_opt = function
300
+
| Table pairs -> Some pairs
301
+
| _ -> None
302
+
303
+
let to_datetime = function
304
+
| Datetime s | Datetime_local s | Date_local s | Time_local s -> s
305
+
| _ -> invalid_arg "Toml.to_datetime: not a datetime"
306
+
307
+
let to_datetime_opt = function
308
+
| Datetime s | Datetime_local s | Date_local s | Time_local s -> Some s
309
+
| _ -> None
310
+
311
+
(* ============================================
312
+
Type Predicates
313
+
============================================ *)
314
+
315
+
let is_string = function String _ -> true | _ -> false
316
+
let is_int = function Int _ -> true | _ -> false
317
+
let is_float = function Float _ -> true | _ -> false
318
+
let is_bool = function Bool _ -> true | _ -> false
319
+
let is_array = function Array _ -> true | _ -> false
320
+
let is_table = function Table _ -> true | _ -> false
321
+
let is_datetime = function
322
+
| Datetime _ | Datetime_local _ | Date_local _ | Time_local _ -> true
323
+
| _ -> false
324
+
325
+
(* ============================================
326
+
Table Navigation
327
+
============================================ *)
328
+
329
+
let find key = function
330
+
| Table pairs -> List.assoc key pairs
331
+
| _ -> invalid_arg "Toml.find: not a table"
332
+
333
+
let find_opt key = function
334
+
| Table pairs -> List.assoc_opt key pairs
335
+
| _ -> None
336
+
337
+
let mem key = function
338
+
| Table pairs -> List.mem_assoc key pairs
339
+
| _ -> false
340
+
341
+
let keys = function
342
+
| Table pairs -> List.map fst pairs
343
+
| _ -> invalid_arg "Toml.keys: not a table"
344
+
345
+
let rec get path t =
346
+
match path with
347
+
| [] -> t
348
+
| key :: rest ->
349
+
match t with
350
+
| Table pairs ->
351
+
(match List.assoc_opt key pairs with
352
+
| Some v -> get rest v
353
+
| None -> raise Not_found)
354
+
| _ -> invalid_arg "Toml.get: intermediate value is not a table"
355
+
356
+
let get_opt path t =
357
+
try Some (get path t) with Not_found | Invalid_argument _ -> None
358
+
359
+
let ( .%{} ) t path = get path t
360
+
361
+
let rec set_at_path path v t =
362
+
match path with
363
+
| [] -> v
364
+
| [key] ->
365
+
(match t with
366
+
| Table pairs ->
367
+
let pairs' = List.filter (fun (k, _) -> k <> key) pairs in
368
+
Table ((key, v) :: pairs')
369
+
| _ -> invalid_arg "Toml.(.%{}<-): not a table")
370
+
| key :: rest ->
371
+
match t with
372
+
| Table pairs ->
373
+
let existing = List.assoc_opt key pairs in
374
+
let subtable = match existing with
375
+
| Some (Table _ as sub) -> sub
376
+
| Some _ -> invalid_arg "Toml.(.%{}<-): intermediate value is not a table"
377
+
| None -> Table []
378
+
in
379
+
let updated = set_at_path rest v subtable in
380
+
let pairs' = List.filter (fun (k, _) -> k <> key) pairs in
381
+
Table ((key, updated) :: pairs')
382
+
| _ -> invalid_arg "Toml.(.%{}<-): not a table"
383
+
384
+
let ( .%{}<- ) t path v = set_at_path path v t
385
+
386
+
(* ============================================
387
+
Pretty Printing
388
+
============================================ *)
389
+
390
+
let rec pp_value fmt = function
391
+
| String s ->
392
+
Format.fprintf fmt "\"%s\"" (String.escaped s)
393
+
| Int i ->
394
+
Format.fprintf fmt "%Ld" i
395
+
| Float f ->
396
+
if Float.is_nan f then Format.fprintf fmt "nan"
397
+
else if f = Float.infinity then Format.fprintf fmt "inf"
398
+
else if f = Float.neg_infinity then Format.fprintf fmt "-inf"
399
+
else Format.fprintf fmt "%g" f
400
+
| Bool b ->
401
+
Format.fprintf fmt "%s" (if b then "true" else "false")
402
+
| Datetime s | Datetime_local s | Date_local s | Time_local s ->
403
+
Format.fprintf fmt "%s" s
404
+
| Array items ->
405
+
Format.fprintf fmt "[";
406
+
List.iteri (fun i item ->
407
+
if i > 0 then Format.fprintf fmt ", ";
408
+
pp_value fmt item
409
+
) items;
410
+
Format.fprintf fmt "]"
411
+
| Table pairs ->
412
+
Format.fprintf fmt "{";
413
+
List.iteri (fun i (k, v) ->
414
+
if i > 0 then Format.fprintf fmt ", ";
415
+
Format.fprintf fmt "%s = " k;
416
+
pp_value fmt v
417
+
) pairs;
418
+
Format.fprintf fmt "}"
419
+
420
+
let pp = pp_value
421
+
422
+
(* ============================================
423
+
Equality and Comparison
424
+
============================================ *)
425
+
426
+
let rec equal a b =
427
+
match a, b with
428
+
| String s1, String s2 -> String.equal s1 s2
429
+
| Int i1, Int i2 -> Int64.equal i1 i2
430
+
| Float f1, Float f2 ->
431
+
(* NaN = NaN for TOML equality *)
432
+
(Float.is_nan f1 && Float.is_nan f2) || Float.equal f1 f2
433
+
| Bool b1, Bool b2 -> Bool.equal b1 b2
434
+
| Datetime s1, Datetime s2 -> String.equal s1 s2
435
+
| Datetime_local s1, Datetime_local s2 -> String.equal s1 s2
436
+
| Date_local s1, Date_local s2 -> String.equal s1 s2
437
+
| Time_local s1, Time_local s2 -> String.equal s1 s2
438
+
| Array vs1, Array vs2 ->
439
+
List.length vs1 = List.length vs2 &&
440
+
List.for_all2 equal vs1 vs2
441
+
| Table ps1, Table ps2 ->
442
+
List.length ps1 = List.length ps2 &&
443
+
List.for_all2 (fun (k1, v1) (k2, v2) ->
444
+
String.equal k1 k2 && equal v1 v2
445
+
) ps1 ps2
446
+
| _ -> false
447
+
448
+
let type_order = function
449
+
| String _ -> 0
450
+
| Int _ -> 1
451
+
| Float _ -> 2
452
+
| Bool _ -> 3
453
+
| Datetime _ -> 4
454
+
| Datetime_local _ -> 5
455
+
| Date_local _ -> 6
456
+
| Time_local _ -> 7
457
+
| Array _ -> 8
458
+
| Table _ -> 9
459
+
460
+
let rec compare a b =
461
+
let ta, tb = type_order a, type_order b in
462
+
if ta <> tb then Int.compare ta tb
463
+
else match a, b with
464
+
| String s1, String s2 -> String.compare s1 s2
465
+
| Int i1, Int i2 -> Int64.compare i1 i2
466
+
| Float f1, Float f2 -> Float.compare f1 f2
467
+
| Bool b1, Bool b2 -> Bool.compare b1 b2
468
+
| Datetime s1, Datetime s2 -> String.compare s1 s2
469
+
| Datetime_local s1, Datetime_local s2 -> String.compare s1 s2
470
+
| Date_local s1, Date_local s2 -> String.compare s1 s2
471
+
| Time_local s1, Time_local s2 -> String.compare s1 s2
472
+
| Array vs1, Array vs2 ->
473
+
List.compare compare vs1 vs2
474
+
| Table ps1, Table ps2 ->
475
+
List.compare (fun (k1, v1) (k2, v2) ->
476
+
let c = String.compare k1 k2 in
477
+
if c <> 0 then c else compare v1 v2
478
+
) ps1 ps2
479
+
| _ -> 0 (* Impossible - handled by type_order check *)
480
+
481
+
(* ============================================
482
+
Error Module
483
+
============================================ *)
484
+
485
+
module Error = Toml_error
+389
vendor/opam/tomlt/lib/toml.mli
+389
vendor/opam/tomlt/lib/toml.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** {{:https://toml.io/en/v1.1.0}TOML 1.1} value types.
7
+
8
+
This module provides the core TOML value type and operations for
9
+
constructing, accessing, and manipulating TOML data. For parsing and
10
+
encoding, see {!Tomlt_bytesrw}. For codec-based bidirectional encoding,
11
+
see {!Tomlt}.
12
+
13
+
{2 Quick Start}
14
+
15
+
Create TOML values programmatically:
16
+
{[
17
+
let config = Toml.(table [
18
+
"title", string "My App";
19
+
"database", table [
20
+
"host", string "localhost";
21
+
"ports", array [int 5432L; int 5433L]
22
+
]
23
+
])
24
+
]}
25
+
26
+
Access values:
27
+
{[
28
+
let host = Toml.to_string (Toml.find "host" (Toml.find "database" config))
29
+
let ports = Toml.to_array (Toml.find "ports" (Toml.find "database" config))
30
+
let port = Toml.to_int (List.hd ports)
31
+
]}
32
+
33
+
See the {{!page-cookbook}cookbook} for common patterns and recipes.
34
+
35
+
{2 Module Overview}
36
+
37
+
- {!section:types} - TOML value representation
38
+
- {!section:construct} - Value constructors
39
+
- {!section:access} - Value accessors and type conversion
40
+
- {!section:navigate} - Table navigation
41
+
- {!section:ptime} - Ptime datetime conversions
42
+
- {!section:pp} - Pretty printing
43
+
- {!module:Error} - Structured error types *)
44
+
45
+
(** {1:types TOML Value Types} *)
46
+
47
+
(** The type of TOML values.
48
+
49
+
TOML supports the following value types:
50
+
- {{:https://toml.io/en/v1.1.0#string}Strings} (UTF-8 encoded)
51
+
- {{:https://toml.io/en/v1.1.0#integer}Integers} (64-bit signed)
52
+
- {{:https://toml.io/en/v1.1.0#float}Floats} (IEEE 754 double precision)
53
+
- {{:https://toml.io/en/v1.1.0#boolean}Booleans}
54
+
- {{:https://toml.io/en/v1.1.0#offset-date-time}Offset date-times} (RFC 3339 with timezone)
55
+
- {{:https://toml.io/en/v1.1.0#local-date-time}Local date-times} (no timezone)
56
+
- {{:https://toml.io/en/v1.1.0#local-date}Local dates}
57
+
- {{:https://toml.io/en/v1.1.0#local-time}Local times}
58
+
- {{:https://toml.io/en/v1.1.0#array}Arrays} (heterogeneous in TOML 1.1)
59
+
- {{:https://toml.io/en/v1.1.0#table}Tables} (string-keyed maps) *)
60
+
type t =
61
+
| String of string
62
+
(** {{:https://toml.io/en/v1.1.0#string}TOML string}. *)
63
+
| Int of int64
64
+
(** {{:https://toml.io/en/v1.1.0#integer}TOML integer}. *)
65
+
| Float of float
66
+
(** {{:https://toml.io/en/v1.1.0#float}TOML float}. *)
67
+
| Bool of bool
68
+
(** {{:https://toml.io/en/v1.1.0#boolean}TOML boolean}. *)
69
+
| Datetime of string
70
+
(** {{:https://toml.io/en/v1.1.0#offset-date-time}Offset datetime},
71
+
e.g. [1979-05-27T07:32:00Z]. *)
72
+
| Datetime_local of string
73
+
(** {{:https://toml.io/en/v1.1.0#local-date-time}Local datetime},
74
+
e.g. [1979-05-27T07:32:00]. *)
75
+
| Date_local of string
76
+
(** {{:https://toml.io/en/v1.1.0#local-date}Local date},
77
+
e.g. [1979-05-27]. *)
78
+
| Time_local of string
79
+
(** {{:https://toml.io/en/v1.1.0#local-time}Local time},
80
+
e.g. [07:32:00]. *)
81
+
| Array of t list
82
+
(** {{:https://toml.io/en/v1.1.0#array}TOML array}. *)
83
+
| Table of (string * t) list
84
+
(** {{:https://toml.io/en/v1.1.0#table}TOML table}. *)
85
+
(** A TOML value. Tables preserve key insertion order. *)
86
+
87
+
(** {1:construct Value Constructors}
88
+
89
+
These functions create TOML values. Use them to build TOML documents
90
+
programmatically. *)
91
+
92
+
val string : string -> t
93
+
(** [string s] creates a {{:https://toml.io/en/v1.1.0#string}TOML string} value. *)
94
+
95
+
val int : int64 -> t
96
+
(** [int i] creates a {{:https://toml.io/en/v1.1.0#integer}TOML integer} value. *)
97
+
98
+
val int_of_int : int -> t
99
+
(** [int_of_int i] creates a {{:https://toml.io/en/v1.1.0#integer}TOML integer}
100
+
value from an [int]. *)
101
+
102
+
val float : float -> t
103
+
(** [float f] creates a {{:https://toml.io/en/v1.1.0#float}TOML float} value. *)
104
+
105
+
val bool : bool -> t
106
+
(** [bool b] creates a {{:https://toml.io/en/v1.1.0#boolean}TOML boolean} value. *)
107
+
108
+
val array : t list -> t
109
+
(** [array vs] creates a {{:https://toml.io/en/v1.1.0#array}TOML array} value
110
+
from a list of values. TOML 1.1 allows heterogeneous arrays. *)
111
+
112
+
val table : (string * t) list -> t
113
+
(** [table pairs] creates a {{:https://toml.io/en/v1.1.0#table}TOML table} value
114
+
from key-value pairs. Keys should be unique; later bindings shadow earlier
115
+
ones during lookup. *)
116
+
117
+
val datetime : string -> t
118
+
(** [datetime s] creates an {{:https://toml.io/en/v1.1.0#offset-date-time}offset
119
+
datetime} value. The string should be in RFC 3339 format with timezone,
120
+
e.g. ["1979-05-27T07:32:00Z"] or ["1979-05-27T07:32:00-07:00"]. *)
121
+
122
+
val datetime_local : string -> t
123
+
(** [datetime_local s] creates a {{:https://toml.io/en/v1.1.0#local-date-time}local
124
+
datetime} value (no timezone). E.g. ["1979-05-27T07:32:00"]. *)
125
+
126
+
val date_local : string -> t
127
+
(** [date_local s] creates a {{:https://toml.io/en/v1.1.0#local-date}local date}
128
+
value. E.g. ["1979-05-27"]. *)
129
+
130
+
val time_local : string -> t
131
+
(** [time_local s] creates a {{:https://toml.io/en/v1.1.0#local-time}local time}
132
+
value. E.g. ["07:32:00"] or ["07:32:00.999"]. *)
133
+
134
+
(** {1:access Value Accessors}
135
+
136
+
These functions extract OCaml values from TOML values.
137
+
They raise [Invalid_argument] if the value is not of the expected type. *)
138
+
139
+
val to_string : t -> string
140
+
(** [to_string t] returns the string if [t] is a [String].
141
+
@raise Invalid_argument if [t] is not a string. *)
142
+
143
+
val to_string_opt : t -> string option
144
+
(** [to_string_opt t] returns [Some s] if [t] is [String s], [None] otherwise. *)
145
+
146
+
val to_int : t -> int64
147
+
(** [to_int t] returns the integer if [t] is an [Int].
148
+
@raise Invalid_argument if [t] is not an integer. *)
149
+
150
+
val to_int_opt : t -> int64 option
151
+
(** [to_int_opt t] returns [Some i] if [t] is [Int i], [None] otherwise. *)
152
+
153
+
val to_float : t -> float
154
+
(** [to_float t] returns the float if [t] is a [Float].
155
+
@raise Invalid_argument if [t] is not a float. *)
156
+
157
+
val to_float_opt : t -> float option
158
+
(** [to_float_opt t] returns [Some f] if [t] is [Float f], [None] otherwise. *)
159
+
160
+
val to_bool : t -> bool
161
+
(** [to_bool t] returns the boolean if [t] is a [Bool].
162
+
@raise Invalid_argument if [t] is not a boolean. *)
163
+
164
+
val to_bool_opt : t -> bool option
165
+
(** [to_bool_opt t] returns [Some b] if [t] is [Bool b], [None] otherwise. *)
166
+
167
+
val to_array : t -> t list
168
+
(** [to_array t] returns the list if [t] is a {{:https://toml.io/en/v1.1.0#array}TOML array}.
169
+
@raise Invalid_argument if [t] is not an array. *)
170
+
171
+
val to_array_opt : t -> t list option
172
+
(** [to_array_opt t] returns [Some vs] if [t] is [Array vs], [None] otherwise. *)
173
+
174
+
val to_table : t -> (string * t) list
175
+
(** [to_table t] returns the association list if [t] is a {{:https://toml.io/en/v1.1.0#table}TOML table}.
176
+
@raise Invalid_argument if [t] is not a table. *)
177
+
178
+
val to_table_opt : t -> (string * t) list option
179
+
(** [to_table_opt t] returns [Some pairs] if [t] is [Table pairs], [None] otherwise. *)
180
+
181
+
val to_datetime : t -> string
182
+
(** [to_datetime t] returns the datetime string for any datetime type.
183
+
@raise Invalid_argument if [t] is not a datetime variant. *)
184
+
185
+
val to_datetime_opt : t -> string option
186
+
(** [to_datetime_opt t] returns [Some s] if [t] is any datetime variant. *)
187
+
188
+
(** {2 Type Predicates} *)
189
+
190
+
val is_string : t -> bool
191
+
(** [is_string t] is [true] iff [t] is a [String]. *)
192
+
193
+
val is_int : t -> bool
194
+
(** [is_int t] is [true] iff [t] is an [Int]. *)
195
+
196
+
val is_float : t -> bool
197
+
(** [is_float t] is [true] iff [t] is a [Float]. *)
198
+
199
+
val is_bool : t -> bool
200
+
(** [is_bool t] is [true] iff [t] is a [Bool]. *)
201
+
202
+
val is_array : t -> bool
203
+
(** [is_array t] is [true] iff [t] is an [Array]. *)
204
+
205
+
val is_table : t -> bool
206
+
(** [is_table t] is [true] iff [t] is a [Table]. *)
207
+
208
+
val is_datetime : t -> bool
209
+
(** [is_datetime t] is [true] iff [t] is any datetime variant. *)
210
+
211
+
(** {1:navigate Table Navigation}
212
+
213
+
Functions for navigating and querying {{:https://toml.io/en/v1.1.0#table}TOML tables}.
214
+
See also {{:https://toml.io/en/v1.1.0#keys}dotted keys} for path-based access. *)
215
+
216
+
val find : string -> t -> t
217
+
(** [find key t] returns the value associated with [key] in table [t].
218
+
@raise Invalid_argument if [t] is not a table.
219
+
@raise Not_found if [key] is not in the table. *)
220
+
221
+
val find_opt : string -> t -> t option
222
+
(** [find_opt key t] returns [Some v] if [key] maps to [v] in table [t],
223
+
or [None] if [key] is not bound or [t] is not a table. *)
224
+
225
+
val mem : string -> t -> bool
226
+
(** [mem key t] is [true] if [key] is bound in table [t], [false] otherwise.
227
+
Returns [false] if [t] is not a table. *)
228
+
229
+
val keys : t -> string list
230
+
(** [keys t] returns all keys in table [t].
231
+
@raise Invalid_argument if [t] is not a table. *)
232
+
233
+
val get : string list -> t -> t
234
+
(** [get path t] navigates through nested tables following [path].
235
+
For example, [get ["server"; "port"] t] returns [t.server.port].
236
+
@raise Invalid_argument if any intermediate value is not a table.
237
+
@raise Not_found if any key in [path] is not found. *)
238
+
239
+
val get_opt : string list -> t -> t option
240
+
(** [get_opt path t] is like [get] but returns [None] on any error. *)
241
+
242
+
val ( .%{} ) : t -> string list -> t
243
+
(** [t.%{path}] is [get path t].
244
+
245
+
Example: [config.%{["database"; "port"]}]
246
+
247
+
@raise Invalid_argument if any intermediate value is not a table.
248
+
@raise Not_found if any key in the path is not found. *)
249
+
250
+
val ( .%{}<- ) : t -> string list -> t -> t
251
+
(** [t.%{path} <- v] returns a new table with value [v] at [path].
252
+
Creates intermediate tables as needed.
253
+
254
+
Example: [config.%{["server"; "host"]} <- string "localhost"]
255
+
256
+
@raise Invalid_argument if [t] is not a table or if an intermediate
257
+
value exists but is not a table. *)
258
+
259
+
(** {1:ptime Ptime Conversions}
260
+
261
+
Convert between {{:https://toml.io/en/v1.1.0#offset-date-time}TOML datetime}
262
+
values and {{:https://erratique.ch/software/ptime}Ptime} timestamps. Offset
263
+
datetimes can be converted to/from [Ptime.t] since they represent specific
264
+
instants on the UTC timeline. Local datetime types cannot be converted to
265
+
[Ptime.t] without assuming a timezone. *)
266
+
267
+
val datetime_of_ptime : ?tz_offset_s:int -> ?frac_s:int -> Ptime.t -> t
268
+
(** [datetime_of_ptime ?tz_offset_s ?frac_s ptime] creates an
269
+
{{:https://toml.io/en/v1.1.0#offset-date-time}offset datetime} from a ptime
270
+
timestamp.
271
+
@param tz_offset_s Timezone offset in seconds (default: 0 for UTC).
272
+
Use positive values for east of UTC (e.g., 3600 for +01:00),
273
+
negative for west (e.g., -18000 for -05:00).
274
+
@param frac_s Number of fractional second digits to include (default: 0).
275
+
Clipped to range \[0, 12\]. *)
276
+
277
+
val to_ptime : t -> Ptime.t
278
+
(** [to_ptime t] converts an {{:https://toml.io/en/v1.1.0#offset-date-time}offset
279
+
datetime} to a ptime timestamp.
280
+
@raise Invalid_argument if [t] is not a [Datetime] or if the datetime
281
+
string cannot be parsed. Local datetime types cannot be converted. *)
282
+
283
+
val to_ptime_opt : t -> Ptime.t option
284
+
(** [to_ptime_opt t] returns [Some ptime] if [t] is a [Datetime] that can be
285
+
parsed, [None] otherwise. *)
286
+
287
+
val to_ptime_tz : t -> (Ptime.t * Ptime.tz_offset_s option) option
288
+
(** [to_ptime_tz t] returns the ptime timestamp and timezone offset for an
289
+
offset datetime. The timezone is [Some 0] for [Z], [Some offset_s] for
290
+
explicit offsets like [+05:30], or [None] for the unknown local offset
291
+
convention ([-00:00]). Returns [None] if [t] is not a [Datetime]. *)
292
+
293
+
val date_of_ptime : ?tz_offset_s:int -> Ptime.t -> t
294
+
(** [date_of_ptime ?tz_offset_s ptime] creates a {{:https://toml.io/en/v1.1.0#local-date}local
295
+
date} from a ptime timestamp. The date is extracted in the given timezone
296
+
(default: UTC). *)
297
+
298
+
val to_date : t -> Ptime.date
299
+
(** [to_date t] converts a {{:https://toml.io/en/v1.1.0#local-date}local date}
300
+
to a ptime date tuple [(year, month, day)].
301
+
@raise Invalid_argument if [t] is not a [Date_local] or cannot be parsed. *)
302
+
303
+
val to_date_opt : t -> Ptime.date option
304
+
(** [to_date_opt t] returns [Some date] if [t] is a [Date_local], [None] otherwise. *)
305
+
306
+
(** {2:ptime_unified Unified Ptime Datetime}
307
+
308
+
Unifies all {{:https://toml.io/en/v1.1.0#offset-date-time}TOML datetime}
309
+
formats using {!Ptime} types, while preserving information about what was
310
+
originally specified in the TOML source.
311
+
312
+
For {{:https://toml.io/en/v1.1.0#local-date-time}local datetimes} without
313
+
timezone, pass [~tz_offset_s] to specify the timezone to use for
314
+
conversion. If not provided, UTC (0) is used as the default. *)
315
+
316
+
type ptime_datetime = [
317
+
| `Datetime of Ptime.t * Ptime.tz_offset_s option
318
+
(** {{:https://toml.io/en/v1.1.0#offset-date-time}Offset datetime} with
319
+
full timezone info. The offset is [Some 0] for [Z], [Some n] for
320
+
explicit offsets, or [None] for the unknown local offset convention
321
+
([-00:00]). *)
322
+
| `Datetime_local of Ptime.t
323
+
(** {{:https://toml.io/en/v1.1.0#local-date-time}Local datetime} converted
324
+
to [Ptime.t] using current system timezone. Preserves that the source
325
+
had no explicit timezone. *)
326
+
| `Date of Ptime.date
327
+
(** {{:https://toml.io/en/v1.1.0#local-date}Local date} as
328
+
[(year, month, day)]. *)
329
+
| `Time of int * int * int * int
330
+
(** {{:https://toml.io/en/v1.1.0#local-time}Local time} as
331
+
[(hour, minute, second, nanoseconds)]. Nanoseconds range from 0 to
332
+
999_999_999. *)
333
+
]
334
+
(** Datetime representation using {!Ptime}.
335
+
336
+
This variant indicates both the ptime value and the precision level
337
+
of datetime information present in the original TOML source. *)
338
+
339
+
val to_ptime_datetime : ?tz_offset_s:int -> t -> ptime_datetime option
340
+
(** [to_ptime_datetime ?tz_offset_s t] converts any TOML datetime value to
341
+
a unified ptime representation.
342
+
343
+
@param tz_offset_s Timezone offset for local datetimes. This is the offset
344
+
to assume when the TOML value is a local datetime without explicit
345
+
timezone. Defaults to 0 (UTC) if not provided.
346
+
@return [None] if [t] is not a datetime type, [Some pdt] otherwise.
347
+
348
+
Examples:
349
+
- [Datetime "1979-05-27T07:32:00Z"] →
350
+
[Some (`Datetime (ptime, Some 0))]
351
+
- [Datetime_local "1979-05-27T07:32:00"] →
352
+
[Some (`Datetime_local ptime)] (converted using current tz)
353
+
- [Date_local "1979-05-27"] →
354
+
[Some (`Date (1979, 5, 27))]
355
+
- [Time_local "07:32:00.123"] →
356
+
[Some (`Time (7, 32, 0, 123_000_000))] *)
357
+
358
+
val ptime_datetime_to_toml : ptime_datetime -> t
359
+
(** [ptime_datetime_to_toml pdt] converts a unified ptime datetime back to
360
+
a TOML value, preserving the appropriate datetime variant:
361
+
- [`Datetime (t, tz)] → [Datetime s] with timezone
362
+
- [`Datetime_local t] → [Datetime_local s]
363
+
- [`Date d] → [Date_local s]
364
+
- [`Time (h, m, s, ns)] → [Time_local s] *)
365
+
366
+
val pp_ptime_datetime : Format.formatter -> ptime_datetime -> unit
367
+
(** [pp_ptime_datetime fmt pdt] pretty-prints the unified datetime. *)
368
+
369
+
(** {1:pp Pretty Printing} *)
370
+
371
+
val pp : Format.formatter -> t -> unit
372
+
(** [pp fmt t] pretty-prints [t] in TOML inline format.
373
+
Tables are printed as inline tables. *)
374
+
375
+
val pp_value : Format.formatter -> t -> unit
376
+
(** [pp_value fmt t] pretty-prints a single TOML value.
377
+
Same as {!val:pp}. *)
378
+
379
+
val equal : t -> t -> bool
380
+
(** [equal a b] is structural equality on TOML values.
381
+
NaN floats are considered equal to each other. *)
382
+
383
+
val compare : t -> t -> int
384
+
(** [compare a b] is a total ordering on TOML values. *)
385
+
386
+
(** {1:errors Error Handling} *)
387
+
388
+
module Error = Toml_error
389
+
(** Structured error types for TOML parsing and encoding. *)
+216
vendor/opam/tomlt/lib/toml_error.ml
+216
vendor/opam/tomlt/lib/toml_error.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** TOML parsing and encoding error types *)
7
+
8
+
(** Location in the input *)
9
+
type location = {
10
+
line : int;
11
+
column : int;
12
+
file : string option;
13
+
}
14
+
15
+
let pp_location fmt loc =
16
+
match loc.file with
17
+
| Some f -> Format.fprintf fmt "%s:%d:%d" f loc.line loc.column
18
+
| None -> Format.fprintf fmt "line %d, column %d" loc.line loc.column
19
+
20
+
(** Lexer errors - low-level tokenization issues *)
21
+
type lexer_error =
22
+
| Invalid_utf8
23
+
| Incomplete_utf8
24
+
| Invalid_escape of char
25
+
| Incomplete_escape of string (** e.g., "\\x", "\\u", "\\U" *)
26
+
| Invalid_unicode_escape of string
27
+
| Invalid_unicode_codepoint of int
28
+
| Surrogate_codepoint of int
29
+
| Bare_carriage_return
30
+
| Control_character of int
31
+
| Unterminated_string
32
+
| Unterminated_comment
33
+
| Too_many_quotes
34
+
| Newline_in_string
35
+
| Unexpected_character of char
36
+
| Unexpected_eof
37
+
38
+
let pp_lexer_error fmt = function
39
+
| Invalid_utf8 -> Format.fprintf fmt "invalid UTF-8 sequence"
40
+
| Incomplete_utf8 -> Format.fprintf fmt "incomplete UTF-8 sequence"
41
+
| Invalid_escape c -> Format.fprintf fmt "invalid escape sequence: \\%c" c
42
+
| Incomplete_escape s -> Format.fprintf fmt "incomplete %s escape sequence" s
43
+
| Invalid_unicode_escape s -> Format.fprintf fmt "invalid %s escape sequence" s
44
+
| Invalid_unicode_codepoint cp -> Format.fprintf fmt "invalid Unicode codepoint: U+%X" cp
45
+
| Surrogate_codepoint cp -> Format.fprintf fmt "surrogate codepoint not allowed: U+%04X" cp
46
+
| Bare_carriage_return -> Format.fprintf fmt "bare carriage return not allowed"
47
+
| Control_character cp -> Format.fprintf fmt "control character U+%04X not allowed" cp
48
+
| Unterminated_string -> Format.fprintf fmt "unterminated string"
49
+
| Unterminated_comment -> Format.fprintf fmt "unterminated comment"
50
+
| Too_many_quotes -> Format.fprintf fmt "too many consecutive quotes"
51
+
| Newline_in_string -> Format.fprintf fmt "newline not allowed in basic string"
52
+
| Unexpected_character c -> Format.fprintf fmt "unexpected character '%c'" c
53
+
| Unexpected_eof -> Format.fprintf fmt "unexpected end of input"
54
+
55
+
(** Number parsing errors *)
56
+
type number_error =
57
+
| Leading_zero
58
+
| Leading_underscore
59
+
| Trailing_underscore
60
+
| Double_underscore
61
+
| Underscore_not_between_digits
62
+
| Underscore_after_exponent
63
+
| Missing_digit
64
+
| Missing_digit_after_sign
65
+
| Missing_digit_after_decimal
66
+
| Missing_digit_after_exponent
67
+
| Invalid_hex_digit
68
+
| Invalid_octal_digit
69
+
| Invalid_binary_digit
70
+
71
+
let pp_number_error fmt = function
72
+
| Leading_zero -> Format.fprintf fmt "leading zeros not allowed"
73
+
| Leading_underscore -> Format.fprintf fmt "leading underscore not allowed"
74
+
| Trailing_underscore -> Format.fprintf fmt "trailing underscore not allowed"
75
+
| Double_underscore -> Format.fprintf fmt "double underscore not allowed"
76
+
| Underscore_not_between_digits -> Format.fprintf fmt "underscore must be between digits"
77
+
| Underscore_after_exponent -> Format.fprintf fmt "underscore cannot follow exponent"
78
+
| Missing_digit -> Format.fprintf fmt "expected digit"
79
+
| Missing_digit_after_sign -> Format.fprintf fmt "expected digit after sign"
80
+
| Missing_digit_after_decimal -> Format.fprintf fmt "expected digit after decimal point"
81
+
| Missing_digit_after_exponent -> Format.fprintf fmt "expected digit after exponent"
82
+
| Invalid_hex_digit -> Format.fprintf fmt "invalid hexadecimal digit"
83
+
| Invalid_octal_digit -> Format.fprintf fmt "invalid octal digit"
84
+
| Invalid_binary_digit -> Format.fprintf fmt "invalid binary digit"
85
+
86
+
(** DateTime parsing errors *)
87
+
type datetime_error =
88
+
| Invalid_month of int
89
+
| Invalid_day of int * int (** day, month *)
90
+
| Invalid_hour of int
91
+
| Invalid_minute of int
92
+
| Invalid_second of int
93
+
| Invalid_timezone_offset_hour of int
94
+
| Invalid_timezone_offset_minute of int
95
+
| Invalid_format of string (** expected format description *)
96
+
97
+
let pp_datetime_error fmt = function
98
+
| Invalid_month m -> Format.fprintf fmt "invalid month: %d" m
99
+
| Invalid_day (d, m) -> Format.fprintf fmt "invalid day %d for month %d" d m
100
+
| Invalid_hour h -> Format.fprintf fmt "invalid hour: %d" h
101
+
| Invalid_minute m -> Format.fprintf fmt "invalid minute: %d" m
102
+
| Invalid_second s -> Format.fprintf fmt "invalid second: %d" s
103
+
| Invalid_timezone_offset_hour h -> Format.fprintf fmt "invalid timezone offset hour: %d" h
104
+
| Invalid_timezone_offset_minute m -> Format.fprintf fmt "invalid timezone offset minute: %d" m
105
+
| Invalid_format desc -> Format.fprintf fmt "invalid %s format" desc
106
+
107
+
(** Semantic/table structure errors *)
108
+
type semantic_error =
109
+
| Duplicate_key of string
110
+
| Table_already_defined of string
111
+
| Cannot_redefine_table_as_value of string
112
+
| Cannot_redefine_array_as_value of string
113
+
| Cannot_use_value_as_table of string
114
+
| Cannot_extend_inline_table of string
115
+
| Cannot_extend_closed_table of string
116
+
| Cannot_extend_array_of_tables of string
117
+
| Cannot_convert_table_to_array of string
118
+
| Cannot_convert_array_to_table of string
119
+
| Table_has_content of string
120
+
| Conflicting_keys
121
+
| Empty_key
122
+
| Multiline_key
123
+
124
+
let pp_semantic_error fmt = function
125
+
| Duplicate_key k -> Format.fprintf fmt "duplicate key: %s" k
126
+
| Table_already_defined k -> Format.fprintf fmt "table '%s' already defined" k
127
+
| Cannot_redefine_table_as_value k -> Format.fprintf fmt "cannot redefine table '%s' as a value" k
128
+
| Cannot_redefine_array_as_value k -> Format.fprintf fmt "cannot redefine array of tables '%s' as a value" k
129
+
| Cannot_use_value_as_table k -> Format.fprintf fmt "cannot use value '%s' as a table" k
130
+
| Cannot_extend_inline_table k -> Format.fprintf fmt "cannot extend inline table '%s'" k
131
+
| Cannot_extend_closed_table k -> Format.fprintf fmt "cannot extend table '%s' using dotted keys" k
132
+
| Cannot_extend_array_of_tables k -> Format.fprintf fmt "cannot extend array of tables '%s' using dotted keys" k
133
+
| Cannot_convert_table_to_array k -> Format.fprintf fmt "cannot define '%s' as array of tables; already defined as table" k
134
+
| Cannot_convert_array_to_table k -> Format.fprintf fmt "cannot define '%s' as table; already defined as array of tables" k
135
+
| Table_has_content k -> Format.fprintf fmt "cannot define '%s' as array of tables; already has content" k
136
+
| Conflicting_keys -> Format.fprintf fmt "conflicting keys in inline table"
137
+
| Empty_key -> Format.fprintf fmt "empty key"
138
+
| Multiline_key -> Format.fprintf fmt "multiline strings are not allowed as keys"
139
+
140
+
(** Syntax errors *)
141
+
type syntax_error =
142
+
| Expected of string
143
+
| Invalid_table_header
144
+
| Invalid_array_of_tables_header
145
+
| Unexpected_token of string
146
+
| Unexpected_bare_key of string
147
+
148
+
let pp_syntax_error fmt = function
149
+
| Expected s -> Format.fprintf fmt "expected %s" s
150
+
| Invalid_table_header -> Format.fprintf fmt "invalid table header syntax"
151
+
| Invalid_array_of_tables_header -> Format.fprintf fmt "invalid array of tables syntax"
152
+
| Unexpected_token s -> Format.fprintf fmt "unexpected token: %s" s
153
+
| Unexpected_bare_key k -> Format.fprintf fmt "unexpected bare key '%s' as value" k
154
+
155
+
(** Encoding errors *)
156
+
type encode_error =
157
+
| Cannot_encode_inline_table
158
+
| Not_a_table
159
+
160
+
let pp_encode_error fmt = function
161
+
| Cannot_encode_inline_table -> Format.fprintf fmt "cannot encode table inline without inline flag"
162
+
| Not_a_table -> Format.fprintf fmt "top-level TOML must be a table"
163
+
164
+
(** All error kinds *)
165
+
type kind =
166
+
| Lexer of lexer_error
167
+
| Number of number_error
168
+
| Datetime of datetime_error
169
+
| Semantic of semantic_error
170
+
| Syntax of syntax_error
171
+
| Encode of encode_error
172
+
173
+
let pp_kind fmt = function
174
+
| Lexer e -> pp_lexer_error fmt e
175
+
| Number e -> pp_number_error fmt e
176
+
| Datetime e -> pp_datetime_error fmt e
177
+
| Semantic e -> pp_semantic_error fmt e
178
+
| Syntax e -> pp_syntax_error fmt e
179
+
| Encode e -> pp_encode_error fmt e
180
+
181
+
(** Full error with location *)
182
+
type t = {
183
+
kind : kind;
184
+
location : location option;
185
+
}
186
+
187
+
let make ?location kind = { kind; location }
188
+
189
+
let pp fmt t =
190
+
match t.location with
191
+
| Some loc -> Format.fprintf fmt "%a: %a" pp_location loc pp_kind t.kind
192
+
| None -> pp_kind fmt t.kind
193
+
194
+
let to_string t =
195
+
Format.asprintf "%a" pp t
196
+
197
+
(** Exception for TOML errors *)
198
+
exception Error of t
199
+
200
+
let () = Printexc.register_printer (function
201
+
| Error e -> Some (Format.asprintf "Tomlt.Error: %a" pp e)
202
+
| _ -> None)
203
+
204
+
(** Raise a TOML error *)
205
+
let raise_error ?location kind =
206
+
raise (Error { kind; location })
207
+
208
+
let raise_lexer ?location e = raise_error ?location (Lexer e)
209
+
let raise_number ?location e = raise_error ?location (Number e)
210
+
let raise_datetime ?location e = raise_error ?location (Datetime e)
211
+
let raise_semantic ?location e = raise_error ?location (Semantic e)
212
+
let raise_syntax ?location e = raise_error ?location (Syntax e)
213
+
let raise_encode ?location e = raise_error ?location (Encode e)
214
+
215
+
(** Create location from line and column *)
216
+
let loc ?file ~line ~column () = { line; column; file }
+147
vendor/opam/tomlt/lib/toml_error.mli
+147
vendor/opam/tomlt/lib/toml_error.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** TOML parsing and encoding error types.
7
+
8
+
This module defines structured error types for TOML parsing and encoding,
9
+
with location tracking and pretty-printing support. *)
10
+
11
+
(** {1 Location} *)
12
+
13
+
(** Location in the input *)
14
+
type location = {
15
+
line : int;
16
+
column : int;
17
+
file : string option;
18
+
}
19
+
20
+
val pp_location : Format.formatter -> location -> unit
21
+
val loc : ?file:string -> line:int -> column:int -> unit -> location
22
+
23
+
(** {1 Error Categories} *)
24
+
25
+
(** Lexer errors - low-level tokenization issues *)
26
+
type lexer_error =
27
+
| Invalid_utf8
28
+
| Incomplete_utf8
29
+
| Invalid_escape of char
30
+
| Incomplete_escape of string
31
+
| Invalid_unicode_escape of string
32
+
| Invalid_unicode_codepoint of int
33
+
| Surrogate_codepoint of int
34
+
| Bare_carriage_return
35
+
| Control_character of int
36
+
| Unterminated_string
37
+
| Unterminated_comment
38
+
| Too_many_quotes
39
+
| Newline_in_string
40
+
| Unexpected_character of char
41
+
| Unexpected_eof
42
+
43
+
val pp_lexer_error : Format.formatter -> lexer_error -> unit
44
+
45
+
(** Number parsing errors *)
46
+
type number_error =
47
+
| Leading_zero
48
+
| Leading_underscore
49
+
| Trailing_underscore
50
+
| Double_underscore
51
+
| Underscore_not_between_digits
52
+
| Underscore_after_exponent
53
+
| Missing_digit
54
+
| Missing_digit_after_sign
55
+
| Missing_digit_after_decimal
56
+
| Missing_digit_after_exponent
57
+
| Invalid_hex_digit
58
+
| Invalid_octal_digit
59
+
| Invalid_binary_digit
60
+
61
+
val pp_number_error : Format.formatter -> number_error -> unit
62
+
63
+
(** DateTime parsing errors *)
64
+
type datetime_error =
65
+
| Invalid_month of int
66
+
| Invalid_day of int * int
67
+
| Invalid_hour of int
68
+
| Invalid_minute of int
69
+
| Invalid_second of int
70
+
| Invalid_timezone_offset_hour of int
71
+
| Invalid_timezone_offset_minute of int
72
+
| Invalid_format of string
73
+
74
+
val pp_datetime_error : Format.formatter -> datetime_error -> unit
75
+
76
+
(** Semantic/table structure errors *)
77
+
type semantic_error =
78
+
| Duplicate_key of string
79
+
| Table_already_defined of string
80
+
| Cannot_redefine_table_as_value of string
81
+
| Cannot_redefine_array_as_value of string
82
+
| Cannot_use_value_as_table of string
83
+
| Cannot_extend_inline_table of string
84
+
| Cannot_extend_closed_table of string
85
+
| Cannot_extend_array_of_tables of string
86
+
| Cannot_convert_table_to_array of string
87
+
| Cannot_convert_array_to_table of string
88
+
| Table_has_content of string
89
+
| Conflicting_keys
90
+
| Empty_key
91
+
| Multiline_key
92
+
93
+
val pp_semantic_error : Format.formatter -> semantic_error -> unit
94
+
95
+
(** Syntax errors *)
96
+
type syntax_error =
97
+
| Expected of string
98
+
| Invalid_table_header
99
+
| Invalid_array_of_tables_header
100
+
| Unexpected_token of string
101
+
| Unexpected_bare_key of string
102
+
103
+
val pp_syntax_error : Format.formatter -> syntax_error -> unit
104
+
105
+
(** Encoding errors *)
106
+
type encode_error =
107
+
| Cannot_encode_inline_table
108
+
| Not_a_table
109
+
110
+
val pp_encode_error : Format.formatter -> encode_error -> unit
111
+
112
+
(** {1 Combined Error Type} *)
113
+
114
+
(** All error kinds *)
115
+
type kind =
116
+
| Lexer of lexer_error
117
+
| Number of number_error
118
+
| Datetime of datetime_error
119
+
| Semantic of semantic_error
120
+
| Syntax of syntax_error
121
+
| Encode of encode_error
122
+
123
+
val pp_kind : Format.formatter -> kind -> unit
124
+
125
+
(** Full error with location *)
126
+
type t = {
127
+
kind : kind;
128
+
location : location option;
129
+
}
130
+
131
+
val make : ?location:location -> kind -> t
132
+
val pp : Format.formatter -> t -> unit
133
+
val to_string : t -> string
134
+
135
+
(** {1 Exception} *)
136
+
137
+
exception Error of t
138
+
139
+
(** {1 Raising Errors} *)
140
+
141
+
val raise_error : ?location:location -> kind -> 'a
142
+
val raise_lexer : ?location:location -> lexer_error -> 'a
143
+
val raise_number : ?location:location -> number_error -> 'a
144
+
val raise_datetime : ?location:location -> datetime_error -> 'a
145
+
val raise_semantic : ?location:location -> semantic_error -> 'a
146
+
val raise_syntax : ?location:location -> syntax_error -> 'a
147
+
val raise_encode : ?location:location -> encode_error -> 'a
+1325
vendor/opam/tomlt/lib/tomlt.ml
+1325
vendor/opam/tomlt/lib/tomlt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Declarative TOML codecs *)
7
+
8
+
(* ---- Preliminaries ---- *)
9
+
10
+
type 'a fmt = Format.formatter -> 'a -> unit
11
+
12
+
module Sort = struct
13
+
type t =
14
+
| String
15
+
| Int
16
+
| Float
17
+
| Bool
18
+
| Datetime
19
+
| Datetime_local
20
+
| Date
21
+
| Time
22
+
| Array
23
+
| Table
24
+
25
+
let to_string = function
26
+
| String -> "string"
27
+
| Int -> "integer"
28
+
| Float -> "float"
29
+
| Bool -> "boolean"
30
+
| Datetime -> "datetime"
31
+
| Datetime_local -> "datetime-local"
32
+
| Date -> "date-local"
33
+
| Time -> "time-local"
34
+
| Array -> "array"
35
+
| Table -> "table"
36
+
37
+
let pp fmt t = Format.pp_print_string fmt (to_string t)
38
+
39
+
let of_toml = function
40
+
| Toml.String _ -> String
41
+
| Toml.Int _ -> Int
42
+
| Toml.Float _ -> Float
43
+
| Toml.Bool _ -> Bool
44
+
| Toml.Datetime _ -> Datetime
45
+
| Toml.Datetime_local _ -> Datetime_local
46
+
| Toml.Date_local _ -> Date
47
+
| Toml.Time_local _ -> Time
48
+
| Toml.Array _ -> Array
49
+
| Toml.Table _ -> Table
50
+
51
+
let or_kind ~kind sort =
52
+
if kind = "" then to_string sort else kind
53
+
54
+
let kinded ~kind sort =
55
+
if kind = "" then to_string sort
56
+
else kind ^ " " ^ to_string sort
57
+
end
58
+
59
+
(* ---- Helpers ---- *)
60
+
61
+
(* Result syntax for cleaner monadic chaining *)
62
+
module Result_syntax = struct
63
+
let ( let* ) = Result.bind
64
+
let ( let+ ) r f = Result.map f r
65
+
end
66
+
67
+
(* Chain comparisons: return first non-zero, or final comparison *)
68
+
let ( <?> ) c lazy_c = if c <> 0 then c else Lazy.force lazy_c
69
+
70
+
(* Find first char matching predicate *)
71
+
let string_index_opt p s =
72
+
let len = String.length s in
73
+
let rec loop i =
74
+
if i >= len then None
75
+
else if p s.[i] then Some i
76
+
else loop (i + 1)
77
+
in
78
+
loop 0
79
+
80
+
(* Find separator (T, t, or space) for datetime parsing *)
81
+
let find_datetime_sep s =
82
+
string_index_opt (fun c -> c = 'T' || c = 't' || c = ' ') s
83
+
84
+
(* ---- Datetime structured types ---- *)
85
+
86
+
module Tz = struct
87
+
type t =
88
+
| UTC
89
+
| Offset of { hours : int; minutes : int }
90
+
91
+
let utc = UTC
92
+
let offset ~hours ~minutes = Offset { hours; minutes }
93
+
94
+
let equal a b = match a, b with
95
+
| UTC, UTC -> true
96
+
| Offset { hours = h1; minutes = m1 }, Offset { hours = h2; minutes = m2 } ->
97
+
h1 = h2 && m1 = m2
98
+
| _ -> false
99
+
100
+
let compare a b = match a, b with
101
+
| UTC, UTC -> 0
102
+
| UTC, Offset _ -> -1
103
+
| Offset _, UTC -> 1
104
+
| Offset { hours = h1; minutes = m1 }, Offset { hours = h2; minutes = m2 } ->
105
+
Int.compare h1 h2 <?> lazy (Int.compare m1 m2)
106
+
107
+
let to_string = function
108
+
| UTC -> "Z"
109
+
| Offset { hours; minutes } ->
110
+
let sign = if hours >= 0 then '+' else '-' in
111
+
Printf.sprintf "%c%02d:%02d" sign (abs hours) (abs minutes)
112
+
113
+
let pp fmt t = Format.pp_print_string fmt (to_string t)
114
+
115
+
let of_string s =
116
+
let len = String.length s in
117
+
if len = 0 then Error "empty timezone"
118
+
else if s = "Z" || s = "z" then Ok UTC
119
+
else if len >= 5 then
120
+
let sign = if s.[0] = '-' then -1 else 1 in
121
+
let start = if s.[0] = '+' || s.[0] = '-' then 1 else 0 in
122
+
try
123
+
let hours = int_of_string (String.sub s start 2) * sign in
124
+
let minutes = int_of_string (String.sub s (start + 3) 2) in
125
+
Ok (Offset { hours; minutes })
126
+
with _ -> Error ("invalid timezone: " ^ s)
127
+
else Error ("invalid timezone: " ^ s)
128
+
end
129
+
130
+
module Date = struct
131
+
type t = { year : int; month : int; day : int }
132
+
133
+
let make ~year ~month ~day = { year; month; day }
134
+
135
+
let equal a b = a.year = b.year && a.month = b.month && a.day = b.day
136
+
137
+
let compare a b =
138
+
Int.compare a.year b.year
139
+
<?> lazy (Int.compare a.month b.month)
140
+
<?> lazy (Int.compare a.day b.day)
141
+
142
+
let to_string d = Printf.sprintf "%04d-%02d-%02d" d.year d.month d.day
143
+
144
+
let pp fmt d = Format.pp_print_string fmt (to_string d)
145
+
146
+
let of_string s =
147
+
if String.length s < 10 then Error "date too short"
148
+
else
149
+
try
150
+
let year = int_of_string (String.sub s 0 4) in
151
+
let month = int_of_string (String.sub s 5 2) in
152
+
let day = int_of_string (String.sub s 8 2) in
153
+
Ok { year; month; day }
154
+
with _ -> Error ("invalid date: " ^ s)
155
+
end
156
+
157
+
module Time = struct
158
+
type t = {
159
+
hour : int;
160
+
minute : int;
161
+
second : int;
162
+
frac : float;
163
+
}
164
+
165
+
let make ~hour ~minute ~second ?(frac = 0.0) () =
166
+
{ hour; minute; second; frac }
167
+
168
+
let equal a b =
169
+
a.hour = b.hour && a.minute = b.minute &&
170
+
a.second = b.second && a.frac = b.frac
171
+
172
+
let compare a b =
173
+
Int.compare a.hour b.hour
174
+
<?> lazy (Int.compare a.minute b.minute)
175
+
<?> lazy (Int.compare a.second b.second)
176
+
<?> lazy (Float.compare a.frac b.frac)
177
+
178
+
(* Remove trailing zeros from a string, keeping at least one char *)
179
+
let rstrip_zeros s =
180
+
let rec find_end i =
181
+
if i <= 0 then 1
182
+
else if s.[i] <> '0' then i + 1
183
+
else find_end (i - 1)
184
+
in
185
+
String.sub s 0 (find_end (String.length s - 1))
186
+
187
+
let to_string t =
188
+
match t.frac with
189
+
| 0.0 -> Printf.sprintf "%02d:%02d:%02d" t.hour t.minute t.second
190
+
| frac ->
191
+
(* Format fractional seconds: "0.123456789" -> "123456789" -> trim zeros *)
192
+
let frac_str = Printf.sprintf "%.9f" frac in
193
+
let frac_digits = String.sub frac_str 2 (String.length frac_str - 2) in
194
+
Printf.sprintf "%02d:%02d:%02d.%s" t.hour t.minute t.second (rstrip_zeros frac_digits)
195
+
196
+
let pp fmt t = Format.pp_print_string fmt (to_string t)
197
+
198
+
let of_string s =
199
+
if String.length s < 8 then Error "time too short"
200
+
else
201
+
try
202
+
let hour = int_of_string (String.sub s 0 2) in
203
+
let minute = int_of_string (String.sub s 3 2) in
204
+
let second = int_of_string (String.sub s 6 2) in
205
+
let frac =
206
+
if String.length s > 8 && s.[8] = '.' then
207
+
float_of_string ("0" ^ String.sub s 8 (String.length s - 8))
208
+
else 0.0
209
+
in
210
+
Ok { hour; minute; second; frac }
211
+
with _ -> Error ("invalid time: " ^ s)
212
+
end
213
+
214
+
module Datetime = struct
215
+
type t = { date : Date.t; time : Time.t; tz : Tz.t }
216
+
217
+
let make ~date ~time ~tz = { date; time; tz }
218
+
219
+
let equal a b =
220
+
Date.equal a.date b.date && Time.equal a.time b.time && Tz.equal a.tz b.tz
221
+
222
+
let compare a b =
223
+
Date.compare a.date b.date
224
+
<?> lazy (Time.compare a.time b.time)
225
+
<?> lazy (Tz.compare a.tz b.tz)
226
+
227
+
let to_string dt =
228
+
Printf.sprintf "%sT%s%s"
229
+
(Date.to_string dt.date)
230
+
(Time.to_string dt.time)
231
+
(Tz.to_string dt.tz)
232
+
233
+
let pp fmt dt = Format.pp_print_string fmt (to_string dt)
234
+
235
+
let of_string s =
236
+
let open Result_syntax in
237
+
match find_datetime_sep s with
238
+
| None -> Error "missing date/time separator"
239
+
| Some idx ->
240
+
let date_str = String.sub s 0 idx in
241
+
let rest = String.sub s (idx + 1) (String.length s - idx - 1) in
242
+
(* Find timezone: Z, z, +, or - (but not - in first 2 chars of time) *)
243
+
let is_tz_start i c = c = 'Z' || c = 'z' || c = '+' || (c = '-' && i > 2) in
244
+
let tz_idx =
245
+
let len = String.length rest in
246
+
let rec find i =
247
+
if i >= len then len
248
+
else if is_tz_start i rest.[i] then i
249
+
else find (i + 1)
250
+
in
251
+
find 0
252
+
in
253
+
let time_str = String.sub rest 0 tz_idx in
254
+
let tz_str = String.sub rest tz_idx (String.length rest - tz_idx) in
255
+
let* date = Date.of_string date_str in
256
+
let* time = Time.of_string time_str in
257
+
let+ tz = Tz.of_string tz_str in
258
+
{ date; time; tz }
259
+
end
260
+
261
+
module Datetime_local = struct
262
+
type t = { date : Date.t; time : Time.t }
263
+
264
+
let make ~date ~time = { date; time }
265
+
266
+
let equal a b = Date.equal a.date b.date && Time.equal a.time b.time
267
+
268
+
let compare a b =
269
+
Date.compare a.date b.date <?> lazy (Time.compare a.time b.time)
270
+
271
+
let to_string dt =
272
+
Printf.sprintf "%sT%s" (Date.to_string dt.date) (Time.to_string dt.time)
273
+
274
+
let pp fmt dt = Format.pp_print_string fmt (to_string dt)
275
+
276
+
let of_string s =
277
+
let open Result_syntax in
278
+
match find_datetime_sep s with
279
+
| None -> Error "missing date/time separator"
280
+
| Some idx ->
281
+
let date_str = String.sub s 0 idx in
282
+
let time_str = String.sub s (idx + 1) (String.length s - idx - 1) in
283
+
let* date = Date.of_string date_str in
284
+
let+ time = Time.of_string time_str in
285
+
{ date; time }
286
+
end
287
+
288
+
(* ---- Codec error type ---- *)
289
+
290
+
type codec_error =
291
+
| Type_mismatch of { expected : string; got : string }
292
+
| Missing_member of string
293
+
| Unknown_member of string [@warning "-37"]
294
+
| Value_error of string
295
+
| Int_overflow of int64
296
+
| Parse_error of string [@warning "-37"]
297
+
298
+
let codec_error_to_string = function
299
+
| Type_mismatch { expected; got } ->
300
+
Printf.sprintf "type mismatch: expected %s, got %s" expected got
301
+
| Missing_member name ->
302
+
Printf.sprintf "missing required member: %s" name
303
+
| Unknown_member name ->
304
+
Printf.sprintf "unknown member: %s" name
305
+
| Value_error msg -> msg
306
+
| Int_overflow n ->
307
+
Printf.sprintf "integer overflow: %Ld" n
308
+
| Parse_error msg ->
309
+
Printf.sprintf "parse error: %s" msg
310
+
311
+
(* ---- Codec type ---- *)
312
+
313
+
type 'a t = {
314
+
kind : string;
315
+
doc : string;
316
+
dec : Toml.t -> ('a, codec_error) result;
317
+
enc : 'a -> Toml.t;
318
+
}
319
+
320
+
let kind c = c.kind
321
+
let doc c = c.doc
322
+
323
+
let with_doc ?kind:k ?doc:d c =
324
+
{ c with
325
+
kind = Option.value ~default:c.kind k;
326
+
doc = Option.value ~default:c.doc d }
327
+
328
+
(* ---- Type helpers ---- *)
329
+
330
+
let type_name = function
331
+
| Toml.String _ -> "string"
332
+
| Toml.Int _ -> "integer"
333
+
| Toml.Float _ -> "float"
334
+
| Toml.Bool _ -> "boolean"
335
+
| Toml.Datetime _ -> "datetime"
336
+
| Toml.Datetime_local _ -> "datetime-local"
337
+
| Toml.Date_local _ -> "date-local"
338
+
| Toml.Time_local _ -> "time-local"
339
+
| Toml.Array _ -> "array"
340
+
| Toml.Table _ -> "table"
341
+
342
+
(* Helpers for codec error construction *)
343
+
let type_error ~expected v =
344
+
Error (Type_mismatch { expected; got = type_name v })
345
+
346
+
let value_error msg = Error (Value_error msg)
347
+
let int_overflow n = Error (Int_overflow n)
348
+
let missing_member name = Error (Missing_member name)
349
+
350
+
(* ---- Base codecs ---- *)
351
+
352
+
let bool = {
353
+
kind = "boolean";
354
+
doc = "";
355
+
dec = (function
356
+
| Toml.Bool b -> Ok b
357
+
| v -> type_error ~expected:"boolean" v);
358
+
enc = (fun b -> Toml.Bool b);
359
+
}
360
+
361
+
let int = {
362
+
kind = "integer";
363
+
doc = "";
364
+
dec = (function
365
+
| Toml.Int i ->
366
+
if i >= Int64.of_int min_int && i <= Int64.of_int max_int then
367
+
Ok (Int64.to_int i)
368
+
else int_overflow i
369
+
| v -> type_error ~expected:"integer" v);
370
+
enc = (fun i -> Toml.Int (Int64.of_int i));
371
+
}
372
+
373
+
let int32 = {
374
+
kind = "integer";
375
+
doc = "";
376
+
dec = (function
377
+
| Toml.Int i ->
378
+
if i >= Int64.of_int32 Int32.min_int && i <= Int64.of_int32 Int32.max_int then
379
+
Ok (Int64.to_int32 i)
380
+
else int_overflow i
381
+
| v -> type_error ~expected:"integer" v);
382
+
enc = (fun i -> Toml.Int (Int64.of_int32 i));
383
+
}
384
+
385
+
let int64 = {
386
+
kind = "integer";
387
+
doc = "";
388
+
dec = (function
389
+
| Toml.Int i -> Ok i
390
+
| v -> type_error ~expected:"integer" v);
391
+
enc = (fun i -> Toml.Int i);
392
+
}
393
+
394
+
let float = {
395
+
kind = "float";
396
+
doc = "";
397
+
dec = (function
398
+
| Toml.Float f -> Ok f
399
+
| v -> type_error ~expected:"float" v);
400
+
enc = (fun f -> Toml.Float f);
401
+
}
402
+
403
+
let number = {
404
+
kind = "number";
405
+
doc = "";
406
+
dec = (function
407
+
| Toml.Float f -> Ok f
408
+
| Toml.Int i -> Ok (Int64.to_float i)
409
+
| v -> type_error ~expected:"number" v);
410
+
enc = (fun f -> Toml.Float f);
411
+
}
412
+
413
+
let string = {
414
+
kind = "string";
415
+
doc = "";
416
+
dec = (function
417
+
| Toml.String s -> Ok s
418
+
| v -> type_error ~expected:"string" v);
419
+
enc = (fun s -> Toml.String s);
420
+
}
421
+
422
+
let int_as_string = {
423
+
kind = "integer (as string)";
424
+
doc = "";
425
+
dec = (function
426
+
| Toml.String s ->
427
+
(match int_of_string_opt s with
428
+
| Some i -> Ok i
429
+
| None -> value_error ("cannot parse integer: " ^ s))
430
+
| v -> type_error ~expected:"string" v);
431
+
enc = (fun i -> Toml.String (Int.to_string i));
432
+
}
433
+
434
+
let int64_as_string = {
435
+
kind = "int64 (as string)";
436
+
doc = "";
437
+
dec = (function
438
+
| Toml.String s ->
439
+
(match Int64.of_string_opt s with
440
+
| Some i -> Ok i
441
+
| None -> value_error ("cannot parse int64: " ^ s))
442
+
| v -> type_error ~expected:"string" v);
443
+
enc = (fun i -> Toml.String (Int64.to_string i));
444
+
}
445
+
446
+
(* ---- Internal datetime codecs (for structured datetime types) ---- *)
447
+
(* These are used internally but not exposed in the mli - only ptime codecs are public *)
448
+
449
+
let datetime_ = {
450
+
kind = "datetime";
451
+
doc = "";
452
+
dec = (function
453
+
| Toml.Datetime s ->
454
+
Result.map_error (fun msg -> Value_error msg) (Datetime.of_string s)
455
+
| v -> type_error ~expected:"datetime" v);
456
+
enc = (fun dt -> Toml.Datetime (Datetime.to_string dt));
457
+
}
458
+
459
+
let datetime_local_ = {
460
+
kind = "datetime-local";
461
+
doc = "";
462
+
dec = (function
463
+
| Toml.Datetime_local s ->
464
+
Result.map_error (fun msg -> Value_error msg) (Datetime_local.of_string s)
465
+
| v -> type_error ~expected:"datetime-local" v);
466
+
enc = (fun dt -> Toml.Datetime_local (Datetime_local.to_string dt));
467
+
}
468
+
469
+
let date_local_ = {
470
+
kind = "date-local";
471
+
doc = "";
472
+
dec = (function
473
+
| Toml.Date_local s ->
474
+
Result.map_error (fun msg -> Value_error msg) (Date.of_string s)
475
+
| v -> type_error ~expected:"date-local" v);
476
+
enc = (fun d -> Toml.Date_local (Date.to_string d));
477
+
}
478
+
479
+
let time_local_ = {
480
+
kind = "time-local";
481
+
doc = "";
482
+
dec = (function
483
+
| Toml.Time_local s ->
484
+
Result.map_error (fun msg -> Value_error msg) (Time.of_string s)
485
+
| v -> type_error ~expected:"time-local" v);
486
+
enc = (fun t -> Toml.Time_local (Time.to_string t));
487
+
}
488
+
489
+
(* Silence unused warnings for internal codecs *)
490
+
let _ = datetime_
491
+
let _ = datetime_local_
492
+
let _ = date_local_
493
+
let _ = time_local_
494
+
495
+
(* ---- Ptime codecs ---- *)
496
+
497
+
(* Helper to get current timezone offset from explicit value or function *)
498
+
let get_tz_offset ?tz_offset_s ?get_tz () =
499
+
tz_offset_s
500
+
|> Option.fold ~none:(Option.bind get_tz (fun f -> f ())) ~some:Option.some
501
+
|> Option.value ~default:0 (* Default to UTC when no timezone source provided *)
502
+
503
+
(* Helper to get today's date in the given timezone *)
504
+
let today_date ?now tz_offset_s =
505
+
let t = Option.fold ~none:Ptime.epoch ~some:(fun f -> f ()) now in
506
+
Ptime.to_date ~tz_offset_s t
507
+
508
+
(* Helper to create a ptime from date at midnight *)
509
+
let ptime_of_date ?(tz_offset_s = 0) (year, month, day) =
510
+
match Ptime.of_date_time ((year, month, day), ((0, 0, 0), tz_offset_s)) with
511
+
| Some t -> t
512
+
| None ->
513
+
(* Fallback to epoch if date is invalid *)
514
+
Ptime.epoch
515
+
516
+
(* Helper to create a ptime from time on today's date *)
517
+
let ptime_of_time ?now ~tz_offset_s ~hour ~minute ~second ~ns () =
518
+
let frac = Float.of_int ns /. 1_000_000_000.0 in
519
+
let date = today_date ?now tz_offset_s in
520
+
let time = ((hour, minute, second), tz_offset_s) in
521
+
match Ptime.of_date_time (date, time) with
522
+
| Some t ->
523
+
(* Add fractional seconds *)
524
+
(match Ptime.Span.of_float_s frac with
525
+
| Some span -> Option.value ~default:t (Ptime.add_span t span)
526
+
| None -> t)
527
+
| None -> Ptime.epoch
528
+
529
+
(* Unified ptime codec - accepts any TOML datetime, fills in defaults *)
530
+
let ptime ?tz_offset_s ?get_tz ?now ?(frac_s = 0) () =
531
+
let tz () = get_tz_offset ?tz_offset_s ?get_tz () in
532
+
{
533
+
kind = "datetime (ptime)";
534
+
doc = "";
535
+
dec = (fun v ->
536
+
let tz_s = tz () in
537
+
match v with
538
+
| Toml.Datetime _ ->
539
+
(match Toml.to_ptime_opt v with
540
+
| Some t -> Ok t
541
+
| None -> value_error "cannot parse offset datetime")
542
+
| Toml.Datetime_local _ ->
543
+
(match Toml.to_ptime_datetime ~tz_offset_s:tz_s v with
544
+
| Some (`Datetime_local t) -> Ok t
545
+
| _ -> value_error "cannot parse local datetime")
546
+
| Toml.Date_local _ ->
547
+
(match Toml.to_date_opt v with
548
+
| Some date -> Ok (ptime_of_date ~tz_offset_s:tz_s date)
549
+
| None -> value_error "cannot parse local date")
550
+
| Toml.Time_local _ ->
551
+
(match Toml.to_ptime_datetime ~tz_offset_s:tz_s v with
552
+
| Some (`Time (h, m, s, ns)) ->
553
+
Ok (ptime_of_time ?now ~tz_offset_s:tz_s ~hour:h ~minute:m ~second:s ~ns ())
554
+
| _ -> value_error "cannot parse local time")
555
+
| v -> type_error ~expected:"datetime" v);
556
+
enc = (fun t -> Toml.datetime_of_ptime ~tz_offset_s:(tz ()) ~frac_s t);
557
+
}
558
+
559
+
(* Strict ptime codec - only accepts offset datetimes *)
560
+
let ptime_opt ?(tz_offset_s = 0) ?(frac_s = 0) () = {
561
+
kind = "datetime (ptime offset only)";
562
+
doc = "";
563
+
dec = (function
564
+
| Toml.Datetime _ as v ->
565
+
(match Toml.to_ptime_opt v with
566
+
| Some t -> Ok t
567
+
| None -> value_error "cannot parse offset datetime")
568
+
| Toml.Datetime_local _ ->
569
+
value_error "local datetime requires timezone; use ptime() instead"
570
+
| Toml.Date_local _ ->
571
+
value_error "local date requires timezone; use ptime() instead"
572
+
| Toml.Time_local _ ->
573
+
value_error "local time requires timezone; use ptime() instead"
574
+
| v -> type_error ~expected:"datetime" v);
575
+
enc = (fun t -> Toml.datetime_of_ptime ~tz_offset_s ~frac_s t);
576
+
}
577
+
578
+
(* Ptime span codec for local times (duration from midnight) *)
579
+
let ptime_span = {
580
+
kind = "time-local (ptime span)";
581
+
doc = "";
582
+
dec = (function
583
+
| Toml.Time_local _ as v ->
584
+
(match Toml.to_ptime_datetime v with
585
+
| Some (`Time (h, m, s, ns)) ->
586
+
let total_secs = (h * 3600) + (m * 60) + s in
587
+
let frac = Float.of_int ns /. 1_000_000_000.0 in
588
+
(match Ptime.Span.of_float_s (Float.of_int total_secs +. frac) with
589
+
| Some span -> Ok span
590
+
| None -> value_error "cannot create span from time")
591
+
| _ -> value_error "cannot parse local time")
592
+
| v -> type_error ~expected:"time-local" v);
593
+
enc = (fun span ->
594
+
let secs = Ptime.Span.to_float_s span in
595
+
(* Clamp to 0-24 hours *)
596
+
let secs = Float.max 0.0 (Float.min secs 86399.999999999) in
597
+
let total_secs = Float.to_int secs in
598
+
let frac = secs -. Float.of_int total_secs in
599
+
let h = total_secs / 3600 in
600
+
let m = (total_secs mod 3600) / 60 in
601
+
let s = total_secs mod 60 in
602
+
if frac > 0.0 then
603
+
Toml.Time_local (Printf.sprintf "%02d:%02d:%02d%s" h m s
604
+
(String.sub (Printf.sprintf "%.9f" frac) 1 10))
605
+
else
606
+
Toml.Time_local (Printf.sprintf "%02d:%02d:%02d" h m s));
607
+
}
608
+
609
+
(* Ptime date codec *)
610
+
let ptime_date = {
611
+
kind = "date-local (ptime)";
612
+
doc = "";
613
+
dec = (function
614
+
| Toml.Date_local _ as v ->
615
+
(match Toml.to_date_opt v with
616
+
| Some d -> Ok d
617
+
| None -> value_error "cannot parse local date")
618
+
| v -> type_error ~expected:"date-local" v);
619
+
enc = (fun (year, month, day) ->
620
+
Toml.Date_local (Printf.sprintf "%04d-%02d-%02d" year month day));
621
+
}
622
+
623
+
(* Full ptime datetime codec - preserves variant information *)
624
+
let ptime_full ?tz_offset_s ?get_tz () =
625
+
let tz_offset_s =
626
+
Option.fold ~none:(Option.bind get_tz (fun f -> f ())) ~some:Option.some tz_offset_s
627
+
in
628
+
{
629
+
kind = "datetime (unified ptime)";
630
+
doc = "";
631
+
dec = (fun v ->
632
+
match Toml.to_ptime_datetime ?tz_offset_s v with
633
+
| Some pdt -> Ok pdt
634
+
| None ->
635
+
match v with
636
+
| Toml.Datetime _ | Toml.Datetime_local _
637
+
| Toml.Date_local _ | Toml.Time_local _ ->
638
+
value_error "cannot parse datetime"
639
+
| _ -> type_error ~expected:"datetime" v);
640
+
enc = Toml.ptime_datetime_to_toml;
641
+
}
642
+
643
+
(* ---- Combinators ---- *)
644
+
645
+
let map ?kind:k ?doc:d ?dec ?enc c =
646
+
let kind = Option.value ~default:c.kind k in
647
+
let doc = Option.value ~default:c.doc d in
648
+
let dec_fn = match dec with
649
+
| Some f -> fun v -> Result.map f (c.dec v)
650
+
| None -> fun _ -> value_error "decode not supported"
651
+
in
652
+
let enc_fn = match enc with
653
+
| Some f -> fun v -> c.enc (f v)
654
+
| None -> fun _ -> failwith "encode not supported"
655
+
in
656
+
{ kind; doc; dec = dec_fn; enc = enc_fn }
657
+
658
+
let const ?kind ?doc v =
659
+
let kind = Option.value ~default:"constant" kind in
660
+
let doc = Option.value ~default:"" doc in
661
+
{ kind; doc; dec = (fun _ -> Ok v); enc = (fun _ -> Toml.Table []) }
662
+
663
+
let enum ?cmp ?kind ?doc assoc =
664
+
let cmp = Option.value ~default:Stdlib.compare cmp in
665
+
let kind = Option.value ~default:"enum" kind in
666
+
let doc = Option.value ~default:"" doc in
667
+
let rev_assoc = List.map (fun (s, v) -> (v, s)) assoc in
668
+
{
669
+
kind; doc;
670
+
dec = (function
671
+
| Toml.String s ->
672
+
(match List.assoc_opt s assoc with
673
+
| Some v -> Ok v
674
+
| None -> value_error ("unknown enum value: " ^ s))
675
+
| v -> type_error ~expected:"string" v);
676
+
enc = (fun v ->
677
+
match List.find_opt (fun (v', _) -> cmp v v' = 0) rev_assoc with
678
+
| Some (_, s) -> Toml.String s
679
+
| None -> failwith "enum value not in association list");
680
+
}
681
+
682
+
let option ?kind ?doc c =
683
+
let kind = Option.value ~default:("optional " ^ c.kind) kind in
684
+
let doc = Option.value ~default:c.doc doc in
685
+
{
686
+
kind; doc;
687
+
dec = (fun v -> Result.map Option.some (c.dec v));
688
+
enc = (function
689
+
| Some v -> c.enc v
690
+
| None -> Toml.Table []); (* Should not be called for None *)
691
+
}
692
+
693
+
let result ~ok ~error =
694
+
{
695
+
kind = ok.kind ^ " or " ^ error.kind;
696
+
doc = "";
697
+
dec = (fun v ->
698
+
match ok.dec v with
699
+
| Ok x -> Ok (Ok x)
700
+
| Error _ ->
701
+
match error.dec v with
702
+
| Ok x -> Ok (Error x)
703
+
| Error e -> Error e);
704
+
enc = (function
705
+
| Ok x -> ok.enc x
706
+
| Error x -> error.enc x);
707
+
}
708
+
709
+
let rec' lazy_c =
710
+
{
711
+
kind = "recursive";
712
+
doc = "";
713
+
dec = (fun v -> (Lazy.force lazy_c).dec v);
714
+
enc = (fun v -> (Lazy.force lazy_c).enc v);
715
+
}
716
+
717
+
let iter ?kind ?doc ?dec ?enc c =
718
+
let kind = Option.value ~default:c.kind kind in
719
+
let doc = Option.value ~default:c.doc doc in
720
+
{
721
+
kind;
722
+
doc;
723
+
dec = (fun v ->
724
+
match c.dec v with
725
+
| Ok x ->
726
+
(match dec with Some f -> f x | None -> ());
727
+
Ok x
728
+
| Error e -> Error e);
729
+
enc = (fun x ->
730
+
(match enc with Some f -> f x | None -> ());
731
+
c.enc x);
732
+
}
733
+
734
+
let recode ~dec:dec_codec f ~enc:enc_codec =
735
+
{
736
+
kind = dec_codec.kind;
737
+
doc = dec_codec.doc;
738
+
dec = (fun v ->
739
+
match dec_codec.dec v with
740
+
| Ok x -> Ok (f x)
741
+
| Error e -> Error e);
742
+
enc = enc_codec.enc;
743
+
}
744
+
745
+
(* ---- Query combinators ---- *)
746
+
747
+
let nth ?absent n elt_codec =
748
+
{
749
+
kind = elt_codec.kind;
750
+
doc = "";
751
+
dec = (function
752
+
| Toml.Array arr ->
753
+
if n >= 0 && n < List.length arr then
754
+
elt_codec.dec (List.nth arr n)
755
+
else
756
+
(match absent with
757
+
| Some v -> Ok v
758
+
| None -> value_error (Printf.sprintf "array index %d out of bounds" n))
759
+
| v -> type_error ~expected:"array" v);
760
+
enc = (fun x -> Toml.Array [elt_codec.enc x]);
761
+
}
762
+
763
+
let mem ?absent name value_codec =
764
+
{
765
+
kind = value_codec.kind;
766
+
doc = "";
767
+
dec = (function
768
+
| Toml.Table pairs ->
769
+
(match List.assoc_opt name pairs with
770
+
| Some v -> value_codec.dec v
771
+
| None ->
772
+
match absent with
773
+
| Some v -> Ok v
774
+
| None -> value_error (Printf.sprintf "missing member %S" name))
775
+
| v -> type_error ~expected:"table" v);
776
+
enc = (fun x -> Toml.Table [(name, value_codec.enc x)]);
777
+
}
778
+
779
+
let fold_array elt_codec f init =
780
+
{
781
+
kind = "array";
782
+
doc = "";
783
+
dec = (function
784
+
| Toml.Array arr ->
785
+
let rec loop acc i = function
786
+
| [] -> Ok acc
787
+
| x :: xs ->
788
+
match elt_codec.dec x with
789
+
| Ok v -> loop (f i v acc) (i + 1) xs
790
+
| Error e -> Error e
791
+
in
792
+
loop init 0 arr
793
+
| v -> type_error ~expected:"array" v);
794
+
enc = (fun _ -> Toml.Array []); (* Encoding not supported for folds *)
795
+
}
796
+
797
+
let fold_table value_codec f init =
798
+
{
799
+
kind = "table";
800
+
doc = "";
801
+
dec = (function
802
+
| Toml.Table pairs ->
803
+
let rec loop acc = function
804
+
| [] -> Ok acc
805
+
| (k, v) :: rest ->
806
+
match value_codec.dec v with
807
+
| Ok x -> loop (f k x acc) rest
808
+
| Error e -> Error e
809
+
in
810
+
loop init pairs
811
+
| v -> type_error ~expected:"table" v);
812
+
enc = (fun _ -> Toml.Table []); (* Encoding not supported for folds *)
813
+
}
814
+
815
+
(* ---- Ignoring and placeholders ---- *)
816
+
817
+
let ignore = {
818
+
kind = "ignored";
819
+
doc = "";
820
+
dec = (fun _ -> Ok ());
821
+
enc = (fun () -> failwith "cannot encode ignored value");
822
+
}
823
+
824
+
let zero = {
825
+
kind = "zero";
826
+
doc = "";
827
+
dec = (fun _ -> Ok ());
828
+
enc = (fun () -> Toml.Table []);
829
+
}
830
+
831
+
let todo ?kind ?doc ?dec_stub () =
832
+
let kind = Option.value ~default:"todo" kind in
833
+
let doc = Option.value ~default:"" doc in
834
+
{
835
+
kind;
836
+
doc;
837
+
dec = (fun _ ->
838
+
match dec_stub with
839
+
| Some v -> Ok v
840
+
| None -> value_error "TODO: codec not implemented");
841
+
enc = (fun _ -> failwith "TODO: codec not implemented");
842
+
}
843
+
844
+
(* ---- Array codecs ---- *)
845
+
846
+
module Array = struct
847
+
type 'a codec = 'a t
848
+
849
+
type ('array, 'elt) enc = {
850
+
fold : 'acc. ('acc -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc
851
+
}
852
+
853
+
type ('array, 'elt, 'builder) map = {
854
+
kind : string;
855
+
doc : string;
856
+
elt : 'elt codec;
857
+
dec_empty : unit -> 'builder;
858
+
dec_add : 'elt -> 'builder -> 'builder;
859
+
dec_finish : 'builder -> 'array;
860
+
enc : ('array, 'elt) enc;
861
+
}
862
+
863
+
let map ?kind ?doc
864
+
?(dec_empty = fun () -> failwith "decode not supported")
865
+
?(dec_add = fun _ _ -> failwith "decode not supported")
866
+
?(dec_finish = fun _ -> failwith "decode not supported")
867
+
?(enc = { fold = fun _ _ _ -> failwith "encode not supported" })
868
+
(elt : 'elt codec) : ('array, 'elt, 'builder) map =
869
+
let kind = Option.value ~default:("array of " ^ elt.kind) kind in
870
+
let doc = Option.value ~default:"" doc in
871
+
{ kind; doc; elt; dec_empty; dec_add; dec_finish; enc }
872
+
873
+
let list ?kind ?doc (elt : 'a codec) : ('a list, 'a, 'a list) map =
874
+
let kind = Option.value ~default:("list of " ^ elt.kind) kind in
875
+
let doc = Option.value ~default:"" doc in
876
+
{
877
+
kind; doc; elt;
878
+
dec_empty = (fun () -> []);
879
+
dec_add = (fun x xs -> x :: xs);
880
+
dec_finish = List.rev;
881
+
enc = { fold = (fun f acc xs -> List.fold_left f acc xs) };
882
+
}
883
+
884
+
let array ?kind ?doc (elt : 'a codec) : ('a array, 'a, 'a list) map =
885
+
let kind = Option.value ~default:("array of " ^ elt.kind) kind in
886
+
let doc = Option.value ~default:"" doc in
887
+
{
888
+
kind; doc; elt;
889
+
dec_empty = (fun () -> []);
890
+
dec_add = (fun x xs -> x :: xs);
891
+
dec_finish = (fun xs -> Stdlib.Array.of_list (List.rev xs));
892
+
enc = { fold = (fun f acc arr -> Stdlib.Array.fold_left f acc arr) };
893
+
}
894
+
895
+
let finish m =
896
+
{
897
+
kind = m.kind;
898
+
doc = m.doc;
899
+
dec = (function
900
+
| Toml.Array items ->
901
+
let rec decode_items builder = function
902
+
| [] -> Ok (m.dec_finish builder)
903
+
| item :: rest ->
904
+
match m.elt.dec item with
905
+
| Ok v -> decode_items (m.dec_add v builder) rest
906
+
| Error e -> Error e
907
+
in
908
+
decode_items (m.dec_empty ()) items
909
+
| v -> type_error ~expected:"array" v);
910
+
enc = (fun arr ->
911
+
let items = m.enc.fold (fun acc elt -> m.elt.enc elt :: acc) [] arr in
912
+
Toml.Array (List.rev items));
913
+
}
914
+
end
915
+
916
+
let list ?kind ?doc c = Array.(finish (list ?kind ?doc c))
917
+
let array ?kind ?doc c = Array.(finish (array ?kind ?doc c))
918
+
919
+
(* ---- Table codecs ---- *)
920
+
921
+
module Table = struct
922
+
type 'a codec = 'a t
923
+
924
+
(* Unknown member handling *)
925
+
type unknown_handling =
926
+
| Skip
927
+
| Error_on_unknown
928
+
| Keep of (string -> Toml.t -> unit) (* Callback to collect *)
929
+
930
+
(* Member specification - existential type for storing typed member info *)
931
+
type 'o mem_encoder = {
932
+
mem_enc : 'o -> Toml.t;
933
+
mem_should_omit : 'o -> bool;
934
+
}
935
+
936
+
type ('o, 'a) mem_spec = {
937
+
name : string;
938
+
mem_doc : string;
939
+
mem_codec : 'a codec;
940
+
dec_absent : 'a option;
941
+
enc_typed : 'o mem_encoder option;
942
+
}
943
+
944
+
(* Helper to create enc_typed from encoder and optional omit function *)
945
+
let make_enc_typed (codec : 'a codec) enc enc_omit =
946
+
match enc with
947
+
| None -> None
948
+
| Some f ->
949
+
let omit = Option.value ~default:(fun _ -> false) enc_omit in
950
+
Some {
951
+
mem_enc = (fun o -> codec.enc (f o));
952
+
mem_should_omit = (fun o -> omit (f o));
953
+
}
954
+
955
+
module Mem = struct
956
+
type 'a codec = 'a t
957
+
958
+
type ('o, 'a) t = ('o, 'a) mem_spec
959
+
960
+
let v ?doc ?(dec_absent : 'a option) ?enc ?enc_omit name (codec : 'a codec) =
961
+
{ name;
962
+
mem_doc = Option.value ~default:"" doc;
963
+
mem_codec = codec;
964
+
dec_absent;
965
+
enc_typed = make_enc_typed codec enc enc_omit }
966
+
967
+
let opt ?doc ?enc name (codec : 'a codec) =
968
+
let opt_codec = option codec in
969
+
{ name;
970
+
mem_doc = Option.value ~default:"" doc;
971
+
mem_codec = opt_codec;
972
+
dec_absent = Some None;
973
+
enc_typed = make_enc_typed opt_codec enc (Some Option.is_none) }
974
+
end
975
+
976
+
(* Map state for building table codecs *)
977
+
type ('o, 'dec) map = {
978
+
map_kind : string;
979
+
map_doc : string;
980
+
members : ('o, Toml.t) mem_spec list; (* Stored in reverse order *)
981
+
dec : Toml.t list -> ('dec, codec_error) result;
982
+
unknown : unknown_handling;
983
+
keep_unknown_enc : ('o -> (string * Toml.t) list) option;
984
+
}
985
+
986
+
let obj ?kind ?doc dec =
987
+
let kind = Option.value ~default:"table" kind in
988
+
let doc = Option.value ~default:"" doc in
989
+
{
990
+
map_kind = kind;
991
+
map_doc = doc;
992
+
members = [];
993
+
dec = (fun _ -> Ok dec);
994
+
unknown = Skip;
995
+
keep_unknown_enc = None;
996
+
}
997
+
998
+
let obj' ?kind ?doc dec_fn =
999
+
let kind = Option.value ~default:"table" kind in
1000
+
let doc = Option.value ~default:"" doc in
1001
+
{
1002
+
map_kind = kind;
1003
+
map_doc = doc;
1004
+
members = [];
1005
+
dec = (fun _ -> Ok (dec_fn ()));
1006
+
unknown = Skip;
1007
+
keep_unknown_enc = None;
1008
+
}
1009
+
1010
+
(* Marker to indicate a missing member with a default *)
1011
+
let missing_marker_str = "__TOMLT_MISSING_WITH_DEFAULT__"
1012
+
let missing_marker = Toml.String missing_marker_str
1013
+
1014
+
let is_missing_marker = function
1015
+
| Toml.String s -> String.equal s missing_marker_str
1016
+
| _ -> false
1017
+
1018
+
let mem ?doc ?dec_absent ?enc ?enc_omit name (c : 'a codec) m =
1019
+
(* Create a member spec that stores raw TOML for later processing *)
1020
+
let raw_spec = {
1021
+
name;
1022
+
mem_doc = Option.value ~default:"" doc;
1023
+
mem_codec = { kind = c.kind; doc = c.doc;
1024
+
dec = (fun v -> Ok v); enc = (fun v -> v) };
1025
+
(* We use the marker value when member is missing but has a default *)
1026
+
dec_absent = Option.map (fun _ -> missing_marker) dec_absent;
1027
+
enc_typed = make_enc_typed c enc enc_omit;
1028
+
} in
1029
+
{
1030
+
m with
1031
+
members = raw_spec :: m.members;
1032
+
dec = (function
1033
+
| [] -> value_error "internal: not enough values"
1034
+
| v :: rest ->
1035
+
Result.bind (m.dec rest) @@ fun f ->
1036
+
(* Check if this is the missing marker - use default directly *)
1037
+
if is_missing_marker v then
1038
+
match dec_absent with
1039
+
| Some default -> Ok (f default)
1040
+
| None -> value_error "internal: missing marker without default"
1041
+
else
1042
+
Result.map f (c.dec v));
1043
+
}
1044
+
1045
+
let opt_mem ?doc ?enc name (c : 'a codec) m =
1046
+
(* dec_absent parameter is ('a option) option.
1047
+
Some None means "the default decoded value is None : 'a option"
1048
+
None would mean "no default, member is required" *)
1049
+
let default : 'a option = None in
1050
+
mem ?doc ?enc ~dec_absent:default ~enc_omit:Option.is_none name (option c) m
1051
+
1052
+
(* Unknown member handling *)
1053
+
module Mems = struct
1054
+
type 'a codec = 'a t
1055
+
1056
+
type ('mems, 'a) enc = {
1057
+
fold : 'acc. ('acc -> string -> 'a -> 'acc) -> 'acc -> 'mems -> 'acc
1058
+
}
1059
+
1060
+
type ('mems, 'a, 'builder) map = {
1061
+
mems_kind : string;
1062
+
mems_doc : string;
1063
+
elt : 'a codec;
1064
+
dec_empty : unit -> 'builder;
1065
+
dec_add : string -> 'a -> 'builder -> 'builder;
1066
+
dec_finish : 'builder -> 'mems;
1067
+
enc : ('mems, 'a) enc;
1068
+
}
1069
+
1070
+
let map ?kind ?doc
1071
+
?(dec_empty = fun () -> failwith "decode not supported")
1072
+
?(dec_add = fun _ _ _ -> failwith "decode not supported")
1073
+
?(dec_finish = fun _ -> failwith "decode not supported")
1074
+
?(enc = { fold = fun _ _ _ -> failwith "encode not supported" })
1075
+
elt =
1076
+
let kind = Option.value ~default:("members of " ^ elt.kind) kind in
1077
+
let doc = Option.value ~default:"" doc in
1078
+
{ mems_kind = kind; mems_doc = doc; elt; dec_empty; dec_add; dec_finish; enc }
1079
+
1080
+
module StringMap = Map.Make(String)
1081
+
1082
+
let string_map ?kind ?doc elt =
1083
+
let kind = Option.value ~default:("string map of " ^ elt.kind) kind in
1084
+
let doc = Option.value ~default:"" doc in
1085
+
{
1086
+
mems_kind = kind; mems_doc = doc; elt;
1087
+
dec_empty = (fun () -> []);
1088
+
dec_add = (fun k v acc -> (k, v) :: acc);
1089
+
dec_finish = (fun pairs ->
1090
+
List.fold_left (fun m (k, v) -> StringMap.add k v m) StringMap.empty pairs);
1091
+
enc = { fold = (fun f acc m -> StringMap.fold (fun k v acc -> f acc k v) m acc) };
1092
+
}
1093
+
1094
+
let assoc ?kind ?doc elt =
1095
+
let kind = Option.value ~default:("assoc of " ^ elt.kind) kind in
1096
+
let doc = Option.value ~default:"" doc in
1097
+
{
1098
+
mems_kind = kind; mems_doc = doc; elt;
1099
+
dec_empty = (fun () -> []);
1100
+
dec_add = (fun k v acc -> (k, v) :: acc);
1101
+
dec_finish = List.rev;
1102
+
enc = { fold = (fun f acc pairs -> List.fold_left (fun acc (k, v) -> f acc k v) acc pairs) };
1103
+
}
1104
+
end
1105
+
1106
+
let skip_unknown m = { m with unknown = Skip }
1107
+
let error_unknown m = { m with unknown = Error_on_unknown }
1108
+
1109
+
let keep_unknown ?enc mems m =
1110
+
(* Add a pseudo-member that collects unknown members *)
1111
+
let unknown_vals = ref [] in
1112
+
let collector name v =
1113
+
match mems.Mems.elt.dec v with
1114
+
| Ok decoded -> unknown_vals := (name, decoded) :: !unknown_vals
1115
+
| Error _ -> () (* Skip values that don't decode *)
1116
+
in
1117
+
(* Create a raw spec for unknown members *)
1118
+
let raw_spec = {
1119
+
name = ""; (* Special marker for unknown members *)
1120
+
mem_doc = "";
1121
+
mem_codec = { kind = "unknown"; doc = "";
1122
+
dec = (fun _ -> Ok (Toml.Table []));
1123
+
enc = (fun _ -> Toml.Table []) };
1124
+
dec_absent = Some (Toml.Table []);
1125
+
enc_typed = None;
1126
+
} in
1127
+
{
1128
+
m with
1129
+
members = raw_spec :: m.members;
1130
+
unknown = Keep collector;
1131
+
keep_unknown_enc = Option.map (fun f o ->
1132
+
let mems_val = f o in
1133
+
mems.Mems.enc.fold (fun acc k v -> (k, mems.Mems.elt.enc v) :: acc) [] mems_val
1134
+
|> List.rev
1135
+
) enc;
1136
+
dec = (function
1137
+
| [] -> value_error "internal: not enough values"
1138
+
| _ :: rest ->
1139
+
Result.map (fun f ->
1140
+
let collected = mems.Mems.dec_finish (
1141
+
List.fold_left (fun acc (k, v) -> mems.Mems.dec_add k v acc)
1142
+
(mems.Mems.dec_empty ())
1143
+
(List.rev !unknown_vals)
1144
+
) in
1145
+
unknown_vals := [];
1146
+
f collected
1147
+
) (m.dec rest));
1148
+
}
1149
+
1150
+
(* Check for duplicates in a list *)
1151
+
let find_dup xs =
1152
+
let rec loop seen = function
1153
+
| [] -> None
1154
+
| x :: rest -> if List.mem x seen then Some x else loop (x :: seen) rest
1155
+
in
1156
+
loop [] xs
1157
+
1158
+
let finish_common ~inline m =
1159
+
let _ = inline in (* For future inline table support *)
1160
+
(* members_ordered is for display (reversed to get declaration order) *)
1161
+
let members_ordered = List.rev m.members in
1162
+
let known_names =
1163
+
List.filter_map (fun spec -> if spec.name = "" then None else Some spec.name) members_ordered
1164
+
in
1165
+
(* Check for duplicate member names *)
1166
+
Option.iter (fun name -> invalid_arg ("duplicate member name: " ^ name)) (find_dup known_names);
1167
+
{
1168
+
kind = m.map_kind;
1169
+
doc = m.map_doc;
1170
+
dec = (function
1171
+
| Toml.Table pairs ->
1172
+
(* Build list of values in the order expected by the dec chain.
1173
+
m.members is in reverse declaration order, which matches
1174
+
how the dec chain was built (outer = last added). *)
1175
+
let vals = List.map (fun spec ->
1176
+
if spec.name = "" then
1177
+
(* Unknown members placeholder *)
1178
+
Toml.Table []
1179
+
else
1180
+
match List.assoc_opt spec.name pairs with
1181
+
| Some v -> v
1182
+
| None ->
1183
+
match spec.dec_absent with
1184
+
| Some default -> default
1185
+
| None ->
1186
+
(* Will cause error during decoding *)
1187
+
Toml.Table []
1188
+
) m.members in
1189
+
(* Check for unknown members *)
1190
+
(match m.unknown with
1191
+
| Skip -> ()
1192
+
| Error_on_unknown ->
1193
+
List.iter (fun (name, _) ->
1194
+
if not (List.mem name known_names) then
1195
+
raise (Toml.Error.Error (Toml.Error.make
1196
+
(Toml.Error.Semantic (Toml.Error.Duplicate_key name))))
1197
+
) pairs
1198
+
| Keep collector ->
1199
+
List.iter (fun (name, v) ->
1200
+
if not (List.mem name known_names) then
1201
+
collector name v
1202
+
) pairs);
1203
+
(* Check for missing required members *)
1204
+
let missing = List.filter_map (fun spec ->
1205
+
if spec.name = "" then None
1206
+
else if spec.dec_absent = None &&
1207
+
not (List.exists (fun (n, _) -> n = spec.name) pairs) then
1208
+
Some spec.name
1209
+
else None
1210
+
) members_ordered in
1211
+
(match missing with
1212
+
| name :: _ -> missing_member name
1213
+
| [] -> m.dec vals)
1214
+
| v -> type_error ~expected:"table" v);
1215
+
enc = (fun o ->
1216
+
let pairs = List.filter_map (fun spec ->
1217
+
if spec.name = "" then None (* Skip unknown member placeholder *)
1218
+
else
1219
+
match spec.enc_typed with
1220
+
| None -> None
1221
+
| Some enc_info ->
1222
+
(* Check should_omit on original object, not encoded value *)
1223
+
if enc_info.mem_should_omit o then None
1224
+
else Some (spec.name, enc_info.mem_enc o)
1225
+
) members_ordered in
1226
+
(* Add unknown members if keep_unknown was used *)
1227
+
let pairs = match m.keep_unknown_enc with
1228
+
| None -> pairs
1229
+
| Some get_unknown -> pairs @ get_unknown o
1230
+
in
1231
+
Toml.Table pairs);
1232
+
}
1233
+
1234
+
let finish m = finish_common ~inline:false m
1235
+
let inline m = finish_common ~inline:true m
1236
+
end
1237
+
1238
+
(* ---- Array of tables ---- *)
1239
+
1240
+
let array_of_tables ?kind ?doc c =
1241
+
let kind = Option.value ~default:("array of " ^ c.kind) kind in
1242
+
let doc = Option.value ~default:"" doc in
1243
+
{
1244
+
kind; doc;
1245
+
dec = (function
1246
+
| Toml.Array items ->
1247
+
let rec decode_items acc = function
1248
+
| [] -> Ok (List.rev acc)
1249
+
| item :: rest ->
1250
+
match c.dec item with
1251
+
| Ok v -> decode_items (v :: acc) rest
1252
+
| Error e -> Error e
1253
+
in
1254
+
decode_items [] items
1255
+
| v -> type_error ~expected:"array" v);
1256
+
enc = (fun xs -> Toml.Array (List.map c.enc xs));
1257
+
}
1258
+
1259
+
(* ---- Any / Generic value codecs ---- *)
1260
+
1261
+
let value = {
1262
+
kind = "value";
1263
+
doc = "";
1264
+
dec = (fun v -> Ok v);
1265
+
enc = (fun v -> v);
1266
+
}
1267
+
1268
+
let value_mems = {
1269
+
kind = "value members";
1270
+
doc = "";
1271
+
dec = (function
1272
+
| Toml.Table pairs -> Ok pairs
1273
+
| v -> type_error ~expected:"table" v);
1274
+
enc = (fun pairs -> Toml.Table pairs);
1275
+
}
1276
+
1277
+
let any ?kind ?doc ?dec_string ?dec_int ?dec_float ?dec_bool
1278
+
?dec_datetime ?dec_array ?dec_table ?enc () =
1279
+
let kind = Option.value ~default:"any" kind in
1280
+
let doc = Option.value ~default:"" doc in
1281
+
let type_error expected got =
1282
+
Error (Type_mismatch { expected; got = type_name got })
1283
+
in
1284
+
{
1285
+
kind; doc;
1286
+
dec = (fun v ->
1287
+
match v with
1288
+
| Toml.String _ ->
1289
+
(match dec_string with Some c -> c.dec v | None -> type_error "string" v)
1290
+
| Toml.Int _ ->
1291
+
(match dec_int with Some c -> c.dec v | None -> type_error "integer" v)
1292
+
| Toml.Float _ ->
1293
+
(match dec_float with Some c -> c.dec v | None -> type_error "float" v)
1294
+
| Toml.Bool _ ->
1295
+
(match dec_bool with Some c -> c.dec v | None -> type_error "boolean" v)
1296
+
| Toml.Datetime _ | Toml.Datetime_local _
1297
+
| Toml.Date_local _ | Toml.Time_local _ ->
1298
+
(match dec_datetime with Some c -> c.dec v | None -> type_error "datetime" v)
1299
+
| Toml.Array _ ->
1300
+
(match dec_array with Some c -> c.dec v | None -> type_error "array" v)
1301
+
| Toml.Table _ ->
1302
+
(match dec_table with Some c -> c.dec v | None -> type_error "table" v));
1303
+
enc = (fun v ->
1304
+
match enc with
1305
+
| Some selector -> (selector v).enc v
1306
+
| None -> failwith "any: enc not provided");
1307
+
}
1308
+
1309
+
(* ---- Encoding and decoding ---- *)
1310
+
1311
+
let to_tomlt_error e =
1312
+
Toml.Error.make (Toml.Error.Semantic (Toml.Error.Duplicate_key (codec_error_to_string e)))
1313
+
1314
+
let decode c v = Result.map_error to_tomlt_error (c.dec v)
1315
+
1316
+
let decode_exn c v =
1317
+
match c.dec v with
1318
+
| Ok x -> x
1319
+
| Error e -> raise (Toml.Error.Error (to_tomlt_error e))
1320
+
1321
+
let encode c v = c.enc v
1322
+
1323
+
(* Re-export the Toml module for accessing raw TOML values *)
1324
+
module Toml = Toml
1325
+
module Error = Toml.Error
+826
vendor/opam/tomlt/lib/tomlt.mli
+826
vendor/opam/tomlt/lib/tomlt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Declarative {{:https://toml.io/en/v1.1.0}TOML 1.1} codecs.
7
+
8
+
Tomlt provides a bidirectional codec system for TOML files, inspired by
9
+
{{:https://erratique.ch/software/jsont}Jsont}'s approach to JSON codecs.
10
+
11
+
{2 Quick Start}
12
+
13
+
Define a codec for your OCaml types:
14
+
{v
15
+
type config = { host : string; port : int; debug : bool }
16
+
17
+
let config_codec =
18
+
Tomlt.(Table.(
19
+
obj (fun host port debug -> { host; port; debug })
20
+
|> mem "host" string ~enc:(fun c -> c.host)
21
+
|> mem "port" int ~enc:(fun c -> c.port)
22
+
|> mem "debug" bool ~enc:(fun c -> c.debug) ~dec_absent:false
23
+
|> finish
24
+
))
25
+
v}
26
+
27
+
For I/O operations (parsing strings, reading files), use {!Tomlt_bytesrw}:
28
+
{v
29
+
let () =
30
+
match Tomlt_bytesrw.decode_string config_codec {|
31
+
host = "localhost"
32
+
port = 8080
33
+
|} with
34
+
| Ok config -> Printf.printf "Host: %s\n" config.host
35
+
| Error e -> prerr_endline (Toml.Error.to_string e)
36
+
v}
37
+
38
+
{2 Codec Pattern}
39
+
40
+
Each codec ['a t] defines:
41
+
- A decoder: [Toml.t -> ('a, error) result]
42
+
- An encoder: ['a -> Toml.t]
43
+
44
+
Codecs compose through combinators to build complex types from
45
+
simple primitives.
46
+
47
+
{2 Cookbook}
48
+
49
+
See the {{!page-cookbook}cookbook} for patterns and recipes:
50
+
51
+
- {{!page-cookbook.config_files}Parsing configuration files}
52
+
- {{!page-cookbook.optional_values}Optional and absent values}
53
+
- {{!page-cookbook.datetimes}Working with datetimes}
54
+
- {{!page-cookbook.arrays}Working with arrays}
55
+
- {{!page-cookbook.tables}Nested tables and objects}
56
+
- {{!page-cookbook.unknown_members}Unknown member handling}
57
+
- {{!page-cookbook.validation}Validation and constraints}
58
+
59
+
{2 Module Overview}
60
+
61
+
- {!section:datetime} - Structured datetime types (for advanced use)
62
+
- {!section:codec} - Core codec type and combinators
63
+
- {!section:base} - Primitive type codecs
64
+
- {!section:ptime_codecs} - Ptime-based datetime codecs
65
+
- {!section:combinators} - Codec transformers
66
+
- {!section:arrays} - Array codec builders
67
+
- {!section:tables} - Table/object codec builders
68
+
- {!section:codec_ops} - Encoding and decoding operations
69
+
70
+
{2 Related Libraries}
71
+
72
+
{ul
73
+
{- [Tomlt_bytesrw] - Byte-level I/O for string and channel operations}
74
+
{- [Tomlt_eio] - Eio integration with system timezone support}
75
+
{- [Toml] - Low-level TOML value type and error handling}} *)
76
+
77
+
(** {1:preliminaries Preliminaries} *)
78
+
79
+
type 'a fmt = Format.formatter -> 'a -> unit
80
+
(** The type for formatters of values of type ['a]. *)
81
+
82
+
(** Sorts of TOML values.
83
+
84
+
TOML values are classified into sorts (types). This module provides
85
+
utilities for working with these sorts programmatically. *)
86
+
module Sort : sig
87
+
type t =
88
+
| String (** Strings *)
89
+
| Int (** Integers *)
90
+
| Float (** Floating-point numbers *)
91
+
| Bool (** Booleans *)
92
+
| Datetime (** Offset datetimes *)
93
+
| Datetime_local (** Local datetimes *)
94
+
| Date (** Local dates *)
95
+
| Time (** Local times *)
96
+
| Array (** Arrays *)
97
+
| Table (** Tables (objects) *)
98
+
(** The type for sorts of TOML values. *)
99
+
100
+
val to_string : t -> string
101
+
(** [to_string sort] is a human-readable string for [sort]. *)
102
+
103
+
val pp : t fmt
104
+
(** [pp] formats sorts. *)
105
+
106
+
val of_toml : Toml.t -> t
107
+
(** [of_toml v] returns the sort of TOML value [v]. *)
108
+
109
+
val or_kind : kind:string -> t -> string
110
+
(** [or_kind ~kind sort] is [to_string sort] if [kind] is [""] and
111
+
[kind] otherwise. *)
112
+
113
+
val kinded : kind:string -> t -> string
114
+
(** [kinded ~kind sort] is [to_string sort] if [kind] is [""]
115
+
and [String.concat " " \[kind; to_string sort\]] otherwise. *)
116
+
end
117
+
118
+
(** {1:datetime Structured Datetime Types}
119
+
120
+
TOML 1.1 supports four datetime formats:
121
+
122
+
- {b {{:https://toml.io/en/v1.1.0#offset-date-time}Offset datetime}}:
123
+
[1979-05-27T07:32:00Z] or [1979-05-27T07:32:00-07:00]
124
+
- {b {{:https://toml.io/en/v1.1.0#local-date-time}Local datetime}}:
125
+
[1979-05-27T07:32:00] (no timezone)
126
+
- {b {{:https://toml.io/en/v1.1.0#local-date}Local date}}:
127
+
[1979-05-27]
128
+
- {b {{:https://toml.io/en/v1.1.0#local-time}Local time}}:
129
+
[07:32:00] or [07:32:00.999999]
130
+
131
+
These modules provide structured representations for parsing and
132
+
formatting. For most use cases, prefer the {!section:ptime_codecs}
133
+
which provide a unified Ptime-based interface. *)
134
+
135
+
(** Timezone offsets for {{:https://toml.io/en/v1.1.0#offset-date-time}TOML
136
+
offset datetimes}.
137
+
138
+
Per RFC 3339, timezones are expressed as [Z] (UTC) or as
139
+
[+HH:MM] / [-HH:MM] offsets from UTC. *)
140
+
module Tz : sig
141
+
(** Timezone offset representation. *)
142
+
type t =
143
+
| UTC (** UTC timezone, written as [Z] *)
144
+
| Offset of { hours : int; minutes : int } (** Fixed offset from UTC *)
145
+
146
+
val utc : t
147
+
(** [utc] is the UTC timezone. *)
148
+
149
+
val offset : hours:int -> minutes:int -> t
150
+
(** [offset ~hours ~minutes] creates a fixed UTC offset.
151
+
Hours may be negative for western timezones. *)
152
+
153
+
val equal : t -> t -> bool
154
+
(** [equal a b] is structural equality. *)
155
+
156
+
val compare : t -> t -> int
157
+
(** [compare a b] is a total ordering. *)
158
+
159
+
val to_string : t -> string
160
+
(** [to_string tz] formats as ["Z"] or ["+HH:MM"]/["-HH:MM"]. *)
161
+
162
+
val pp : Format.formatter -> t -> unit
163
+
(** [pp fmt tz] pretty-prints the timezone. *)
164
+
165
+
val of_string : string -> (t, string) result
166
+
(** [of_string s] parses ["Z"], ["+HH:MM"], or ["-HH:MM"]. *)
167
+
end
168
+
169
+
(** {{:https://toml.io/en/v1.1.0#local-date}Local dates} (no timezone information).
170
+
171
+
Represents a calendar date like [1979-05-27]. *)
172
+
module Date : sig
173
+
type t = { year : int; month : int; day : int }
174
+
(** A calendar date with year (4 digits), month (1-12), and day (1-31). *)
175
+
176
+
val make : year:int -> month:int -> day:int -> t
177
+
(** [make ~year ~month ~day] creates a date value. *)
178
+
179
+
val equal : t -> t -> bool
180
+
val compare : t -> t -> int
181
+
val to_string : t -> string
182
+
(** [to_string d] formats as ["YYYY-MM-DD"]. *)
183
+
184
+
val pp : Format.formatter -> t -> unit
185
+
val of_string : string -> (t, string) result
186
+
(** [of_string s] parses ["YYYY-MM-DD"] format. *)
187
+
end
188
+
189
+
(** {{:https://toml.io/en/v1.1.0#local-time}Local times} (no date or timezone).
190
+
191
+
Represents a time of day like [07:32:00] or [07:32:00.999999]. *)
192
+
module Time : sig
193
+
type t = {
194
+
hour : int; (** Hour (0-23) *)
195
+
minute : int; (** Minute (0-59) *)
196
+
second : int; (** Second (0-59, 60 for leap seconds) *)
197
+
frac : float; (** Fractional seconds in range \[0.0, 1.0) *)
198
+
}
199
+
200
+
val make : hour:int -> minute:int -> second:int -> ?frac:float -> unit -> t
201
+
(** [make ~hour ~minute ~second ?frac ()] creates a time value.
202
+
[frac] defaults to [0.0]. *)
203
+
204
+
val equal : t -> t -> bool
205
+
val compare : t -> t -> int
206
+
val to_string : t -> string
207
+
(** [to_string t] formats as ["HH:MM:SS"] or ["HH:MM:SS.fff"]. *)
208
+
209
+
val pp : Format.formatter -> t -> unit
210
+
val of_string : string -> (t, string) result
211
+
end
212
+
213
+
(** {{:https://toml.io/en/v1.1.0#offset-date-time}Offset datetimes}
214
+
(date + time + timezone).
215
+
216
+
The complete datetime format per RFC 3339, like
217
+
[1979-05-27T07:32:00Z] or [1979-05-27T07:32:00-07:00]. *)
218
+
module Datetime : sig
219
+
type t = { date : Date.t; time : Time.t; tz : Tz.t }
220
+
221
+
val make : date:Date.t -> time:Time.t -> tz:Tz.t -> t
222
+
val equal : t -> t -> bool
223
+
val compare : t -> t -> int
224
+
val to_string : t -> string
225
+
val pp : Format.formatter -> t -> unit
226
+
val of_string : string -> (t, string) result
227
+
end
228
+
229
+
(** {{:https://toml.io/en/v1.1.0#local-date-time}Local datetimes}
230
+
(date + time, no timezone).
231
+
232
+
Like [1979-05-27T07:32:00] - a datetime with no timezone
233
+
information, representing "wall clock" time. *)
234
+
module Datetime_local : sig
235
+
type t = { date : Date.t; time : Time.t }
236
+
237
+
val make : date:Date.t -> time:Time.t -> t
238
+
val equal : t -> t -> bool
239
+
val compare : t -> t -> int
240
+
val to_string : t -> string
241
+
val pp : Format.formatter -> t -> unit
242
+
val of_string : string -> (t, string) result
243
+
end
244
+
245
+
(** {1:codec Codec Types} *)
246
+
247
+
(** Errors that can occur during codec operations. *)
248
+
type codec_error =
249
+
| Type_mismatch of { expected : string; got : string }
250
+
(** TOML value was not the expected type *)
251
+
| Missing_member of string
252
+
(** Required table member was not present *)
253
+
| Unknown_member of string
254
+
(** Unknown member found (when using [error_unknown]) *)
255
+
| Value_error of string
256
+
(** Value failed validation or parsing *)
257
+
| Int_overflow of int64
258
+
(** Integer value exceeds OCaml [int] range *)
259
+
| Parse_error of string
260
+
(** Parsing failed *)
261
+
262
+
val codec_error_to_string : codec_error -> string
263
+
(** [codec_error_to_string e] returns a human-readable error message. *)
264
+
265
+
(** The type of TOML codecs.
266
+
267
+
A value of type ['a t] can decode TOML values to type ['a]
268
+
and encode values of type ['a] to TOML. *)
269
+
type 'a t
270
+
271
+
val kind : 'a t -> string
272
+
(** [kind c] returns the kind description of codec [c]. *)
273
+
274
+
val doc : 'a t -> string
275
+
(** [doc c] returns the documentation string of codec [c]. *)
276
+
277
+
val with_doc : ?kind:string -> ?doc:string -> 'a t -> 'a t
278
+
(** [with_doc ?kind ?doc c] is [c] with its {!kind} or {!doc} updated
279
+
to the corresponding values if specified. Unlike {!map}, this does
280
+
not change the codec's decoding or encoding behavior.
281
+
282
+
{4 Example}
283
+
{[
284
+
let person_id = with_doc ~kind:"person ID" int
285
+
]} *)
286
+
287
+
(** {1:base Base Type Codecs}
288
+
289
+
Primitive codecs for {{:https://toml.io/en/v1.1.0}TOML 1.1}'s basic
290
+
value types. *)
291
+
292
+
val bool : bool t
293
+
(** Codec for {{:https://toml.io/en/v1.1.0#boolean}TOML booleans}. *)
294
+
295
+
val int : int t
296
+
(** Codec for {{:https://toml.io/en/v1.1.0#integer}TOML integers} to OCaml [int].
297
+
Supports decimal, hex ([0x]), octal ([0o]), and binary ([0b]) formats.
298
+
@raise Int_overflow if the value exceeds platform [int] range. *)
299
+
300
+
val int32 : int32 t
301
+
(** Codec for {{:https://toml.io/en/v1.1.0#integer}TOML integers} to [int32]. *)
302
+
303
+
val int64 : int64 t
304
+
(** Codec for {{:https://toml.io/en/v1.1.0#integer}TOML integers} to [int64]. *)
305
+
306
+
val float : float t
307
+
(** Codec for {{:https://toml.io/en/v1.1.0#float}TOML floats}.
308
+
Handles [inf], [-inf], and [nan] per the spec. *)
309
+
310
+
val number : float t
311
+
(** Codec that accepts both {{:https://toml.io/en/v1.1.0#integer}integers}
312
+
and {{:https://toml.io/en/v1.1.0#float}floats} as [float].
313
+
Integers are converted to floats during decoding. *)
314
+
315
+
val string : string t
316
+
(** Codec for {{:https://toml.io/en/v1.1.0#string}TOML strings} (UTF-8 encoded).
317
+
Supports basic strings, literal strings, and their multiline variants. *)
318
+
319
+
val int_as_string : int t
320
+
(** Codec for integers stored as TOML strings.
321
+
322
+
On decode, uses [int_of_string_opt] which accepts decimal, hex ([0x]),
323
+
octal ([0o]), and binary ([0b]) formats.
324
+
On encode, uses [Int.to_string] (decimal).
325
+
326
+
Useful when integers must be stored as strings for compatibility,
327
+
or when you need to preserve leading zeros or specific formats. *)
328
+
329
+
val int64_as_string : int64 t
330
+
(** Codec for 64-bit integers stored as TOML strings.
331
+
332
+
Like {!int_as_string} but for [int64] values. Uses [Int64.of_string_opt]
333
+
for decoding and [Int64.to_string] for encoding. *)
334
+
335
+
(** {1:ptime_codecs Ptime Datetime Codecs}
336
+
337
+
Tomlt provides unified datetime handling using
338
+
{{:https://erratique.ch/software/ptime}Ptime}. All TOML datetime formats
339
+
can be decoded to [Ptime.t] timestamps.
340
+
341
+
See the {{!page-cookbook.datetimes}cookbook} for detailed patterns
342
+
and examples.
343
+
344
+
{2 Choosing a Codec}
345
+
346
+
- {!val:ptime} - Accepts any datetime format, normalizes to [Ptime.t]
347
+
- {!val:ptime_opt} - Strict: only accepts offset datetimes with timezone
348
+
- {!val:ptime_date} - For date-only fields
349
+
- {!val:ptime_span} - For time-only fields (as duration from midnight)
350
+
- {!val:ptime_full} - Preserves exact variant for roundtripping *)
351
+
352
+
val ptime :
353
+
?tz_offset_s:int ->
354
+
?get_tz:(unit -> int option) ->
355
+
?now:(unit -> Ptime.t) ->
356
+
?frac_s:int ->
357
+
unit -> Ptime.t t
358
+
(** Datetime codec that converts any TOML datetime to {!Ptime.t}.
359
+
360
+
Handles all TOML datetime variants by filling in sensible defaults.
361
+
Encoding produces RFC 3339 offset datetime strings.
362
+
363
+
See {{!page-cookbook.datetimes}Working with datetimes} for examples.
364
+
365
+
@param tz_offset_s Timezone offset in seconds for local datetimes.
366
+
Common: [0] (UTC), [3600] (+01:00), [-18000] (-05:00).
367
+
@param get_tz Function to get timezone offset when [tz_offset_s]
368
+
not provided. Use [Tomlt_unix.current_tz_offset_s] for system timezone.
369
+
@param now Function for current time, used for time-only values.
370
+
Use [Tomlt_unix.now] for system time.
371
+
@param frac_s Fractional second digits (0-12) for encoding. *)
372
+
373
+
val ptime_opt : ?tz_offset_s:int -> ?frac_s:int -> unit -> Ptime.t t
374
+
(** Strict datetime codec that only accepts offset datetimes.
375
+
376
+
Requires explicit timezone; rejects local datetimes, dates, and times.
377
+
Use when you need unambiguous timestamps.
378
+
379
+
See {{!page-cookbook.datetimes}Working with datetimes} for examples.
380
+
381
+
@param tz_offset_s Timezone offset for encoding. Default: 0 (UTC).
382
+
@param frac_s Fractional second digits for encoding. Default: 0. *)
383
+
384
+
val ptime_span : Ptime.Span.t t
385
+
(** Codec for TOML local times as [Ptime.Span.t] (duration from midnight).
386
+
387
+
Decodes [07:32:00] to a span representing time since midnight.
388
+
Values are clamped to [00:00:00] to [23:59:59.999999999].
389
+
390
+
See {{!page-cookbook.datetimes}Working with datetimes} for examples. *)
391
+
392
+
val ptime_date : Ptime.date t
393
+
(** Codec for TOML local dates as [Ptime.date] ([(year, month, day)] tuple).
394
+
395
+
Decodes [1979-05-27] to [(1979, 5, 27)]. Only accepts local dates.
396
+
To work with dates as [Ptime.t] (at midnight), use {!ptime} instead.
397
+
398
+
See {{!page-cookbook.datetimes}Working with datetimes} for examples. *)
399
+
400
+
val ptime_full :
401
+
?tz_offset_s:int ->
402
+
?get_tz:(unit -> int option) ->
403
+
unit -> Toml.ptime_datetime t
404
+
(** Codec that preserves full datetime variant information.
405
+
406
+
Returns a {!Toml.ptime_datetime} variant indicating exactly what was
407
+
present in the TOML source. Essential for roundtripping TOML files
408
+
while preserving the original format.
409
+
410
+
See {{!page-cookbook.datetimes}Working with datetimes} and
411
+
{{!page-cookbook.roundtripping}Roundtripping TOML} for examples.
412
+
413
+
@param tz_offset_s Timezone offset for converting [`Datetime_local].
414
+
@param get_tz Function for timezone when [tz_offset_s] not provided. *)
415
+
416
+
(** {1:combinators Codec Combinators} *)
417
+
418
+
val map :
419
+
?kind:string -> ?doc:string ->
420
+
?dec:('a -> 'b) -> ?enc:('b -> 'a) ->
421
+
'a t -> 'b t
422
+
(** [map ?dec ?enc c] transforms codec [c] through functions.
423
+
[dec] transforms decoded values; [enc] transforms values before encoding. *)
424
+
425
+
val const : ?kind:string -> ?doc:string -> 'a -> 'a t
426
+
(** [const v] is a codec that always decodes to [v] and encodes as empty. *)
427
+
428
+
val enum : ?cmp:('a -> 'a -> int) -> ?kind:string -> ?doc:string ->
429
+
(string * 'a) list -> 'a t
430
+
(** [enum assoc] creates a codec for string enumerations.
431
+
@param cmp Comparison function for finding values during encoding.
432
+
@param assoc List of [(string, value)] pairs. *)
433
+
434
+
val option : ?kind:string -> ?doc:string -> 'a t -> 'a option t
435
+
(** [option c] wraps codec [c] to decode [Some v] or encode [None] as omitted. *)
436
+
437
+
val result : ok:'a t -> error:'b t -> ('a, 'b) result t
438
+
(** [result ~ok ~error] tries [ok] first, then [error]. *)
439
+
440
+
val rec' : 'a t Lazy.t -> 'a t
441
+
(** [rec' lazy_c] creates a recursive codec.
442
+
Use for self-referential types:
443
+
{v
444
+
let rec tree = lazy Tomlt.(
445
+
Table.(obj (fun v children -> Node (v, children))
446
+
|> mem "value" int ~enc:(function Node (v, _) -> v)
447
+
|> mem "children" (list (rec' tree)) ~enc:(function Node (_, cs) -> cs)
448
+
|> finish))
449
+
v} *)
450
+
451
+
val iter :
452
+
?kind:string -> ?doc:string ->
453
+
?dec:('a -> unit) -> ?enc:('a -> unit) ->
454
+
'a t -> 'a t
455
+
(** [iter ?dec ?enc c] applies [dec] on decoding and [enc] on encoding
456
+
but otherwise behaves like [c]. Useful for:
457
+
- Asserting additional constraints on decoded values
458
+
- Tracing/debugging codec behavior
459
+
- Side effects during encoding/decoding
460
+
461
+
{4 Example}
462
+
{[
463
+
(* Trace all decoded integers *)
464
+
let traced_int = iter int
465
+
~dec:(fun i -> Printf.printf "Decoded: %d\n" i)
466
+
467
+
(* Validate port range *)
468
+
let port = iter int
469
+
~dec:(fun p ->
470
+
if p < 0 || p > 65535 then
471
+
failwith "port out of range")
472
+
]} *)
473
+
474
+
val recode : dec:'a t -> ('a -> 'b) -> enc:'b t -> 'b t
475
+
(** [recode ~dec f ~enc] decodes like [dec] followed by [f], and
476
+
encodes using [enc]. This allows changing the TOML representation
477
+
while maintaining bidirectionality.
478
+
479
+
{4 Example}
480
+
{[
481
+
(* Store URI as string, decode to Uri.t *)
482
+
let uri_codec =
483
+
recode ~dec:string Uri.of_string ~enc:string_of_uri
484
+
485
+
(* Convert between string list and comma-separated string *)
486
+
let tags_codec =
487
+
recode
488
+
~dec:string
489
+
(String.split_on_char ',')
490
+
~enc:(list string)
491
+
]} *)
492
+
493
+
(** {2:query Query Combinators}
494
+
495
+
Extract single values from arrays or tables without processing
496
+
the entire structure. *)
497
+
498
+
val nth : ?absent:'a -> int -> 'a t -> 'a t
499
+
(** [nth n t] decodes the [n]th element of a TOML array with [t].
500
+
Other elements are skipped.
501
+
502
+
@param absent Value to use if the index is out of bounds.
503
+
If not provided, an error is raised for out-of-bounds access.
504
+
@raise Value_error if [n] is out of bounds and [absent] is not provided.
505
+
506
+
{4 Example}
507
+
{[
508
+
(* Get first element of array *)
509
+
let first = nth 0 string
510
+
511
+
(* Get second element with default *)
512
+
let second = nth ~absent:"default" 1 string
513
+
]} *)
514
+
515
+
val mem : ?absent:'a -> string -> 'a t -> 'a t
516
+
(** [mem name t] decodes the member named [name] from a TOML table with [t].
517
+
Other members are skipped. This is simpler than {!Table} when you only
518
+
need a single value.
519
+
520
+
@param absent Value to use if the member doesn't exist.
521
+
If not provided, an error is raised for missing members.
522
+
523
+
{4 Example}
524
+
{[
525
+
(* Extract just the "version" field *)
526
+
let version = mem "version" string
527
+
528
+
(* With default value *)
529
+
let debug = mem ~absent:false "debug" bool
530
+
]} *)
531
+
532
+
(** {2:folding Folding Combinators}
533
+
534
+
Process all elements of an array or table. These are decode-only;
535
+
encoding produces empty containers. *)
536
+
537
+
val fold_array : 'a t -> (int -> 'a -> 'b -> 'b) -> 'b -> 'b t
538
+
(** [fold_array t f init] folds [f] over all elements of a TOML array,
539
+
decoding each element with [t]. The fold function receives the index,
540
+
decoded value, and accumulator.
541
+
542
+
Encodes to an empty array (folding is decode-only).
543
+
544
+
{4 Example}
545
+
{[
546
+
(* Sum all integers in array *)
547
+
let sum = fold_array int (fun _i x acc -> x + acc) 0
548
+
549
+
(* Collect values into a Set *)
550
+
let string_set = fold_array string
551
+
(fun _i s acc -> StringSet.add s acc) StringSet.empty
552
+
]} *)
553
+
554
+
val fold_table : 'a t -> (string -> 'a -> 'b -> 'b) -> 'b -> 'b t
555
+
(** [fold_table t f init] folds [f] over all members of a TOML table,
556
+
decoding each value with [t]. The fold function receives the key,
557
+
decoded value, and accumulator.
558
+
559
+
Encodes to an empty table (folding is decode-only).
560
+
561
+
{4 Example}
562
+
{[
563
+
(* Build a map from table *)
564
+
let string_map = fold_table string
565
+
(fun k v acc -> StringMap.add k v acc) StringMap.empty
566
+
567
+
(* Count members *)
568
+
let count = fold_table any (fun _k _v n -> n + 1) 0
569
+
]} *)
570
+
571
+
(** {2:ignoring Ignoring and Placeholders} *)
572
+
573
+
val ignore : unit t
574
+
(** [ignore] maps any TOML value to [()] on decoding and errors on encoding.
575
+
Use for values you want to skip during decoding. *)
576
+
577
+
val zero : unit t
578
+
(** [zero] maps any TOML value to [()] on decoding and encodes as an
579
+
empty table. Useful for placeholder values. *)
580
+
581
+
val todo : ?kind:string -> ?doc:string -> ?dec_stub:'a -> unit -> 'a t
582
+
(** [todo ?dec_stub ()] is a placeholder codec for work in progress.
583
+
- On decode: returns [dec_stub] if provided, errors otherwise
584
+
- On encode: always errors
585
+
586
+
Useful during development to mark incomplete parts of a codec.
587
+
588
+
{4 Example}
589
+
{[
590
+
type config = { name : string; advanced : unit (* TODO *) }
591
+
592
+
let config_codec = Tomlt.(Table.(
593
+
obj (fun name advanced -> { name; advanced })
594
+
|> mem "name" string ~enc:(fun c -> c.name)
595
+
|> mem "advanced" (todo ~dec_stub:() ()) ~enc:(fun _ -> ())
596
+
|> finish
597
+
))
598
+
]} *)
599
+
600
+
(** {1:arrays Array Codecs}
601
+
602
+
Build codecs for {{:https://toml.io/en/v1.1.0#array}TOML arrays}.
603
+
604
+
See {{!page-cookbook.arrays}Working with arrays} for patterns. *)
605
+
606
+
module Array : sig
607
+
type 'a codec = 'a t
608
+
609
+
(** Encoder specification for arrays. *)
610
+
type ('array, 'elt) enc = {
611
+
fold : 'acc. ('acc -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc
612
+
}
613
+
614
+
(** Array codec builder. *)
615
+
type ('array, 'elt, 'builder) map
616
+
617
+
val map :
618
+
?kind:string -> ?doc:string ->
619
+
?dec_empty:(unit -> 'builder) ->
620
+
?dec_add:('elt -> 'builder -> 'builder) ->
621
+
?dec_finish:('builder -> 'array) ->
622
+
?enc:('array, 'elt) enc ->
623
+
'elt codec -> ('array, 'elt, 'builder) map
624
+
(** [map elt] creates an array codec builder for elements of type ['elt]. *)
625
+
626
+
val list : ?kind:string -> ?doc:string -> 'a codec -> ('a list, 'a, 'a list) map
627
+
(** [list c] builds lists from arrays of elements decoded by [c]. *)
628
+
629
+
val array : ?kind:string -> ?doc:string -> 'a codec -> ('a array, 'a, 'a list) map
630
+
(** [array c] builds arrays from arrays of elements decoded by [c]. *)
631
+
632
+
val finish : ('array, 'elt, 'builder) map -> 'array codec
633
+
(** [finish m] completes the array codec. *)
634
+
end
635
+
636
+
val list : ?kind:string -> ?doc:string -> 'a t -> 'a list t
637
+
(** [list c] is a codec for {{:https://toml.io/en/v1.1.0#array}TOML arrays}
638
+
as OCaml lists. *)
639
+
640
+
val array : ?kind:string -> ?doc:string -> 'a t -> 'a array t
641
+
(** [array c] is a codec for {{:https://toml.io/en/v1.1.0#array}TOML arrays}
642
+
as OCaml arrays. *)
643
+
644
+
(** {1:tables Table Codecs}
645
+
646
+
Build codecs for {{:https://toml.io/en/v1.1.0#table}TOML tables}
647
+
using an applicative-style builder pattern.
648
+
649
+
See the {{!page-cookbook.config_files}cookbook} for configuration patterns,
650
+
{{!page-cookbook.optional_values}optional values}, and
651
+
{{!page-cookbook.unknown_members}unknown member handling}. *)
652
+
653
+
module Table : sig
654
+
type 'a codec = 'a t
655
+
656
+
(** {2 Member Specifications} *)
657
+
658
+
module Mem : sig
659
+
type 'a codec = 'a t
660
+
type ('o, 'a) t
661
+
(** A member specification for type ['a] within object type ['o]. *)
662
+
663
+
val v :
664
+
?doc:string ->
665
+
?dec_absent:'a ->
666
+
?enc:('o -> 'a) ->
667
+
?enc_omit:('a -> bool) ->
668
+
string -> 'a codec -> ('o, 'a) t
669
+
(** [v name codec] creates a member specification.
670
+
@param doc Documentation for this member.
671
+
@param dec_absent Default value if member is absent (makes it optional).
672
+
@param enc Encoder function from object to member value.
673
+
@param enc_omit Predicate to omit member during encoding. *)
674
+
675
+
val opt :
676
+
?doc:string ->
677
+
?enc:('o -> 'a option) ->
678
+
string -> 'a codec -> ('o, 'a option) t
679
+
(** [opt name codec] creates an optional member that decodes to [None]
680
+
when absent and is omitted when encoding [None]. *)
681
+
end
682
+
683
+
(** {2 Table Builder} *)
684
+
685
+
type ('o, 'dec) map
686
+
(** Builder state for a table codec producing ['o], currently decoding ['dec]. *)
687
+
688
+
val obj : ?kind:string -> ?doc:string -> 'dec -> ('o, 'dec) map
689
+
(** [obj f] starts building a table codec with decoder function [f].
690
+
691
+
The function [f] receives each member's decoded value as arguments
692
+
and returns the final decoded object. Build incrementally with [mem]:
693
+
{v
694
+
obj (fun a b c -> { a; b; c })
695
+
|> mem "a" codec_a ~enc:...
696
+
|> mem "b" codec_b ~enc:...
697
+
|> mem "c" codec_c ~enc:...
698
+
|> finish
699
+
v} *)
700
+
701
+
val obj' : ?kind:string -> ?doc:string -> (unit -> 'dec) -> ('o, 'dec) map
702
+
(** [obj' f] is like [obj] but [f] is a thunk for side-effecting decoders. *)
703
+
704
+
val mem :
705
+
?doc:string ->
706
+
?dec_absent:'a ->
707
+
?enc:('o -> 'a) ->
708
+
?enc_omit:('a -> bool) ->
709
+
string -> 'a codec -> ('o, 'a -> 'dec) map -> ('o, 'dec) map
710
+
(** [mem name codec m] adds a member to the table builder.
711
+
712
+
@param name The TOML key name.
713
+
@param codec The codec for the member's value.
714
+
@param doc Documentation string.
715
+
@param dec_absent Default value if absent (makes member optional).
716
+
@param enc Extractor function for encoding.
717
+
@param enc_omit Predicate; if [true], omit member during encoding. *)
718
+
719
+
val opt_mem :
720
+
?doc:string ->
721
+
?enc:('o -> 'a option) ->
722
+
string -> 'a codec -> ('o, 'a option -> 'dec) map -> ('o, 'dec) map
723
+
(** [opt_mem name codec m] adds an optional member.
724
+
Absent members decode as [None]; [None] values are omitted on encode. *)
725
+
726
+
(** {2 Unknown Member Handling} *)
727
+
728
+
val skip_unknown : ('o, 'dec) map -> ('o, 'dec) map
729
+
(** [skip_unknown m] ignores unknown members (the default). *)
730
+
731
+
val error_unknown : ('o, 'dec) map -> ('o, 'dec) map
732
+
(** [error_unknown m] raises an error on unknown members. *)
733
+
734
+
(** Collection of unknown members. *)
735
+
module Mems : sig
736
+
type 'a codec = 'a t
737
+
738
+
type ('mems, 'a) enc = {
739
+
fold : 'acc. ('acc -> string -> 'a -> 'acc) -> 'acc -> 'mems -> 'acc
740
+
}
741
+
742
+
type ('mems, 'a, 'builder) map
743
+
744
+
val map :
745
+
?kind:string -> ?doc:string ->
746
+
?dec_empty:(unit -> 'builder) ->
747
+
?dec_add:(string -> 'a -> 'builder -> 'builder) ->
748
+
?dec_finish:('builder -> 'mems) ->
749
+
?enc:('mems, 'a) enc ->
750
+
'a codec -> ('mems, 'a, 'builder) map
751
+
752
+
val string_map : ?kind:string -> ?doc:string ->
753
+
'a codec -> ('a Map.Make(String).t, 'a, (string * 'a) list) map
754
+
(** [string_map codec] collects unknown members into a [StringMap]. *)
755
+
756
+
val assoc : ?kind:string -> ?doc:string ->
757
+
'a codec -> ((string * 'a) list, 'a, (string * 'a) list) map
758
+
(** [assoc codec] collects unknown members into an association list. *)
759
+
end
760
+
761
+
val keep_unknown :
762
+
?enc:('o -> 'mems) ->
763
+
('mems, 'a, 'builder) Mems.map ->
764
+
('o, 'mems -> 'dec) map -> ('o, 'dec) map
765
+
(** [keep_unknown mems m] collects unknown members.
766
+
767
+
Unknown members are decoded using [mems] and passed to the decoder.
768
+
If [enc] is provided, those members are included during encoding. *)
769
+
770
+
val finish : ('o, 'o) map -> 'o codec
771
+
(** [finish m] completes the table codec.
772
+
@raise Invalid_argument if member names are duplicated. *)
773
+
774
+
val inline : ('o, 'o) map -> 'o codec
775
+
(** [inline m] is like [finish] but marks the table for inline encoding. *)
776
+
end
777
+
778
+
val array_of_tables : ?kind:string -> ?doc:string -> 'a t -> 'a list t
779
+
(** [array_of_tables c] decodes a
780
+
{{:https://toml.io/en/v1.1.0#array-of-tables}TOML array of tables}.
781
+
This corresponds to TOML's [[\[\[name\]\]]] syntax for defining
782
+
arrays of table elements. *)
783
+
784
+
(** {1 Generic Value Codecs} *)
785
+
786
+
val value : Toml.t t
787
+
(** [value] passes TOML values through unchanged.
788
+
Useful for preserving parts of a document without interpretation. *)
789
+
790
+
val value_mems : (string * Toml.t) list t
791
+
(** [value_mems] decodes a {{:https://toml.io/en/v1.1.0#table}table}
792
+
as raw key-value pairs. *)
793
+
794
+
val any :
795
+
?kind:string -> ?doc:string ->
796
+
?dec_string:'a t -> ?dec_int:'a t -> ?dec_float:'a t -> ?dec_bool:'a t ->
797
+
?dec_datetime:'a t -> ?dec_array:'a t -> ?dec_table:'a t ->
798
+
?enc:('a -> 'a t) ->
799
+
unit -> 'a t
800
+
(** [any ()] creates a codec that handles any TOML type.
801
+
Provide decoders for each type you want to support.
802
+
The [enc] function should return the appropriate codec for encoding. *)
803
+
804
+
(** {1:codec_ops Encoding and Decoding}
805
+
806
+
Functions for converting between OCaml values and TOML values.
807
+
For I/O operations (parsing strings, writing to files), see
808
+
{!Tomlt_bytesrw}. *)
809
+
810
+
val decode : 'a t -> Toml.t -> ('a, Toml.Error.t) result
811
+
(** [decode c v] decodes TOML value [v] using codec [c]. *)
812
+
813
+
val decode_exn : 'a t -> Toml.t -> 'a
814
+
(** [decode_exn c v] is like [decode] but raises on error.
815
+
@raise Toml.Error.Error on decode failure. *)
816
+
817
+
val encode : 'a t -> 'a -> Toml.t
818
+
(** [encode c v] encodes OCaml value [v] to TOML using codec [c]. *)
819
+
820
+
(** {1 Re-exported Modules} *)
821
+
822
+
module Toml = Toml
823
+
(** The raw TOML value module. Use for low-level TOML manipulation. *)
824
+
825
+
module Error = Toml.Error
826
+
(** Error types from the TOML parser. *)
+6
vendor/opam/tomlt/lib_bytesrw/dune
+6
vendor/opam/tomlt/lib_bytesrw/dune
+2355
vendor/opam/tomlt/lib_bytesrw/tomlt_bytesrw.ml
+2355
vendor/opam/tomlt/lib_bytesrw/tomlt_bytesrw.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Bytesrw
7
+
8
+
(* Aliases for cleaner code *)
9
+
module Toml = Tomlt.Toml
10
+
module Toml_error = Toml.Error
11
+
12
+
(* Lexer - works directly on bytes buffer filled from Bytes.Reader *)
13
+
14
+
type token =
15
+
| Tok_lbracket
16
+
| Tok_rbracket
17
+
| Tok_lbrace
18
+
| Tok_rbrace
19
+
| Tok_equals
20
+
| Tok_comma
21
+
| Tok_dot
22
+
| Tok_newline
23
+
| Tok_eof
24
+
| Tok_bare_key of string
25
+
| Tok_basic_string of string
26
+
| Tok_literal_string of string
27
+
| Tok_ml_basic_string of string (* Multiline basic string - not valid as key *)
28
+
| Tok_ml_literal_string of string (* Multiline literal string - not valid as key *)
29
+
| Tok_integer of int64 * string (* value, original string for key reconstruction *)
30
+
| Tok_float of float * string (* value, original string for key reconstruction *)
31
+
| Tok_datetime of string
32
+
| Tok_datetime_local of string
33
+
| Tok_date_local of string
34
+
| Tok_time_local of string
35
+
36
+
type lexer = {
37
+
input : bytes; (* Buffer containing input data *)
38
+
input_len : int; (* Length of valid data in input *)
39
+
mutable pos : int;
40
+
mutable line : int;
41
+
mutable col : int;
42
+
file : string;
43
+
}
44
+
45
+
(* Create lexer from string (copies to bytes) *)
46
+
let make_lexer ?(file = "-") s =
47
+
let input = Bytes.of_string s in
48
+
{ input; input_len = Bytes.length input; pos = 0; line = 1; col = 1; file }
49
+
50
+
(* Create lexer directly from Bytes.Reader - reads all data into buffer *)
51
+
let make_lexer_from_reader ?(file = "-") r =
52
+
(* Read all slices into a buffer *)
53
+
let buf = Buffer.create 4096 in
54
+
let rec read_all () =
55
+
let slice = Bytes.Reader.read r in
56
+
if Bytes.Slice.is_eod slice then ()
57
+
else begin
58
+
Bytes.Slice.add_to_buffer buf slice;
59
+
read_all ()
60
+
end
61
+
in
62
+
read_all ();
63
+
let input = Buffer.to_bytes buf in
64
+
{ input; input_len = Bytes.length input; pos = 0; line = 1; col = 1; file }
65
+
66
+
let is_eof l = l.pos >= l.input_len
67
+
68
+
let peek l = if is_eof l then None else Some (Bytes.get l.input l.pos)
69
+
70
+
let peek2 l =
71
+
if l.pos + 1 >= l.input_len then None
72
+
else Some (Bytes.get l.input (l.pos + 1))
73
+
74
+
let peek_n l n =
75
+
if l.pos + n - 1 >= l.input_len then None
76
+
else Some (Bytes.sub_string l.input l.pos n)
77
+
78
+
let advance l =
79
+
if not (is_eof l) then begin
80
+
if Bytes.get l.input l.pos = '\n' then begin
81
+
l.line <- l.line + 1;
82
+
l.col <- 1
83
+
end else
84
+
l.col <- l.col + 1;
85
+
l.pos <- l.pos + 1
86
+
end
87
+
88
+
let advance_n l n =
89
+
for _ = 1 to n do advance l done
90
+
91
+
let skip_whitespace l =
92
+
while not (is_eof l) && (Bytes.get l.input l.pos = ' ' || Bytes.get l.input l.pos = '\t') do
93
+
advance l
94
+
done
95
+
96
+
(* Helper functions for bytes access *)
97
+
let[@inline] get_char l pos = Bytes.unsafe_get l.input pos
98
+
let[@inline] get_current l = Bytes.unsafe_get l.input l.pos
99
+
let sub_string l pos len = Bytes.sub_string l.input pos len
100
+
101
+
(* Helper to create error location from lexer state *)
102
+
let lexer_loc l = Toml.Error.loc ~file:l.file ~line:l.line ~column:l.col ()
103
+
104
+
(* Get expected byte length of UTF-8 char from first byte *)
105
+
let utf8_byte_length_from_first_byte c =
106
+
let code = Char.code c in
107
+
if code < 0x80 then 1
108
+
else if code < 0xC0 then 0 (* Invalid: continuation byte as start *)
109
+
else if code < 0xE0 then 2
110
+
else if code < 0xF0 then 3
111
+
else if code < 0xF8 then 4
112
+
else 0 (* Invalid: 5+ byte sequence *)
113
+
114
+
(* Validate UTF-8 at position in lexer's bytes buffer, returns byte length *)
115
+
let validate_utf8_at_pos_bytes l =
116
+
if l.pos >= l.input_len then
117
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Unexpected_eof;
118
+
let byte_len = utf8_byte_length_from_first_byte (Bytes.unsafe_get l.input l.pos) in
119
+
if byte_len = 0 then
120
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Invalid_utf8;
121
+
if l.pos + byte_len > l.input_len then
122
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Incomplete_utf8;
123
+
(* Validate using uutf - it checks overlong encodings, surrogates, etc. *)
124
+
let sub = Bytes.sub_string l.input l.pos byte_len in
125
+
let valid = ref false in
126
+
Uutf.String.fold_utf_8 (fun () _ -> function
127
+
| `Uchar _ -> valid := true
128
+
| `Malformed _ -> ()
129
+
) () sub;
130
+
if not !valid then
131
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Invalid_utf8;
132
+
byte_len
133
+
134
+
(* UTF-8 validation - validates and advances over a single UTF-8 character *)
135
+
let validate_utf8_char l =
136
+
let byte_len = validate_utf8_at_pos_bytes l in
137
+
for _ = 1 to byte_len do advance l done
138
+
139
+
let skip_comment l =
140
+
if not (is_eof l) && get_current l = '#' then begin
141
+
(* Validate comment characters *)
142
+
advance l;
143
+
let continue = ref true in
144
+
while !continue && not (is_eof l) && get_current l <> '\n' do
145
+
let c = get_current l in
146
+
let code = Char.code c in
147
+
(* CR is only valid if followed by LF (CRLF at end of comment) *)
148
+
if c = '\r' then begin
149
+
(* Check if this CR is followed by LF - if so, it ends the comment *)
150
+
if l.pos + 1 < l.input_len && get_char l (l.pos + 1) = '\n' then
151
+
(* This is CRLF - stop the loop, let the main lexer handle it *)
152
+
continue := false
153
+
else
154
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Bare_carriage_return
155
+
end else if code >= 0x80 then begin
156
+
(* Multi-byte UTF-8 character - validate it *)
157
+
validate_utf8_char l
158
+
end else begin
159
+
(* ASCII control characters other than tab are not allowed in comments *)
160
+
if code < 0x09 || (code > 0x09 && code < 0x20) || code = 0x7F then
161
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Control_character code);
162
+
advance l
163
+
end
164
+
done
165
+
end
166
+
167
+
let skip_ws_and_comments l =
168
+
let rec loop () =
169
+
skip_whitespace l;
170
+
if not (is_eof l) && get_current l = '#' then begin
171
+
skip_comment l;
172
+
loop ()
173
+
end
174
+
in
175
+
loop ()
176
+
177
+
let is_bare_key_char c =
178
+
(c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') ||
179
+
(c >= '0' && c <= '9') || c = '_' || c = '-'
180
+
181
+
let is_digit c = c >= '0' && c <= '9'
182
+
let is_hex_digit c = is_digit c || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')
183
+
let is_oct_digit c = c >= '0' && c <= '7'
184
+
let is_bin_digit c = c = '0' || c = '1'
185
+
186
+
let hex_value c =
187
+
if c >= '0' && c <= '9' then Char.code c - Char.code '0'
188
+
else if c >= 'a' && c <= 'f' then Char.code c - Char.code 'a' + 10
189
+
else if c >= 'A' && c <= 'F' then Char.code c - Char.code 'A' + 10
190
+
else Toml.Error.raise_number Invalid_hex_digit
191
+
192
+
(* Convert Unicode codepoint to UTF-8 using uutf *)
193
+
let codepoint_to_utf8 codepoint =
194
+
if codepoint < 0 || codepoint > 0x10FFFF then
195
+
failwith (Printf.sprintf "Invalid Unicode codepoint: U+%X" codepoint);
196
+
if codepoint >= 0xD800 && codepoint <= 0xDFFF then
197
+
failwith (Printf.sprintf "Surrogate codepoint not allowed: U+%04X" codepoint);
198
+
let buf = Buffer.create 4 in
199
+
Uutf.Buffer.add_utf_8 buf (Uchar.of_int codepoint);
200
+
Buffer.contents buf
201
+
202
+
(* Parse Unicode escape with error location from lexer *)
203
+
let unicode_to_utf8 l codepoint =
204
+
if codepoint < 0 || codepoint > 0x10FFFF then
205
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Invalid_unicode_codepoint codepoint);
206
+
if codepoint >= 0xD800 && codepoint <= 0xDFFF then
207
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Surrogate_codepoint codepoint);
208
+
let buf = Buffer.create 4 in
209
+
Uutf.Buffer.add_utf_8 buf (Uchar.of_int codepoint);
210
+
Buffer.contents buf
211
+
212
+
let parse_escape l =
213
+
advance l; (* skip backslash *)
214
+
if is_eof l then
215
+
Toml.Error.raise_lexer ~location:(lexer_loc l) Unexpected_eof;
216
+
let c = get_current l in
217
+
advance l;
218
+
match c with
219
+
| 'b' -> "\b"
220
+
| 't' -> "\t"
221
+
| 'n' -> "\n"
222
+
| 'f' -> "\x0C"
223
+
| 'r' -> "\r"
224
+
| 'e' -> "\x1B" (* TOML 1.1 escape *)
225
+
| '"' -> "\""
226
+
| '\\' -> "\\"
227
+
| 'x' ->
228
+
(* \xHH - 2 hex digits *)
229
+
if l.pos + 1 >= l.input_len then
230
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Incomplete_escape "\\x");
231
+
let c1 = get_char l l.pos in
232
+
let c2 = get_char l (l.pos + 1) in
233
+
if not (is_hex_digit c1 && is_hex_digit c2) then
234
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Invalid_unicode_escape "\\x");
235
+
let cp = (hex_value c1 * 16) + hex_value c2 in
236
+
advance l; advance l;
237
+
unicode_to_utf8 l cp
238
+
| 'u' ->
239
+
(* \uHHHH - 4 hex digits *)
240
+
if l.pos + 3 >= l.input_len then
241
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Incomplete_escape "\\u");
242
+
let s = sub_string l l.pos 4 in
243
+
for i = 0 to 3 do
244
+
if not (is_hex_digit s.[i]) then
245
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Invalid_unicode_escape "\\u")
246
+
done;
247
+
let cp = int_of_string ("0x" ^ s) in
248
+
advance_n l 4;
249
+
unicode_to_utf8 l cp
250
+
| 'U' ->
251
+
(* \UHHHHHHHH - 8 hex digits *)
252
+
if l.pos + 7 >= l.input_len then
253
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Incomplete_escape "\\U");
254
+
let s = sub_string l l.pos 8 in
255
+
for i = 0 to 7 do
256
+
if not (is_hex_digit s.[i]) then
257
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Invalid_unicode_escape "\\U")
258
+
done;
259
+
let cp = int_of_string ("0x" ^ s) in
260
+
advance_n l 8;
261
+
unicode_to_utf8 l cp
262
+
| _ ->
263
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Invalid_escape c)
264
+
265
+
let validate_string_char l c is_multiline =
266
+
let code = Char.code c in
267
+
(* Control characters other than tab (and LF/CR for multiline) are not allowed *)
268
+
if code < 0x09 then
269
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Control_character code);
270
+
if code > 0x09 && code < 0x20 && not (is_multiline && (code = 0x0A || code = 0x0D)) then
271
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Control_character code);
272
+
if code = 0x7F then
273
+
Toml.Error.raise_lexer ~location:(lexer_loc l) (Control_character code)
274
+
275
+
(* Validate UTF-8 in string context and add bytes to buffer *)
276
+
let validate_and_add_utf8_to_buffer l buf =
277
+
let byte_len = validate_utf8_at_pos_bytes l in
278
+
Buffer.add_string buf (sub_string l l.pos byte_len);
279
+
for _ = 1 to byte_len do advance l done
280
+
281
+
let parse_basic_string l =
282
+
advance l; (* skip opening quote *)
283
+
let buf = Buffer.create 64 in
284
+
let multiline =
285
+
match peek_n l 2 with
286
+
| Some "\"\"" ->
287
+
advance l; advance l; (* skip two more quotes *)
288
+
(* Skip newline immediately after opening delimiter *)
289
+
(match peek l with
290
+
| Some '\n' -> advance l
291
+
| Some '\r' ->
292
+
advance l;
293
+
if peek l = Some '\n' then advance l
294
+
else failwith "Bare carriage return not allowed in string"
295
+
| _ -> ());
296
+
true
297
+
| _ -> false
298
+
in
299
+
let rec loop () =
300
+
if is_eof l then
301
+
failwith "Unterminated string";
302
+
let c = get_current l in
303
+
if multiline then begin
304
+
if c = '"' then begin
305
+
(* Count consecutive quotes *)
306
+
let quote_count = ref 0 in
307
+
let p = ref l.pos in
308
+
while !p < l.input_len && get_char l !p = '"' do
309
+
incr quote_count;
310
+
incr p
311
+
done;
312
+
if !quote_count >= 3 then begin
313
+
(* 3+ quotes - this is a closing delimiter *)
314
+
(* Add extra quotes (up to 2) to content before closing delimiter *)
315
+
let extra = min (!quote_count - 3) 2 in
316
+
for _ = 1 to extra do
317
+
Buffer.add_char buf '"'
318
+
done;
319
+
advance_n l (!quote_count);
320
+
if !quote_count > 5 then
321
+
failwith "Too many quotes in multiline string"
322
+
end else begin
323
+
(* Less than 3 quotes - add them to content *)
324
+
for _ = 1 to !quote_count do
325
+
Buffer.add_char buf '"';
326
+
advance l
327
+
done;
328
+
loop ()
329
+
end
330
+
end else if c = '\\' then begin
331
+
(* Check for line-ending backslash *)
332
+
let saved_pos = l.pos in
333
+
let saved_line = l.line in
334
+
let saved_col = l.col in
335
+
advance l;
336
+
let rec skip_ws () =
337
+
match peek l with
338
+
| Some ' ' | Some '\t' -> advance l; skip_ws ()
339
+
| _ -> ()
340
+
in
341
+
skip_ws ();
342
+
match peek l with
343
+
| Some '\n' ->
344
+
advance l;
345
+
(* Skip all whitespace and newlines after *)
346
+
let rec skip_all () =
347
+
match peek l with
348
+
| Some ' ' | Some '\t' | Some '\n' -> advance l; skip_all ()
349
+
| Some '\r' ->
350
+
advance l;
351
+
if peek l = Some '\n' then advance l;
352
+
skip_all ()
353
+
| _ -> ()
354
+
in
355
+
skip_all ();
356
+
loop ()
357
+
| Some '\r' ->
358
+
advance l;
359
+
if peek l = Some '\n' then advance l;
360
+
let rec skip_all () =
361
+
match peek l with
362
+
| Some ' ' | Some '\t' | Some '\n' -> advance l; skip_all ()
363
+
| Some '\r' ->
364
+
advance l;
365
+
if peek l = Some '\n' then advance l;
366
+
skip_all ()
367
+
| _ -> ()
368
+
in
369
+
skip_all ();
370
+
loop ()
371
+
| _ ->
372
+
(* Not a line-ending backslash, restore position and parse escape *)
373
+
l.pos <- saved_pos;
374
+
l.line <- saved_line;
375
+
l.col <- saved_col;
376
+
Buffer.add_string buf (parse_escape l);
377
+
loop ()
378
+
end else begin
379
+
let code = Char.code c in
380
+
if c = '\r' then begin
381
+
advance l;
382
+
if peek l = Some '\n' then begin
383
+
Buffer.add_char buf '\n';
384
+
advance l
385
+
end else
386
+
failwith "Bare carriage return not allowed in string"
387
+
end else if code >= 0x80 then begin
388
+
(* Multi-byte UTF-8 - validate and add *)
389
+
validate_and_add_utf8_to_buffer l buf
390
+
end else begin
391
+
(* ASCII - validate control chars *)
392
+
validate_string_char l c true;
393
+
Buffer.add_char buf c;
394
+
advance l
395
+
end;
396
+
loop ()
397
+
end
398
+
end else begin
399
+
(* Single-line basic string *)
400
+
if c = '"' then begin
401
+
advance l;
402
+
()
403
+
end else if c = '\\' then begin
404
+
Buffer.add_string buf (parse_escape l);
405
+
loop ()
406
+
end else if c = '\n' || c = '\r' then
407
+
failwith "Newline not allowed in basic string"
408
+
else begin
409
+
let code = Char.code c in
410
+
if code >= 0x80 then begin
411
+
(* Multi-byte UTF-8 - validate and add *)
412
+
validate_and_add_utf8_to_buffer l buf
413
+
end else begin
414
+
(* ASCII - validate control chars *)
415
+
validate_string_char l c false;
416
+
Buffer.add_char buf c;
417
+
advance l
418
+
end;
419
+
loop ()
420
+
end
421
+
end
422
+
in
423
+
loop ();
424
+
(Buffer.contents buf, multiline)
425
+
426
+
let parse_literal_string l =
427
+
advance l; (* skip opening quote *)
428
+
let buf = Buffer.create 64 in
429
+
let multiline =
430
+
match peek_n l 2 with
431
+
| Some "''" ->
432
+
advance l; advance l; (* skip two more quotes *)
433
+
(* Skip newline immediately after opening delimiter *)
434
+
(match peek l with
435
+
| Some '\n' -> advance l
436
+
| Some '\r' ->
437
+
advance l;
438
+
if peek l = Some '\n' then advance l
439
+
else failwith "Bare carriage return not allowed in literal string"
440
+
| _ -> ());
441
+
true
442
+
| _ -> false
443
+
in
444
+
let rec loop () =
445
+
if is_eof l then
446
+
failwith "Unterminated literal string";
447
+
let c = get_current l in
448
+
if multiline then begin
449
+
if c = '\'' then begin
450
+
(* Count consecutive quotes *)
451
+
let quote_count = ref 0 in
452
+
let p = ref l.pos in
453
+
while !p < l.input_len && get_char l !p = '\'' do
454
+
incr quote_count;
455
+
incr p
456
+
done;
457
+
if !quote_count >= 3 then begin
458
+
(* 3+ quotes - this is a closing delimiter *)
459
+
(* Add extra quotes (up to 2) to content before closing delimiter *)
460
+
let extra = min (!quote_count - 3) 2 in
461
+
for _ = 1 to extra do
462
+
Buffer.add_char buf '\''
463
+
done;
464
+
advance_n l (!quote_count);
465
+
if !quote_count > 5 then
466
+
failwith "Too many quotes in multiline literal string"
467
+
end else begin
468
+
(* Less than 3 quotes - add them to content *)
469
+
for _ = 1 to !quote_count do
470
+
Buffer.add_char buf '\'';
471
+
advance l
472
+
done;
473
+
loop ()
474
+
end
475
+
end else begin
476
+
let code = Char.code c in
477
+
if c = '\r' then begin
478
+
advance l;
479
+
if peek l = Some '\n' then begin
480
+
Buffer.add_char buf '\n';
481
+
advance l
482
+
end else
483
+
failwith "Bare carriage return not allowed in literal string"
484
+
end else if code >= 0x80 then begin
485
+
(* Multi-byte UTF-8 - validate and add *)
486
+
validate_and_add_utf8_to_buffer l buf
487
+
end else begin
488
+
(* ASCII control char validation for literal strings *)
489
+
if code < 0x09 || (code > 0x09 && code < 0x0A) || (code > 0x0D && code < 0x20) || code = 0x7F then
490
+
if code <> 0x0A && code <> 0x0D then
491
+
failwith (Printf.sprintf "Control character U+%04X not allowed in literal string at line %d" code l.line);
492
+
Buffer.add_char buf c;
493
+
advance l
494
+
end;
495
+
loop ()
496
+
end
497
+
end else begin
498
+
if c = '\'' then begin
499
+
advance l;
500
+
()
501
+
end else if c = '\n' || c = '\r' then
502
+
failwith "Newline not allowed in literal string"
503
+
else begin
504
+
let code = Char.code c in
505
+
if code >= 0x80 then begin
506
+
(* Multi-byte UTF-8 - validate and add *)
507
+
validate_and_add_utf8_to_buffer l buf
508
+
end else begin
509
+
(* ASCII control char validation *)
510
+
if code < 0x09 || (code > 0x09 && code < 0x20) || code = 0x7F then
511
+
failwith (Printf.sprintf "Control character U+%04X not allowed in literal string at line %d" code l.line);
512
+
Buffer.add_char buf c;
513
+
advance l
514
+
end;
515
+
loop ()
516
+
end
517
+
end
518
+
in
519
+
loop ();
520
+
(Buffer.contents buf, multiline)
521
+
522
+
let parse_number l =
523
+
let start = l.pos in
524
+
let neg =
525
+
match peek l with
526
+
| Some '-' -> advance l; true
527
+
| Some '+' -> advance l; false
528
+
| _ -> false
529
+
in
530
+
(* Check for special floats: inf and nan *)
531
+
match peek_n l 3 with
532
+
| Some "inf" ->
533
+
advance_n l 3;
534
+
let s = sub_string l start (l.pos - start) in
535
+
Tok_float ((if neg then Float.neg_infinity else Float.infinity), s)
536
+
| Some "nan" ->
537
+
advance_n l 3;
538
+
let s = sub_string l start (l.pos - start) in
539
+
Tok_float (Float.nan, s)
540
+
| _ ->
541
+
(* Check for hex, octal, or binary *)
542
+
match peek l, peek2 l with
543
+
| Some '0', Some 'x' when not neg ->
544
+
advance l; advance l;
545
+
let num_start = l.pos in
546
+
(* Check for leading underscore *)
547
+
if peek l = Some '_' then failwith "Leading underscore not allowed after 0x";
548
+
let rec read_hex first =
549
+
match peek l with
550
+
| Some c when is_hex_digit c -> advance l; read_hex false
551
+
| Some '_' ->
552
+
if first then failwith "Underscore must follow a hex digit";
553
+
advance l;
554
+
if peek l |> Option.map is_hex_digit |> Option.value ~default:false then
555
+
read_hex false
556
+
else
557
+
failwith "Trailing underscore in hex number"
558
+
| _ ->
559
+
if first then failwith "Expected hex digit after 0x"
560
+
in
561
+
read_hex true;
562
+
let s = sub_string l num_start (l.pos - num_start) in
563
+
let s = String.concat "" (String.split_on_char '_' s) in
564
+
let orig = sub_string l start (l.pos - start) in
565
+
Tok_integer (Int64.of_string ("0x" ^ s), orig)
566
+
| Some '0', Some 'o' when not neg ->
567
+
advance l; advance l;
568
+
let num_start = l.pos in
569
+
(* Check for leading underscore *)
570
+
if peek l = Some '_' then failwith "Leading underscore not allowed after 0o";
571
+
let rec read_oct first =
572
+
match peek l with
573
+
| Some c when is_oct_digit c -> advance l; read_oct false
574
+
| Some '_' ->
575
+
if first then failwith "Underscore must follow an octal digit";
576
+
advance l;
577
+
if peek l |> Option.map is_oct_digit |> Option.value ~default:false then
578
+
read_oct false
579
+
else
580
+
failwith "Trailing underscore in octal number"
581
+
| _ ->
582
+
if first then failwith "Expected octal digit after 0o"
583
+
in
584
+
read_oct true;
585
+
let s = sub_string l num_start (l.pos - num_start) in
586
+
let s = String.concat "" (String.split_on_char '_' s) in
587
+
let orig = sub_string l start (l.pos - start) in
588
+
Tok_integer (Int64.of_string ("0o" ^ s), orig)
589
+
| Some '0', Some 'b' when not neg ->
590
+
advance l; advance l;
591
+
let num_start = l.pos in
592
+
(* Check for leading underscore *)
593
+
if peek l = Some '_' then failwith "Leading underscore not allowed after 0b";
594
+
let rec read_bin first =
595
+
match peek l with
596
+
| Some c when is_bin_digit c -> advance l; read_bin false
597
+
| Some '_' ->
598
+
if first then failwith "Underscore must follow a binary digit";
599
+
advance l;
600
+
if peek l |> Option.map is_bin_digit |> Option.value ~default:false then
601
+
read_bin false
602
+
else
603
+
failwith "Trailing underscore in binary number"
604
+
| _ ->
605
+
if first then failwith "Expected binary digit after 0b"
606
+
in
607
+
read_bin true;
608
+
let s = sub_string l num_start (l.pos - num_start) in
609
+
let s = String.concat "" (String.split_on_char '_' s) in
610
+
let orig = sub_string l start (l.pos - start) in
611
+
Tok_integer (Int64.of_string ("0b" ^ s), orig)
612
+
| _ ->
613
+
(* Regular decimal number *)
614
+
let first_digit = peek l in
615
+
(* Check for leading zeros - also reject 0_ followed by digits *)
616
+
if first_digit = Some '0' then begin
617
+
match peek2 l with
618
+
| Some c when is_digit c -> failwith "Leading zeros not allowed"
619
+
| Some '_' -> failwith "Leading zeros not allowed"
620
+
| _ -> ()
621
+
end;
622
+
let rec read_int first =
623
+
match peek l with
624
+
| Some c when is_digit c -> advance l; read_int false
625
+
| Some '_' ->
626
+
if first then failwith "Underscore must follow a digit";
627
+
advance l;
628
+
if peek l |> Option.map is_digit |> Option.value ~default:false then
629
+
read_int false
630
+
else
631
+
failwith "Trailing underscore in number"
632
+
| _ ->
633
+
if first then failwith "Expected digit"
634
+
in
635
+
(match peek l with
636
+
| Some c when is_digit c -> read_int false
637
+
| _ -> failwith "Expected digit after sign");
638
+
(* Check for float *)
639
+
let is_float = ref false in
640
+
(match peek l, peek2 l with
641
+
| Some '.', Some c when is_digit c ->
642
+
is_float := true;
643
+
advance l;
644
+
read_int false
645
+
| Some '.', _ ->
646
+
failwith "Decimal point must be followed by digit"
647
+
| _ -> ());
648
+
(* Check for exponent *)
649
+
(match peek l with
650
+
| Some 'e' | Some 'E' ->
651
+
is_float := true;
652
+
advance l;
653
+
(match peek l with
654
+
| Some '+' | Some '-' -> advance l
655
+
| _ -> ());
656
+
(* After exponent/sign, first char must be a digit, not underscore *)
657
+
(match peek l with
658
+
| Some '_' -> failwith "Underscore cannot follow exponent"
659
+
| _ -> ());
660
+
read_int true
661
+
| _ -> ());
662
+
let s = sub_string l start (l.pos - start) in
663
+
let s' = String.concat "" (String.split_on_char '_' s) in
664
+
if !is_float then
665
+
Tok_float (float_of_string s', s)
666
+
else
667
+
Tok_integer (Int64.of_string s', s)
668
+
669
+
(* Check if we're looking at a datetime/date/time *)
670
+
let looks_like_datetime l =
671
+
(* YYYY-MM-DD or HH:MM - need to ensure it's not a bare key that starts with numbers *)
672
+
let check_datetime () =
673
+
let pos = l.pos in
674
+
let len = l.input_len in
675
+
(* Check for YYYY-MM-DD pattern - must have exactly this structure *)
676
+
if pos + 10 <= len then begin
677
+
let c0 = get_char l pos in
678
+
let c1 = get_char l (pos + 1) in
679
+
let c2 = get_char l (pos + 2) in
680
+
let c3 = get_char l (pos + 3) in
681
+
let c4 = get_char l (pos + 4) in
682
+
let c5 = get_char l (pos + 5) in
683
+
let c6 = get_char l (pos + 6) in
684
+
let c7 = get_char l (pos + 7) in
685
+
let c8 = get_char l (pos + 8) in
686
+
let c9 = get_char l (pos + 9) in
687
+
(* Must match YYYY-MM-DD pattern AND not be followed by bare key chars (except T or space for time) *)
688
+
if is_digit c0 && is_digit c1 && is_digit c2 && is_digit c3 && c4 = '-' &&
689
+
is_digit c5 && is_digit c6 && c7 = '-' && is_digit c8 && is_digit c9 then begin
690
+
(* Check what follows - if it's a bare key char other than T/t/space, it's not a date *)
691
+
if pos + 10 < len then begin
692
+
let next = get_char l (pos + 10) in
693
+
if next = 'T' || next = 't' then
694
+
`Date (* Datetime continues with time part *)
695
+
else if next = ' ' || next = '\t' then begin
696
+
(* Check if followed by = (key context) or time part *)
697
+
let rec skip_ws p =
698
+
if p >= len then p
699
+
else match get_char l p with
700
+
| ' ' | '\t' -> skip_ws (p + 1)
701
+
| _ -> p
702
+
in
703
+
let after_ws = skip_ws (pos + 11) in
704
+
if after_ws < len && get_char l after_ws = '=' then
705
+
`Other (* It's a key followed by = *)
706
+
else if after_ws < len && is_digit (get_char l after_ws) then
707
+
`Date (* Could be "2001-02-03 12:34:56" format *)
708
+
else
709
+
`Date
710
+
end else if next = '\n' || next = '\r' ||
711
+
next = '#' || next = ',' || next = ']' || next = '}' then
712
+
`Date
713
+
else if is_bare_key_char next then
714
+
`Other (* It's a bare key like "2000-02-29abc" *)
715
+
else
716
+
`Date
717
+
end else
718
+
`Date
719
+
end else if pos + 5 <= len &&
720
+
is_digit c0 && is_digit c1 && c2 = ':' && is_digit c3 && is_digit c4 then
721
+
`Time
722
+
else
723
+
`Other
724
+
end else if pos + 5 <= len then begin
725
+
let c0 = get_char l pos in
726
+
let c1 = get_char l (pos + 1) in
727
+
let c2 = get_char l (pos + 2) in
728
+
let c3 = get_char l (pos + 3) in
729
+
let c4 = get_char l (pos + 4) in
730
+
if is_digit c0 && is_digit c1 && c2 = ':' && is_digit c3 && is_digit c4 then
731
+
`Time
732
+
else
733
+
`Other
734
+
end else
735
+
`Other
736
+
in
737
+
check_datetime ()
738
+
739
+
(* Date/time validation *)
740
+
let validate_date year month day =
741
+
if month < 1 || month > 12 then
742
+
failwith (Printf.sprintf "Invalid month: %d" month);
743
+
if day < 1 then
744
+
failwith (Printf.sprintf "Invalid day: %d" day);
745
+
let days_in_month = [| 0; 31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 |] in
746
+
let is_leap = (year mod 4 = 0 && year mod 100 <> 0) || year mod 400 = 0 in
747
+
let max_days =
748
+
if month = 2 && is_leap then 29
749
+
else days_in_month.(month)
750
+
in
751
+
if day > max_days then
752
+
failwith (Printf.sprintf "Invalid day %d for month %d" day month)
753
+
754
+
let validate_time hour minute second =
755
+
if hour < 0 || hour > 23 then
756
+
failwith (Printf.sprintf "Invalid hour: %d" hour);
757
+
if minute < 0 || minute > 59 then
758
+
failwith (Printf.sprintf "Invalid minute: %d" minute);
759
+
if second < 0 || second > 60 then (* 60 for leap second *)
760
+
failwith (Printf.sprintf "Invalid second: %d" second)
761
+
762
+
let validate_offset hour minute =
763
+
if hour < 0 || hour > 23 then
764
+
failwith (Printf.sprintf "Invalid timezone offset hour: %d" hour);
765
+
if minute < 0 || minute > 59 then
766
+
failwith (Printf.sprintf "Invalid timezone offset minute: %d" minute)
767
+
768
+
let parse_datetime l =
769
+
let buf = Buffer.create 32 in
770
+
let year_buf = Buffer.create 4 in
771
+
let month_buf = Buffer.create 2 in
772
+
let day_buf = Buffer.create 2 in
773
+
(* Read date part YYYY-MM-DD *)
774
+
for _ = 1 to 4 do
775
+
match peek l with
776
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char year_buf c; advance l
777
+
| _ -> failwith "Invalid date format"
778
+
done;
779
+
if peek l <> Some '-' then failwith "Invalid date format";
780
+
Buffer.add_char buf '-'; advance l;
781
+
for _ = 1 to 2 do
782
+
match peek l with
783
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char month_buf c; advance l
784
+
| _ -> failwith "Invalid date format"
785
+
done;
786
+
if peek l <> Some '-' then failwith "Invalid date format";
787
+
Buffer.add_char buf '-'; advance l;
788
+
for _ = 1 to 2 do
789
+
match peek l with
790
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char day_buf c; advance l
791
+
| _ -> failwith "Invalid date format"
792
+
done;
793
+
(* Validate date immediately *)
794
+
let year = int_of_string (Buffer.contents year_buf) in
795
+
let month = int_of_string (Buffer.contents month_buf) in
796
+
let day = int_of_string (Buffer.contents day_buf) in
797
+
validate_date year month day;
798
+
(* Helper to parse time part (after T or space) *)
799
+
let parse_time_part () =
800
+
let hour_buf = Buffer.create 2 in
801
+
let minute_buf = Buffer.create 2 in
802
+
let second_buf = Buffer.create 2 in
803
+
Buffer.add_char buf 'T'; (* Always normalize to uppercase T *)
804
+
for _ = 1 to 2 do
805
+
match peek l with
806
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char hour_buf c; advance l
807
+
| _ -> failwith "Invalid time format"
808
+
done;
809
+
if peek l <> Some ':' then failwith "Invalid time format";
810
+
Buffer.add_char buf ':'; advance l;
811
+
for _ = 1 to 2 do
812
+
match peek l with
813
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char minute_buf c; advance l
814
+
| _ -> failwith "Invalid time format"
815
+
done;
816
+
(* Optional seconds *)
817
+
(match peek l with
818
+
| Some ':' ->
819
+
Buffer.add_char buf ':'; advance l;
820
+
for _ = 1 to 2 do
821
+
match peek l with
822
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char second_buf c; advance l
823
+
| _ -> failwith "Invalid time format"
824
+
done;
825
+
(* Optional fractional seconds *)
826
+
(match peek l with
827
+
| Some '.' ->
828
+
Buffer.add_char buf '.'; advance l;
829
+
if not (peek l |> Option.map is_digit |> Option.value ~default:false) then
830
+
failwith "Expected digit after decimal point";
831
+
while peek l |> Option.map is_digit |> Option.value ~default:false do
832
+
Buffer.add_char buf (Option.get (peek l));
833
+
advance l
834
+
done
835
+
| _ -> ())
836
+
| _ ->
837
+
(* No seconds - add :00 for normalization per toml-test *)
838
+
Buffer.add_string buf ":00";
839
+
Buffer.add_string second_buf "00");
840
+
(* Validate time *)
841
+
let hour = int_of_string (Buffer.contents hour_buf) in
842
+
let minute = int_of_string (Buffer.contents minute_buf) in
843
+
let second = if Buffer.length second_buf > 0 then int_of_string (Buffer.contents second_buf) else 0 in
844
+
validate_time hour minute second;
845
+
(* Check for offset *)
846
+
match peek l with
847
+
| Some 'Z' | Some 'z' ->
848
+
Buffer.add_char buf 'Z';
849
+
advance l;
850
+
Tok_datetime (Buffer.contents buf)
851
+
| Some '+' | Some '-' as sign_opt ->
852
+
let sign = Option.get sign_opt in
853
+
let off_hour_buf = Buffer.create 2 in
854
+
let off_min_buf = Buffer.create 2 in
855
+
Buffer.add_char buf sign;
856
+
advance l;
857
+
for _ = 1 to 2 do
858
+
match peek l with
859
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char off_hour_buf c; advance l
860
+
| _ -> failwith "Invalid timezone offset"
861
+
done;
862
+
if peek l <> Some ':' then failwith "Invalid timezone offset";
863
+
Buffer.add_char buf ':'; advance l;
864
+
for _ = 1 to 2 do
865
+
match peek l with
866
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char off_min_buf c; advance l
867
+
| _ -> failwith "Invalid timezone offset"
868
+
done;
869
+
(* Validate offset *)
870
+
let off_hour = int_of_string (Buffer.contents off_hour_buf) in
871
+
let off_min = int_of_string (Buffer.contents off_min_buf) in
872
+
validate_offset off_hour off_min;
873
+
Tok_datetime (Buffer.contents buf)
874
+
| _ ->
875
+
Tok_datetime_local (Buffer.contents buf)
876
+
in
877
+
(* Check if there's a time part *)
878
+
match peek l with
879
+
| Some 'T' | Some 't' ->
880
+
advance l;
881
+
parse_time_part ()
882
+
| Some ' ' ->
883
+
(* Space could be followed by time (datetime with space separator)
884
+
or could be end of date (local date followed by comment/value) *)
885
+
advance l; (* Skip the space *)
886
+
(* Check if followed by digit (time) *)
887
+
(match peek l with
888
+
| Some c when is_digit c ->
889
+
parse_time_part ()
890
+
| _ ->
891
+
(* Not followed by time - this is just a local date *)
892
+
(* Put the space back by not consuming anything further *)
893
+
l.pos <- l.pos - 1; (* Go back to before the space *)
894
+
Tok_date_local (Buffer.contents buf))
895
+
| _ ->
896
+
(* Just a date *)
897
+
Tok_date_local (Buffer.contents buf)
898
+
899
+
let parse_time l =
900
+
let buf = Buffer.create 16 in
901
+
let hour_buf = Buffer.create 2 in
902
+
let minute_buf = Buffer.create 2 in
903
+
let second_buf = Buffer.create 2 in
904
+
(* Read HH:MM *)
905
+
for _ = 1 to 2 do
906
+
match peek l with
907
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char hour_buf c; advance l
908
+
| _ -> failwith "Invalid time format"
909
+
done;
910
+
if peek l <> Some ':' then failwith "Invalid time format";
911
+
Buffer.add_char buf ':'; advance l;
912
+
for _ = 1 to 2 do
913
+
match peek l with
914
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char minute_buf c; advance l
915
+
| _ -> failwith "Invalid time format"
916
+
done;
917
+
(* Optional seconds *)
918
+
(match peek l with
919
+
| Some ':' ->
920
+
Buffer.add_char buf ':'; advance l;
921
+
for _ = 1 to 2 do
922
+
match peek l with
923
+
| Some c when is_digit c -> Buffer.add_char buf c; Buffer.add_char second_buf c; advance l
924
+
| _ -> failwith "Invalid time format"
925
+
done;
926
+
(* Optional fractional seconds *)
927
+
(match peek l with
928
+
| Some '.' ->
929
+
Buffer.add_char buf '.'; advance l;
930
+
if not (peek l |> Option.map is_digit |> Option.value ~default:false) then
931
+
failwith "Expected digit after decimal point";
932
+
while peek l |> Option.map is_digit |> Option.value ~default:false do
933
+
Buffer.add_char buf (Option.get (peek l));
934
+
advance l
935
+
done
936
+
| _ -> ())
937
+
| _ ->
938
+
(* No seconds - add :00 for normalization *)
939
+
Buffer.add_string buf ":00";
940
+
Buffer.add_string second_buf "00");
941
+
(* Validate time *)
942
+
let hour = int_of_string (Buffer.contents hour_buf) in
943
+
let minute = int_of_string (Buffer.contents minute_buf) in
944
+
let second = if Buffer.length second_buf > 0 then int_of_string (Buffer.contents second_buf) else 0 in
945
+
validate_time hour minute second;
946
+
Tok_time_local (Buffer.contents buf)
947
+
948
+
let next_token l =
949
+
skip_ws_and_comments l;
950
+
if is_eof l then Tok_eof
951
+
else begin
952
+
let c = get_current l in
953
+
match c with
954
+
| '[' -> advance l; Tok_lbracket
955
+
| ']' -> advance l; Tok_rbracket
956
+
| '{' -> advance l; Tok_lbrace
957
+
| '}' -> advance l; Tok_rbrace
958
+
| '=' -> advance l; Tok_equals
959
+
| ',' -> advance l; Tok_comma
960
+
| '.' -> advance l; Tok_dot
961
+
| '\n' -> advance l; Tok_newline
962
+
| '\r' ->
963
+
advance l;
964
+
if peek l = Some '\n' then begin
965
+
advance l;
966
+
Tok_newline
967
+
end else
968
+
failwith (Printf.sprintf "Bare carriage return not allowed at line %d" l.line)
969
+
| '"' ->
970
+
let (s, multiline) = parse_basic_string l in
971
+
if multiline then Tok_ml_basic_string s else Tok_basic_string s
972
+
| '\'' ->
973
+
let (s, multiline) = parse_literal_string l in
974
+
if multiline then Tok_ml_literal_string s else Tok_literal_string s
975
+
| '+' | '-' ->
976
+
(* Could be number, special float (+inf, -inf, +nan, -nan), or bare key starting with - *)
977
+
let sign = c in
978
+
let start = l.pos in
979
+
(match peek2 l with
980
+
| Some d when is_digit d ->
981
+
(* Check if this looks like a key (followed by = after whitespace/key chars) *)
982
+
(* A key like -01 should be followed by whitespace then =, not by . or e (number syntax) *)
983
+
let is_key_context =
984
+
let rec scan_ahead p =
985
+
if p >= l.input_len then false
986
+
else
987
+
let c = get_char l p in
988
+
if is_digit c || c = '_' then scan_ahead (p + 1)
989
+
else if c = ' ' || c = '\t' then
990
+
(* Skip whitespace and check for = *)
991
+
let rec skip_ws pp =
992
+
if pp >= l.input_len then false
993
+
else match get_char l pp with
994
+
| ' ' | '\t' -> skip_ws (pp + 1)
995
+
| '=' -> true
996
+
| _ -> false
997
+
in
998
+
skip_ws (p + 1)
999
+
else if c = '=' then true
1000
+
else if c = '.' then
1001
+
(* Check if . is followed by digit (number) vs letter/underscore (dotted key) *)
1002
+
if p + 1 < l.input_len then
1003
+
let next = get_char l (p + 1) in
1004
+
if is_digit next then false (* It's a decimal number like -3.14 *)
1005
+
else if is_bare_key_char next then true (* Dotted key *)
1006
+
else false
1007
+
else false
1008
+
else if c = 'e' || c = 'E' then false (* Scientific notation *)
1009
+
else if is_bare_key_char c then
1010
+
(* Contains non-digit bare key char - it's a key *)
1011
+
true
1012
+
else false
1013
+
in
1014
+
scan_ahead (start + 1)
1015
+
in
1016
+
if is_key_context then begin
1017
+
(* Treat as bare key *)
1018
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1019
+
advance l
1020
+
done;
1021
+
Tok_bare_key (sub_string l start (l.pos - start))
1022
+
end else
1023
+
parse_number l
1024
+
| Some 'i' ->
1025
+
(* Check for inf *)
1026
+
if l.pos + 3 < l.input_len &&
1027
+
get_char l (l.pos + 1) = 'i' && get_char l (l.pos + 2) = 'n' && get_char l (l.pos + 3) = 'f' then begin
1028
+
advance_n l 4;
1029
+
let s = sub_string l start (l.pos - start) in
1030
+
if sign = '-' then Tok_float (Float.neg_infinity, s)
1031
+
else Tok_float (Float.infinity, s)
1032
+
end else if sign = '-' then begin
1033
+
(* Could be bare key like -inf-key *)
1034
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1035
+
advance l
1036
+
done;
1037
+
Tok_bare_key (sub_string l start (l.pos - start))
1038
+
end else
1039
+
failwith (Printf.sprintf "Unexpected character after %c" sign)
1040
+
| Some 'n' ->
1041
+
(* Check for nan *)
1042
+
if l.pos + 3 < l.input_len &&
1043
+
get_char l (l.pos + 1) = 'n' && get_char l (l.pos + 2) = 'a' && get_char l (l.pos + 3) = 'n' then begin
1044
+
advance_n l 4;
1045
+
let s = sub_string l start (l.pos - start) in
1046
+
Tok_float (Float.nan, s) (* Sign on NaN doesn't change the value *)
1047
+
end else if sign = '-' then begin
1048
+
(* Could be bare key like -name *)
1049
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1050
+
advance l
1051
+
done;
1052
+
Tok_bare_key (sub_string l start (l.pos - start))
1053
+
end else
1054
+
failwith (Printf.sprintf "Unexpected character after %c" sign)
1055
+
| _ when sign = '-' ->
1056
+
(* Bare key starting with - like -key or --- *)
1057
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1058
+
advance l
1059
+
done;
1060
+
Tok_bare_key (sub_string l start (l.pos - start))
1061
+
| _ -> failwith (Printf.sprintf "Unexpected character after %c" sign))
1062
+
| c when is_digit c ->
1063
+
(* Could be number, datetime, or bare key starting with digits *)
1064
+
(match looks_like_datetime l with
1065
+
| `Date -> parse_datetime l
1066
+
| `Time -> parse_time l
1067
+
| `Other ->
1068
+
(* Check for hex/octal/binary prefix first - these are always numbers *)
1069
+
let start = l.pos in
1070
+
let is_prefixed_number =
1071
+
start + 1 < l.input_len && get_char l start = '0' &&
1072
+
(let c1 = get_char l (start + 1) in
1073
+
c1 = 'x' || c1 = 'X' || c1 = 'o' || c1 = 'O' || c1 = 'b' || c1 = 'B')
1074
+
in
1075
+
if is_prefixed_number then
1076
+
parse_number l
1077
+
else begin
1078
+
(* Check if this is a bare key:
1079
+
- Contains letters (like "123abc")
1080
+
- Has leading zeros (like "0123") which would be invalid as a number *)
1081
+
let has_leading_zero =
1082
+
get_char l start = '0' && start + 1 < l.input_len &&
1083
+
let c1 = get_char l (start + 1) in
1084
+
is_digit c1
1085
+
in
1086
+
(* Scan to see if this is a bare key or a number
1087
+
- If it looks like scientific notation (digits + e/E + optional sign + digits), it's a number
1088
+
- If it contains letters OR dashes between digits, it's a bare key *)
1089
+
let rec scan_for_bare_key pos has_dash_between_digits =
1090
+
if pos >= l.input_len then has_dash_between_digits
1091
+
else
1092
+
let c = get_char l pos in
1093
+
if is_digit c || c = '_' then scan_for_bare_key (pos + 1) has_dash_between_digits
1094
+
else if c = '.' then scan_for_bare_key (pos + 1) has_dash_between_digits
1095
+
else if c = '-' then
1096
+
(* Dash in key - check what follows *)
1097
+
let next_pos = pos + 1 in
1098
+
if next_pos < l.input_len then
1099
+
let next = get_char l next_pos in
1100
+
if is_digit next then
1101
+
scan_for_bare_key (next_pos) true (* Dash between digits - bare key *)
1102
+
else if is_bare_key_char next then
1103
+
true (* Dash followed by letter - definitely bare key like 2000-datetime *)
1104
+
else
1105
+
has_dash_between_digits (* End of sequence *)
1106
+
else
1107
+
has_dash_between_digits (* End of input *)
1108
+
else if c = 'e' || c = 'E' then
1109
+
(* Check if this looks like scientific notation *)
1110
+
let next_pos = pos + 1 in
1111
+
if next_pos >= l.input_len then true (* Just 'e' at end, bare key *)
1112
+
else
1113
+
let next = get_char l next_pos in
1114
+
if next = '+' || next = '-' then
1115
+
(* Has exponent sign - check if followed by digit *)
1116
+
let after_sign = next_pos + 1 in
1117
+
if after_sign < l.input_len && is_digit (get_char l after_sign) then
1118
+
has_dash_between_digits (* Scientific notation, but might have dash earlier *)
1119
+
else
1120
+
true (* e.g., "3e-abc" - bare key *)
1121
+
else if is_digit next then
1122
+
has_dash_between_digits (* Scientific notation like 3e2, but check if had dash earlier *)
1123
+
else
1124
+
true (* e.g., "3eabc" - bare key *)
1125
+
else if is_bare_key_char c then
1126
+
(* It's a letter - this is a bare key *)
1127
+
true
1128
+
else has_dash_between_digits
1129
+
in
1130
+
if has_leading_zero || scan_for_bare_key start false then begin
1131
+
(* It's a bare key *)
1132
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1133
+
advance l
1134
+
done;
1135
+
Tok_bare_key (sub_string l start (l.pos - start))
1136
+
end else
1137
+
(* It's a number - use parse_number *)
1138
+
parse_number l
1139
+
end)
1140
+
| c when c = 't' || c = 'f' || c = 'i' || c = 'n' ->
1141
+
(* These could be keywords (true, false, inf, nan) or bare keys
1142
+
Always read as bare key and let parser interpret *)
1143
+
let start = l.pos in
1144
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1145
+
advance l
1146
+
done;
1147
+
Tok_bare_key (sub_string l start (l.pos - start))
1148
+
| c when is_bare_key_char c ->
1149
+
let start = l.pos in
1150
+
while not (is_eof l) && is_bare_key_char (get_current l) do
1151
+
advance l
1152
+
done;
1153
+
Tok_bare_key (sub_string l start (l.pos - start))
1154
+
| c ->
1155
+
let code = Char.code c in
1156
+
if code < 0x20 || code = 0x7F then
1157
+
failwith (Printf.sprintf "Control character U+%04X not allowed at line %d" code l.line)
1158
+
else
1159
+
failwith (Printf.sprintf "Unexpected character '%c' at line %d, column %d" c l.line l.col)
1160
+
end
1161
+
1162
+
(* Parser *)
1163
+
1164
+
type parser = {
1165
+
lexer : lexer;
1166
+
mutable current : token;
1167
+
mutable peeked : bool;
1168
+
}
1169
+
1170
+
let make_parser lexer =
1171
+
{ lexer; current = Tok_eof; peeked = false }
1172
+
1173
+
let peek_token p =
1174
+
if not p.peeked then begin
1175
+
p.current <- next_token p.lexer;
1176
+
p.peeked <- true
1177
+
end;
1178
+
p.current
1179
+
1180
+
let consume_token p =
1181
+
let tok = peek_token p in
1182
+
p.peeked <- false;
1183
+
tok
1184
+
1185
+
(* Check if next raw character (without skipping whitespace) matches *)
1186
+
let next_raw_char_is p c =
1187
+
p.lexer.pos < p.lexer.input_len && get_char p.lexer p.lexer.pos = c
1188
+
1189
+
let expect_token p expected =
1190
+
let tok = consume_token p in
1191
+
if tok <> expected then
1192
+
failwith (Printf.sprintf "Expected %s" (match expected with
1193
+
| Tok_equals -> "="
1194
+
| Tok_rbracket -> "]"
1195
+
| Tok_rbrace -> "}"
1196
+
| Tok_newline -> "newline"
1197
+
| _ -> "token"))
1198
+
1199
+
let skip_newlines p =
1200
+
while peek_token p = Tok_newline do
1201
+
ignore (consume_token p)
1202
+
done
1203
+
1204
+
(* Parse a single key segment (bare, basic string, literal string, or integer) *)
1205
+
(* Note: Tok_float is handled specially in parse_dotted_key *)
1206
+
let parse_key_segment p =
1207
+
match peek_token p with
1208
+
| Tok_bare_key s -> ignore (consume_token p); [s]
1209
+
| Tok_basic_string s -> ignore (consume_token p); [s]
1210
+
| Tok_literal_string s -> ignore (consume_token p); [s]
1211
+
| Tok_integer (_i, orig_str) -> ignore (consume_token p); [orig_str]
1212
+
| Tok_float (f, orig_str) ->
1213
+
(* Float in key context - use original string to preserve exact key parts *)
1214
+
ignore (consume_token p);
1215
+
if Float.is_nan f then ["nan"]
1216
+
else if f = Float.infinity then ["inf"]
1217
+
else if f = Float.neg_infinity then ["-inf"]
1218
+
else begin
1219
+
(* Remove underscores from original string and split on dot *)
1220
+
let s = String.concat "" (String.split_on_char '_' orig_str) in
1221
+
if String.contains s 'e' || String.contains s 'E' then
1222
+
(* Has exponent, treat as single key *)
1223
+
[s]
1224
+
else if String.contains s '.' then
1225
+
(* Split on decimal point for dotted key *)
1226
+
String.split_on_char '.' s
1227
+
else
1228
+
(* No decimal point, single integer key *)
1229
+
[s]
1230
+
end
1231
+
| Tok_date_local s -> ignore (consume_token p); [s]
1232
+
| Tok_datetime s -> ignore (consume_token p); [s]
1233
+
| Tok_datetime_local s -> ignore (consume_token p); [s]
1234
+
| Tok_time_local s -> ignore (consume_token p); [s]
1235
+
| Tok_ml_basic_string _ -> failwith "Multiline strings are not allowed as keys"
1236
+
| Tok_ml_literal_string _ -> failwith "Multiline strings are not allowed as keys"
1237
+
| _ -> failwith "Expected key"
1238
+
1239
+
(* Parse a dotted key - returns list of key strings *)
1240
+
let parse_dotted_key p =
1241
+
let first_keys = parse_key_segment p in
1242
+
let rec loop acc =
1243
+
match peek_token p with
1244
+
| Tok_dot ->
1245
+
ignore (consume_token p);
1246
+
let keys = parse_key_segment p in
1247
+
loop (List.rev_append keys acc)
1248
+
| _ -> List.rev acc
1249
+
in
1250
+
let rest = loop [] in
1251
+
first_keys @ rest
1252
+
1253
+
let rec parse_value p =
1254
+
match peek_token p with
1255
+
| Tok_basic_string s -> ignore (consume_token p); Toml.String s
1256
+
| Tok_literal_string s -> ignore (consume_token p); Toml.String s
1257
+
| Tok_ml_basic_string s -> ignore (consume_token p); Toml.String s
1258
+
| Tok_ml_literal_string s -> ignore (consume_token p); Toml.String s
1259
+
| Tok_integer (i, _) -> ignore (consume_token p); Toml.Int i
1260
+
| Tok_float (f, _) -> ignore (consume_token p); Toml.Float f
1261
+
| Tok_datetime s -> ignore (consume_token p); Toml.Datetime s
1262
+
| Tok_datetime_local s -> ignore (consume_token p); Toml.Datetime_local s
1263
+
| Tok_date_local s -> ignore (consume_token p); Toml.Date_local s
1264
+
| Tok_time_local s -> ignore (consume_token p); Toml.Time_local s
1265
+
| Tok_lbracket -> parse_array p
1266
+
| Tok_lbrace -> parse_inline_table p
1267
+
| Tok_bare_key s ->
1268
+
(* Interpret bare keys as boolean, float keywords, or numbers in value context *)
1269
+
ignore (consume_token p);
1270
+
(match s with
1271
+
| "true" -> Bool true
1272
+
| "false" -> Bool false
1273
+
| "inf" -> Float Float.infinity
1274
+
| "nan" -> Float Float.nan
1275
+
| _ ->
1276
+
(* Validate underscore placement in the original string *)
1277
+
let validate_underscores str =
1278
+
let len = String.length str in
1279
+
if len > 0 && str.[0] = '_' then
1280
+
failwith "Leading underscore not allowed in number";
1281
+
if len > 0 && str.[len - 1] = '_' then
1282
+
failwith "Trailing underscore not allowed in number";
1283
+
for i = 0 to len - 2 do
1284
+
if str.[i] = '_' && str.[i + 1] = '_' then
1285
+
failwith "Double underscore not allowed in number";
1286
+
(* Underscore must be between digits (not next to 'e', 'E', '.', 'x', 'o', 'b', etc.) *)
1287
+
if str.[i] = '_' then begin
1288
+
let prev = if i > 0 then Some str.[i - 1] else None in
1289
+
let next = Some str.[i + 1] in
1290
+
let is_digit_char c = c >= '0' && c <= '9' in
1291
+
let is_hex_char c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') in
1292
+
(* For hex numbers, underscore can be between hex digits *)
1293
+
let has_hex_prefix = len > 2 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') in
1294
+
match prev, next with
1295
+
| Some p, Some n when has_hex_prefix && is_hex_char p && is_hex_char n -> ()
1296
+
| Some p, Some n when is_digit_char p && is_digit_char n -> ()
1297
+
| _ -> failwith "Underscore must be between digits"
1298
+
end
1299
+
done
1300
+
in
1301
+
validate_underscores s;
1302
+
(* Try to parse as a number - bare keys like "10e3" should be floats *)
1303
+
let s_no_underscore = String.concat "" (String.split_on_char '_' s) in
1304
+
let len = String.length s_no_underscore in
1305
+
if len > 0 then
1306
+
let c0 = s_no_underscore.[0] in
1307
+
(* Must start with digit for it to be a number in value context *)
1308
+
if c0 >= '0' && c0 <= '9' then begin
1309
+
(* Check for leading zeros *)
1310
+
if len > 1 && c0 = '0' && s_no_underscore.[1] >= '0' && s_no_underscore.[1] <= '9' then
1311
+
failwith "Leading zeros not allowed"
1312
+
else
1313
+
try
1314
+
(* Try to parse as float (handles scientific notation) *)
1315
+
if String.contains s_no_underscore '.' ||
1316
+
String.contains s_no_underscore 'e' ||
1317
+
String.contains s_no_underscore 'E' then
1318
+
Toml.Float (float_of_string s_no_underscore)
1319
+
else
1320
+
Toml.Int (Int64.of_string s_no_underscore)
1321
+
with _ ->
1322
+
failwith (Printf.sprintf "Unexpected bare key '%s' as value" s)
1323
+
end else
1324
+
failwith (Printf.sprintf "Unexpected bare key '%s' as value" s)
1325
+
else
1326
+
failwith (Printf.sprintf "Unexpected bare key '%s' as value" s))
1327
+
| _ -> failwith "Expected value"
1328
+
1329
+
and parse_array p =
1330
+
ignore (consume_token p); (* [ *)
1331
+
skip_newlines p;
1332
+
let rec loop acc =
1333
+
match peek_token p with
1334
+
| Tok_rbracket ->
1335
+
ignore (consume_token p);
1336
+
Toml.Array (List.rev acc)
1337
+
| _ ->
1338
+
let v = parse_value p in
1339
+
skip_newlines p;
1340
+
match peek_token p with
1341
+
| Tok_comma ->
1342
+
ignore (consume_token p);
1343
+
skip_newlines p;
1344
+
loop (v :: acc)
1345
+
| Tok_rbracket ->
1346
+
ignore (consume_token p);
1347
+
Toml.Array (List.rev (v :: acc))
1348
+
| _ -> failwith "Expected ',' or ']' in array"
1349
+
in
1350
+
loop []
1351
+
1352
+
and parse_inline_table p =
1353
+
ignore (consume_token p); (* { *)
1354
+
skip_newlines p;
1355
+
(* Track explicitly defined keys - can't be extended with dotted keys *)
1356
+
let defined_inline = ref [] in
1357
+
let rec loop acc =
1358
+
match peek_token p with
1359
+
| Tok_rbrace ->
1360
+
ignore (consume_token p);
1361
+
Toml.Table (List.rev acc)
1362
+
| _ ->
1363
+
let keys = parse_dotted_key p in
1364
+
skip_ws p;
1365
+
expect_token p Tok_equals;
1366
+
skip_ws p;
1367
+
let v = parse_value p in
1368
+
(* Check if trying to extend a previously-defined inline table *)
1369
+
(match keys with
1370
+
| first_key :: _ :: _ ->
1371
+
(* Multi-key dotted path - check if first key is already defined *)
1372
+
if List.mem first_key !defined_inline then
1373
+
failwith (Printf.sprintf "Cannot extend inline table '%s' with dotted key" first_key)
1374
+
| _ -> ());
1375
+
(* If this is a direct assignment to a key, track it *)
1376
+
(match keys with
1377
+
| [k] ->
1378
+
if List.mem k !defined_inline then
1379
+
failwith (Printf.sprintf "Duplicate key '%s' in inline table" k);
1380
+
defined_inline := k :: !defined_inline
1381
+
| _ -> ());
1382
+
let entry = build_nested_table keys v in
1383
+
(* Merge the entry with existing entries (for dotted keys with common prefix) *)
1384
+
let acc = merge_entry_into_table acc entry in
1385
+
skip_newlines p;
1386
+
match peek_token p with
1387
+
| Tok_comma ->
1388
+
ignore (consume_token p);
1389
+
skip_newlines p;
1390
+
loop acc
1391
+
| Tok_rbrace ->
1392
+
ignore (consume_token p);
1393
+
Toml.Table (List.rev acc)
1394
+
| _ -> failwith "Expected ',' or '}' in inline table"
1395
+
in
1396
+
loop []
1397
+
1398
+
and skip_ws _p =
1399
+
(* Skip whitespace in token stream - handled by lexer but needed for lookahead *)
1400
+
()
1401
+
1402
+
and build_nested_table keys value =
1403
+
match keys with
1404
+
| [] -> failwith "Empty key"
1405
+
| [k] -> (k, value)
1406
+
| k :: rest ->
1407
+
(k, Toml.Table [build_nested_table rest value])
1408
+
1409
+
(* Merge two TOML values - used for combining dotted keys in inline tables *)
1410
+
and merge_toml_values v1 v2 =
1411
+
match v1, v2 with
1412
+
| Toml.Table entries1, Toml.Table entries2 ->
1413
+
(* Merge the entries *)
1414
+
let merged = List.fold_left (fun acc (k, v) ->
1415
+
match List.assoc_opt k acc with
1416
+
| Some existing ->
1417
+
(* Key exists - try to merge if both are tables *)
1418
+
let merged_v = merge_toml_values existing v in
1419
+
(k, merged_v) :: List.remove_assoc k acc
1420
+
| None ->
1421
+
(k, v) :: acc
1422
+
) entries1 entries2 in
1423
+
Toml.Table (List.rev merged)
1424
+
| _, _ ->
1425
+
(* Can't merge non-table values with same key *)
1426
+
failwith "Conflicting keys in inline table"
1427
+
1428
+
(* Merge a single entry into an existing table *)
1429
+
and merge_entry_into_table entries (k, v) =
1430
+
match List.assoc_opt k entries with
1431
+
| Some existing ->
1432
+
let merged_v = merge_toml_values existing v in
1433
+
(k, merged_v) :: List.remove_assoc k entries
1434
+
| None ->
1435
+
(k, v) :: entries
1436
+
1437
+
let validate_datetime_string s =
1438
+
(* Parse and validate date portion *)
1439
+
if String.length s >= 10 then begin
1440
+
let year = int_of_string (String.sub s 0 4) in
1441
+
let month = int_of_string (String.sub s 5 2) in
1442
+
let day = int_of_string (String.sub s 8 2) in
1443
+
validate_date year month day;
1444
+
(* Parse and validate time portion if present *)
1445
+
if String.length s >= 16 then begin
1446
+
let time_start = if s.[10] = 'T' || s.[10] = 't' || s.[10] = ' ' then 11 else 10 in
1447
+
let hour = int_of_string (String.sub s time_start 2) in
1448
+
let minute = int_of_string (String.sub s (time_start + 3) 2) in
1449
+
let second =
1450
+
if String.length s >= time_start + 8 && s.[time_start + 5] = ':' then
1451
+
int_of_string (String.sub s (time_start + 6) 2)
1452
+
else 0
1453
+
in
1454
+
validate_time hour minute second
1455
+
end
1456
+
end
1457
+
1458
+
let validate_date_string s =
1459
+
if String.length s >= 10 then begin
1460
+
let year = int_of_string (String.sub s 0 4) in
1461
+
let month = int_of_string (String.sub s 5 2) in
1462
+
let day = int_of_string (String.sub s 8 2) in
1463
+
validate_date year month day
1464
+
end
1465
+
1466
+
let validate_time_string s =
1467
+
if String.length s >= 5 then begin
1468
+
let hour = int_of_string (String.sub s 0 2) in
1469
+
let minute = int_of_string (String.sub s 3 2) in
1470
+
let second =
1471
+
if String.length s >= 8 && s.[5] = ':' then
1472
+
int_of_string (String.sub s 6 2)
1473
+
else 0
1474
+
in
1475
+
validate_time hour minute second
1476
+
end
1477
+
1478
+
(* Table management for the parser *)
1479
+
type table_state = {
1480
+
mutable values : (string * Toml.t) list;
1481
+
subtables : (string, table_state) Hashtbl.t;
1482
+
mutable is_array : bool;
1483
+
mutable is_inline : bool;
1484
+
mutable defined : bool; (* Has this table been explicitly defined with [table]? *)
1485
+
mutable closed : bool; (* Closed to extension via dotted keys from parent *)
1486
+
mutable array_elements : table_state list; (* For arrays of tables *)
1487
+
}
1488
+
1489
+
let create_table_state () = {
1490
+
values = [];
1491
+
subtables = Hashtbl.create 16;
1492
+
is_array = false;
1493
+
is_inline = false;
1494
+
defined = false;
1495
+
closed = false;
1496
+
array_elements = [];
1497
+
}
1498
+
1499
+
let rec get_or_create_table state keys create_intermediate =
1500
+
match keys with
1501
+
| [] -> state
1502
+
| [k] ->
1503
+
(* Check if key exists as a value *)
1504
+
if List.mem_assoc k state.values then
1505
+
failwith (Printf.sprintf "Cannot use value '%s' as a table" k);
1506
+
(match Hashtbl.find_opt state.subtables k with
1507
+
| Some sub -> sub
1508
+
| None ->
1509
+
let sub = create_table_state () in
1510
+
Hashtbl.add state.subtables k sub;
1511
+
sub)
1512
+
| k :: rest ->
1513
+
(* Check if key exists as a value *)
1514
+
if List.mem_assoc k state.values then
1515
+
failwith (Printf.sprintf "Cannot use value '%s' as a table" k);
1516
+
let sub = match Hashtbl.find_opt state.subtables k with
1517
+
| Some sub -> sub
1518
+
| None ->
1519
+
let sub = create_table_state () in
1520
+
Hashtbl.add state.subtables k sub;
1521
+
sub
1522
+
in
1523
+
if create_intermediate && not sub.defined then
1524
+
sub.defined <- false; (* Mark as implicitly defined *)
1525
+
get_or_create_table sub rest create_intermediate
1526
+
1527
+
(* Like get_or_create_table but marks tables as defined (for dotted keys) *)
1528
+
(* Dotted keys mark tables as "defined" (can't re-define with [table]) but not "closed" *)
1529
+
let rec get_or_create_table_for_dotted_key state keys =
1530
+
match keys with
1531
+
| [] -> state
1532
+
| [k] ->
1533
+
(* Check if key exists as a value *)
1534
+
if List.mem_assoc k state.values then
1535
+
failwith (Printf.sprintf "Cannot use value '%s' as a table" k);
1536
+
(match Hashtbl.find_opt state.subtables k with
1537
+
| Some sub ->
1538
+
(* Check if it's an array of tables (can't extend with dotted keys) *)
1539
+
if sub.is_array then
1540
+
failwith (Printf.sprintf "Cannot extend array of tables '%s' using dotted keys" k);
1541
+
(* Check if it's closed (explicitly defined with [table] header) *)
1542
+
if sub.closed then
1543
+
failwith (Printf.sprintf "Cannot extend table '%s' using dotted keys" k);
1544
+
if sub.is_inline then
1545
+
failwith (Printf.sprintf "Cannot extend inline table '%s'" k);
1546
+
(* Mark as defined by dotted key *)
1547
+
sub.defined <- true;
1548
+
sub
1549
+
| None ->
1550
+
let sub = create_table_state () in
1551
+
sub.defined <- true; (* Mark as defined by dotted key *)
1552
+
Hashtbl.add state.subtables k sub;
1553
+
sub)
1554
+
| k :: rest ->
1555
+
(* Check if key exists as a value *)
1556
+
if List.mem_assoc k state.values then
1557
+
failwith (Printf.sprintf "Cannot use value '%s' as a table" k);
1558
+
let sub = match Hashtbl.find_opt state.subtables k with
1559
+
| Some sub ->
1560
+
(* Check if it's an array of tables (can't extend with dotted keys) *)
1561
+
if sub.is_array then
1562
+
failwith (Printf.sprintf "Cannot extend array of tables '%s' using dotted keys" k);
1563
+
if sub.closed then
1564
+
failwith (Printf.sprintf "Cannot extend table '%s' using dotted keys" k);
1565
+
if sub.is_inline then
1566
+
failwith (Printf.sprintf "Cannot extend inline table '%s'" k);
1567
+
(* Mark as defined by dotted key *)
1568
+
sub.defined <- true;
1569
+
sub
1570
+
| None ->
1571
+
let sub = create_table_state () in
1572
+
sub.defined <- true; (* Mark as defined by dotted key *)
1573
+
Hashtbl.add state.subtables k sub;
1574
+
sub
1575
+
in
1576
+
get_or_create_table_for_dotted_key sub rest
1577
+
1578
+
let rec table_state_to_toml state =
1579
+
let subtable_values = Hashtbl.fold (fun k sub acc ->
1580
+
let v =
1581
+
if sub.is_array then
1582
+
Toml.Array (List.map table_state_to_toml (get_array_elements sub))
1583
+
else
1584
+
table_state_to_toml sub
1585
+
in
1586
+
(k, v) :: acc
1587
+
) state.subtables [] in
1588
+
Toml.Table (List.rev state.values @ subtable_values)
1589
+
1590
+
and get_array_elements state =
1591
+
List.rev state.array_elements
1592
+
1593
+
(* Main parser function *)
1594
+
let parse_toml_from_lexer lexer =
1595
+
let parser = make_parser lexer in
1596
+
let root = create_table_state () in
1597
+
let current_table = ref root in
1598
+
(* Stack of array contexts: (full_path, parent_state, array_container) *)
1599
+
(* parent_state is where the array lives, array_container is the array table itself *)
1600
+
let array_context_stack = ref ([] : (string list * table_state * table_state) list) in
1601
+
1602
+
(* Check if keys has a prefix matching the given path *)
1603
+
let rec has_prefix keys prefix =
1604
+
match keys, prefix with
1605
+
| _, [] -> true
1606
+
| [], _ -> false
1607
+
| k :: krest, p :: prest -> k = p && has_prefix krest prest
1608
+
in
1609
+
1610
+
(* Remove prefix from keys *)
1611
+
let rec remove_prefix keys prefix =
1612
+
match keys, prefix with
1613
+
| ks, [] -> ks
1614
+
| [], _ -> []
1615
+
| _ :: krest, _ :: prest -> remove_prefix krest prest
1616
+
in
1617
+
1618
+
(* Find matching array context for the given keys *)
1619
+
let find_array_context keys =
1620
+
(* Stack is newest-first, so first match is the innermost (longest) prefix *)
1621
+
let rec find stack =
1622
+
match stack with
1623
+
| [] -> None
1624
+
| (path, parent, container) :: rest ->
1625
+
if keys = path then
1626
+
(* Exact match - adding sibling element *)
1627
+
Some (`Sibling (path, parent, container))
1628
+
else if has_prefix keys path && List.length keys > List.length path then
1629
+
(* Proper prefix - nested table/array within current element *)
1630
+
let current_entry = List.hd container.array_elements in
1631
+
Some (`Nested (path, current_entry))
1632
+
else
1633
+
find rest
1634
+
in
1635
+
find !array_context_stack
1636
+
in
1637
+
1638
+
(* Pop array contexts that are no longer valid for the given keys *)
1639
+
let rec pop_invalid_contexts keys =
1640
+
match !array_context_stack with
1641
+
| [] -> ()
1642
+
| (path, _, _) :: rest ->
1643
+
if not (has_prefix keys path) then begin
1644
+
array_context_stack := rest;
1645
+
pop_invalid_contexts keys
1646
+
end
1647
+
in
1648
+
1649
+
let rec parse_document () =
1650
+
skip_newlines parser;
1651
+
match peek_token parser with
1652
+
| Tok_eof -> ()
1653
+
| Tok_lbracket ->
1654
+
(* Check for array of tables [[...]] vs table [...] *)
1655
+
ignore (consume_token parser);
1656
+
(* For [[, the two brackets must be adjacent (no whitespace) *)
1657
+
let is_adjacent_bracket = next_raw_char_is parser '[' in
1658
+
(match peek_token parser with
1659
+
| Tok_lbracket when not is_adjacent_bracket ->
1660
+
(* The next [ was found after whitespace - this is invalid syntax like [ [table]] *)
1661
+
failwith "Invalid table header syntax"
1662
+
| Tok_lbracket ->
1663
+
(* Array of tables - brackets are adjacent *)
1664
+
ignore (consume_token parser);
1665
+
let keys = parse_dotted_key parser in
1666
+
expect_token parser Tok_rbracket;
1667
+
(* Check that closing ]] are adjacent (no whitespace) *)
1668
+
if not (next_raw_char_is parser ']') then
1669
+
failwith "Invalid array of tables syntax (space in ]])";
1670
+
expect_token parser Tok_rbracket;
1671
+
skip_to_newline parser;
1672
+
(* Pop contexts that are no longer valid for these keys *)
1673
+
pop_invalid_contexts keys;
1674
+
(* Check array context for this path *)
1675
+
(match find_array_context keys with
1676
+
| Some (`Sibling (path, _parent, container)) ->
1677
+
(* Adding another element to an existing array *)
1678
+
let new_entry = create_table_state () in
1679
+
container.array_elements <- new_entry :: container.array_elements;
1680
+
current_table := new_entry;
1681
+
(* Update the stack entry with new current element (by re-adding) *)
1682
+
array_context_stack := List.map (fun (p, par, cont) ->
1683
+
if p = path then (p, par, cont) else (p, par, cont)
1684
+
) !array_context_stack
1685
+
| Some (`Nested (parent_path, parent_entry)) ->
1686
+
(* Sub-array within current array element *)
1687
+
let relative_keys = remove_prefix keys parent_path in
1688
+
let array_table = get_or_create_table parent_entry relative_keys true in
1689
+
(* Check if trying to convert a non-array table to array *)
1690
+
if array_table.defined && not array_table.is_array then
1691
+
failwith (Printf.sprintf "Cannot define '%s' as array of tables; already defined as table" (String.concat "." keys));
1692
+
if (array_table.values <> [] || Hashtbl.length array_table.subtables > 0) && not array_table.is_array then
1693
+
failwith (Printf.sprintf "Cannot define '%s' as array of tables; already has content" (String.concat "." keys));
1694
+
array_table.is_array <- true;
1695
+
let new_entry = create_table_state () in
1696
+
array_table.array_elements <- new_entry :: array_table.array_elements;
1697
+
current_table := new_entry;
1698
+
(* Push new context for the nested array *)
1699
+
array_context_stack := (keys, parent_entry, array_table) :: !array_context_stack
1700
+
| None ->
1701
+
(* Top-level array *)
1702
+
let array_table = get_or_create_table root keys true in
1703
+
(* Check if trying to convert a non-array table to array *)
1704
+
if array_table.defined && not array_table.is_array then
1705
+
failwith (Printf.sprintf "Cannot define '%s' as array of tables; already defined as table" (String.concat "." keys));
1706
+
if (array_table.values <> [] || Hashtbl.length array_table.subtables > 0) && not array_table.is_array then
1707
+
failwith (Printf.sprintf "Cannot define '%s' as array of tables; already has content" (String.concat "." keys));
1708
+
array_table.is_array <- true;
1709
+
let entry = create_table_state () in
1710
+
array_table.array_elements <- entry :: array_table.array_elements;
1711
+
current_table := entry;
1712
+
(* Push context for this array *)
1713
+
array_context_stack := (keys, root, array_table) :: !array_context_stack);
1714
+
parse_document ()
1715
+
| _ ->
1716
+
(* Regular table *)
1717
+
let keys = parse_dotted_key parser in
1718
+
expect_token parser Tok_rbracket;
1719
+
skip_to_newline parser;
1720
+
(* Pop contexts that are no longer valid for these keys *)
1721
+
pop_invalid_contexts keys;
1722
+
(* Check if this table is relative to a current array element *)
1723
+
(match find_array_context keys with
1724
+
| Some (`Nested (parent_path, parent_entry)) ->
1725
+
let relative_keys = remove_prefix keys parent_path in
1726
+
if relative_keys <> [] then begin
1727
+
let table = get_or_create_table parent_entry relative_keys true in
1728
+
if table.is_array then
1729
+
failwith (Printf.sprintf "Cannot define '%s' as table; already defined as array of tables" (String.concat "." keys));
1730
+
if table.defined then
1731
+
failwith (Printf.sprintf "Table '%s' already defined" (String.concat "." keys));
1732
+
table.defined <- true;
1733
+
table.closed <- true; (* Can't extend via dotted keys from parent *)
1734
+
current_table := table
1735
+
end else begin
1736
+
(* Keys equal parent_path - shouldn't happen for regular tables *)
1737
+
let table = get_or_create_table root keys true in
1738
+
if table.is_array then
1739
+
failwith (Printf.sprintf "Cannot define '%s' as table; already defined as array of tables" (String.concat "." keys));
1740
+
if table.defined then
1741
+
failwith (Printf.sprintf "Table '%s' already defined" (String.concat "." keys));
1742
+
table.defined <- true;
1743
+
table.closed <- true; (* Can't extend via dotted keys from parent *)
1744
+
current_table := table
1745
+
end
1746
+
| Some (`Sibling (_, _, container)) ->
1747
+
(* Exact match to an array of tables path - can't define as regular table *)
1748
+
if container.is_array then
1749
+
failwith (Printf.sprintf "Cannot define '%s' as table; already defined as array of tables" (String.concat "." keys));
1750
+
(* Shouldn't reach here normally *)
1751
+
let table = get_or_create_table root keys true in
1752
+
if table.defined then
1753
+
failwith (Printf.sprintf "Table '%s' already defined" (String.concat "." keys));
1754
+
table.defined <- true;
1755
+
table.closed <- true;
1756
+
current_table := table
1757
+
| None ->
1758
+
(* Not in an array context *)
1759
+
let table = get_or_create_table root keys true in
1760
+
if table.is_array then
1761
+
failwith (Printf.sprintf "Cannot define '%s' as table; already defined as array of tables" (String.concat "." keys));
1762
+
if table.defined then
1763
+
failwith (Printf.sprintf "Table '%s' already defined" (String.concat "." keys));
1764
+
table.defined <- true;
1765
+
table.closed <- true; (* Can't extend via dotted keys from parent *)
1766
+
current_table := table;
1767
+
(* Clear array context stack if we left all array contexts *)
1768
+
if not (List.exists (fun (p, _, _) -> has_prefix keys p) !array_context_stack) then
1769
+
array_context_stack := []);
1770
+
parse_document ())
1771
+
| Tok_bare_key _ | Tok_basic_string _ | Tok_literal_string _
1772
+
| Tok_integer _ | Tok_float _ | Tok_date_local _ | Tok_datetime _
1773
+
| Tok_datetime_local _ | Tok_time_local _ ->
1774
+
(* Key-value pair - key can be bare, quoted, or numeric *)
1775
+
let keys = parse_dotted_key parser in
1776
+
expect_token parser Tok_equals;
1777
+
let value = parse_value parser in
1778
+
skip_to_newline parser;
1779
+
(* Add value to current table - check for duplicates first *)
1780
+
let add_value_to_table tbl key v =
1781
+
if List.mem_assoc key tbl.values then
1782
+
failwith (Printf.sprintf "Duplicate key: %s" key);
1783
+
(match Hashtbl.find_opt tbl.subtables key with
1784
+
| Some sub ->
1785
+
if sub.is_array then
1786
+
failwith (Printf.sprintf "Cannot redefine array of tables '%s' as a value" key)
1787
+
else
1788
+
failwith (Printf.sprintf "Cannot redefine table '%s' as a value" key)
1789
+
| None -> ());
1790
+
tbl.values <- (key, v) :: tbl.values
1791
+
in
1792
+
(match keys with
1793
+
| [] -> failwith "Empty key"
1794
+
| [k] ->
1795
+
add_value_to_table !current_table k value
1796
+
| _ ->
1797
+
let parent_keys = List.rev (List.tl (List.rev keys)) in
1798
+
let final_key = List.hd (List.rev keys) in
1799
+
(* Use get_or_create_table_for_dotted_key to check for closed tables *)
1800
+
let parent = get_or_create_table_for_dotted_key !current_table parent_keys in
1801
+
add_value_to_table parent final_key value);
1802
+
parse_document ()
1803
+
| _tok ->
1804
+
failwith (Printf.sprintf "Unexpected token at line %d" parser.lexer.line)
1805
+
1806
+
and skip_to_newline parser =
1807
+
skip_ws_and_comments parser.lexer;
1808
+
match peek_token parser with
1809
+
| Tok_newline -> ignore (consume_token parser)
1810
+
| Tok_eof -> ()
1811
+
| _ -> failwith "Expected newline after value"
1812
+
in
1813
+
1814
+
parse_document ();
1815
+
table_state_to_toml root
1816
+
1817
+
(* Parse TOML from string - creates lexer internally *)
1818
+
let parse_toml input =
1819
+
let lexer = make_lexer input in
1820
+
parse_toml_from_lexer lexer
1821
+
1822
+
(* Parse TOML directly from Bytes.Reader - no intermediate string *)
1823
+
let parse_toml_from_reader ?file r =
1824
+
let lexer = make_lexer_from_reader ?file r in
1825
+
parse_toml_from_lexer lexer
1826
+
1827
+
(* Convert TOML to tagged JSON for toml-test compatibility *)
1828
+
let rec toml_to_tagged_json value =
1829
+
match value with
1830
+
| Toml.String s ->
1831
+
Printf.sprintf "{\"type\":\"string\",\"value\":%s}" (json_encode_string s)
1832
+
| Toml.Int i ->
1833
+
Printf.sprintf "{\"type\":\"integer\",\"value\":\"%Ld\"}" i
1834
+
| Toml.Float f ->
1835
+
let value_str =
1836
+
(* Normalize exponent format - lowercase e, keep + for positive exponents *)
1837
+
let format_exp s =
1838
+
let buf = Buffer.create (String.length s + 1) in
1839
+
let i = ref 0 in
1840
+
while !i < String.length s do
1841
+
let c = s.[!i] in
1842
+
if c = 'E' then begin
1843
+
Buffer.add_char buf 'e';
1844
+
(* Add + if next char is a digit (no sign present) *)
1845
+
if !i + 1 < String.length s then begin
1846
+
let next = s.[!i + 1] in
1847
+
if next >= '0' && next <= '9' then
1848
+
Buffer.add_char buf '+'
1849
+
end
1850
+
end else if c = 'e' then begin
1851
+
Buffer.add_char buf 'e';
1852
+
(* Add + if next char is a digit (no sign present) *)
1853
+
if !i + 1 < String.length s then begin
1854
+
let next = s.[!i + 1] in
1855
+
if next >= '0' && next <= '9' then
1856
+
Buffer.add_char buf '+'
1857
+
end
1858
+
end else
1859
+
Buffer.add_char buf c;
1860
+
incr i
1861
+
done;
1862
+
Buffer.contents buf
1863
+
in
1864
+
if Float.is_nan f then "nan"
1865
+
else if f = Float.infinity then "inf"
1866
+
else if f = Float.neg_infinity then "-inf"
1867
+
else if f = 0.0 then
1868
+
(* Special case for zero - output "0" or "-0" *)
1869
+
if 1.0 /. f = Float.neg_infinity then "-0" else "0"
1870
+
else if Float.is_integer f then
1871
+
(* Integer floats - decide on representation *)
1872
+
let abs_f = Float.abs f in
1873
+
if abs_f = 9007199254740991.0 then
1874
+
(* Exact max safe integer - output without .0 per toml-test expectation *)
1875
+
Printf.sprintf "%.0f" f
1876
+
else if abs_f >= 1e6 then
1877
+
(* Use scientific notation for numbers >= 1e6 *)
1878
+
(* Start with precision 0 to get XeN format (integer mantissa) *)
1879
+
let rec try_exp_precision prec =
1880
+
if prec > 17 then format_exp (Printf.sprintf "%.17e" f)
1881
+
else
1882
+
let s = format_exp (Printf.sprintf "%.*e" prec f) in
1883
+
if float_of_string s = f then s
1884
+
else try_exp_precision (prec + 1)
1885
+
in
1886
+
try_exp_precision 0
1887
+
else if abs_f >= 2.0 then
1888
+
(* Integer floats >= 2 - output with .0 suffix *)
1889
+
Printf.sprintf "%.1f" f
1890
+
else
1891
+
(* Integer floats 0, 1, -1 - output without .0 suffix *)
1892
+
Printf.sprintf "%.0f" f
1893
+
else
1894
+
(* Non-integer float *)
1895
+
let abs_f = Float.abs f in
1896
+
let use_scientific = abs_f >= 1e10 || (abs_f < 1e-4 && abs_f > 0.0) in
1897
+
if use_scientific then
1898
+
let rec try_exp_precision prec =
1899
+
if prec > 17 then format_exp (Printf.sprintf "%.17e" f)
1900
+
else
1901
+
let s = format_exp (Printf.sprintf "%.*e" prec f) in
1902
+
if float_of_string s = f then s
1903
+
else try_exp_precision (prec + 1)
1904
+
in
1905
+
try_exp_precision 1
1906
+
else
1907
+
(* Prefer decimal notation for reasonable range *)
1908
+
(* Try shortest decimal first *)
1909
+
let rec try_decimal_precision prec =
1910
+
if prec > 17 then None
1911
+
else
1912
+
let s = Printf.sprintf "%.*f" prec f in
1913
+
(* Remove trailing zeros but keep at least one decimal place *)
1914
+
let s =
1915
+
let len = String.length s in
1916
+
let dot_pos = try String.index s '.' with Not_found -> len in
1917
+
let rec find_last_nonzero i =
1918
+
if i <= dot_pos then dot_pos + 2 (* Keep at least X.0 *)
1919
+
else if s.[i] <> '0' then i + 1
1920
+
else find_last_nonzero (i - 1)
1921
+
in
1922
+
let end_pos = min len (find_last_nonzero (len - 1)) in
1923
+
String.sub s 0 end_pos
1924
+
in
1925
+
(* Ensure there's a decimal point with at least one digit after *)
1926
+
let s =
1927
+
if not (String.contains s '.') then s ^ ".0"
1928
+
else if s.[String.length s - 1] = '.' then s ^ "0"
1929
+
else s
1930
+
in
1931
+
if float_of_string s = f then Some s
1932
+
else try_decimal_precision (prec + 1)
1933
+
in
1934
+
let decimal = try_decimal_precision 1 in
1935
+
(* Always prefer decimal notation if it works *)
1936
+
match decimal with
1937
+
| Some d -> d
1938
+
| None ->
1939
+
(* Fall back to shortest representation *)
1940
+
let rec try_precision prec =
1941
+
if prec > 17 then Printf.sprintf "%.17g" f
1942
+
else
1943
+
let s = Printf.sprintf "%.*g" prec f in
1944
+
if float_of_string s = f then s
1945
+
else try_precision (prec + 1)
1946
+
in
1947
+
try_precision 1
1948
+
in
1949
+
Printf.sprintf "{\"type\":\"float\",\"value\":\"%s\"}" value_str
1950
+
| Toml.Bool b ->
1951
+
Printf.sprintf "{\"type\":\"bool\",\"value\":\"%s\"}" (if b then "true" else "false")
1952
+
| Toml.Datetime s ->
1953
+
validate_datetime_string s;
1954
+
Printf.sprintf "{\"type\":\"datetime\",\"value\":\"%s\"}" s
1955
+
| Toml.Datetime_local s ->
1956
+
validate_datetime_string s;
1957
+
Printf.sprintf "{\"type\":\"datetime-local\",\"value\":\"%s\"}" s
1958
+
| Toml.Date_local s ->
1959
+
validate_date_string s;
1960
+
Printf.sprintf "{\"type\":\"date-local\",\"value\":\"%s\"}" s
1961
+
| Toml.Time_local s ->
1962
+
validate_time_string s;
1963
+
Printf.sprintf "{\"type\":\"time-local\",\"value\":\"%s\"}" s
1964
+
| Toml.Array items ->
1965
+
let json_items = List.map toml_to_tagged_json items in
1966
+
Printf.sprintf "[%s]" (String.concat "," json_items)
1967
+
| Toml.Table pairs ->
1968
+
let json_pairs = List.map (fun (k, v) ->
1969
+
Printf.sprintf "%s:%s" (json_encode_string k) (toml_to_tagged_json v)
1970
+
) pairs in
1971
+
Printf.sprintf "{%s}" (String.concat "," json_pairs)
1972
+
1973
+
and json_encode_string s =
1974
+
let buf = Buffer.create (String.length s + 2) in
1975
+
Buffer.add_char buf '"';
1976
+
String.iter (fun c ->
1977
+
match c with
1978
+
| '"' -> Buffer.add_string buf "\\\""
1979
+
| '\\' -> Buffer.add_string buf "\\\\"
1980
+
| '\n' -> Buffer.add_string buf "\\n"
1981
+
| '\r' -> Buffer.add_string buf "\\r"
1982
+
| '\t' -> Buffer.add_string buf "\\t"
1983
+
| '\b' -> Buffer.add_string buf "\\b" (* backspace *)
1984
+
| c when Char.code c = 0x0C -> Buffer.add_string buf "\\f" (* formfeed *)
1985
+
| c when Char.code c < 0x20 ->
1986
+
Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))
1987
+
| c -> Buffer.add_char buf c
1988
+
) s;
1989
+
Buffer.add_char buf '"';
1990
+
Buffer.contents buf
1991
+
1992
+
(* Tagged JSON to TOML for encoder *)
1993
+
let decode_tagged_json_string s =
1994
+
(* Simple JSON parser for tagged format *)
1995
+
let pos = ref 0 in
1996
+
let len = String.length s in
1997
+
1998
+
let skip_ws () =
1999
+
while !pos < len && (s.[!pos] = ' ' || s.[!pos] = '\t' || s.[!pos] = '\n' || s.[!pos] = '\r') do
2000
+
incr pos
2001
+
done
2002
+
in
2003
+
2004
+
let expect c =
2005
+
skip_ws ();
2006
+
if !pos >= len || s.[!pos] <> c then
2007
+
failwith (Printf.sprintf "Expected '%c' at position %d" c !pos);
2008
+
incr pos
2009
+
in
2010
+
2011
+
let peek () =
2012
+
skip_ws ();
2013
+
if !pos >= len then None else Some s.[!pos]
2014
+
in
2015
+
2016
+
let parse_json_string () =
2017
+
skip_ws ();
2018
+
expect '"';
2019
+
let buf = Buffer.create 64 in
2020
+
while !pos < len && s.[!pos] <> '"' do
2021
+
if s.[!pos] = '\\' then begin
2022
+
incr pos;
2023
+
if !pos >= len then failwith "Unexpected end in string escape";
2024
+
match s.[!pos] with
2025
+
| '"' -> Buffer.add_char buf '"'; incr pos
2026
+
| '\\' -> Buffer.add_char buf '\\'; incr pos
2027
+
| '/' -> Buffer.add_char buf '/'; incr pos
2028
+
| 'n' -> Buffer.add_char buf '\n'; incr pos
2029
+
| 'r' -> Buffer.add_char buf '\r'; incr pos
2030
+
| 't' -> Buffer.add_char buf '\t'; incr pos
2031
+
| 'b' -> Buffer.add_char buf '\b'; incr pos
2032
+
| 'f' -> Buffer.add_char buf (Char.chr 0x0C); incr pos
2033
+
| 'u' ->
2034
+
incr pos;
2035
+
if !pos + 3 >= len then failwith "Invalid unicode escape";
2036
+
let hex = String.sub s !pos 4 in
2037
+
let cp = int_of_string ("0x" ^ hex) in
2038
+
Buffer.add_string buf (codepoint_to_utf8 cp);
2039
+
pos := !pos + 4
2040
+
| c -> failwith (Printf.sprintf "Invalid escape: \\%c" c)
2041
+
end else begin
2042
+
Buffer.add_char buf s.[!pos];
2043
+
incr pos
2044
+
end
2045
+
done;
2046
+
expect '"';
2047
+
Buffer.contents buf
2048
+
in
2049
+
2050
+
(* Convert a tagged JSON object to a TOML primitive if applicable *)
2051
+
let convert_tagged_value value =
2052
+
match value with
2053
+
| Toml.Table [("type", Toml.String typ); ("value", Toml.String v)]
2054
+
| Toml.Table [("value", Toml.String v); ("type", Toml.String typ)] ->
2055
+
(match typ with
2056
+
| "string" -> Toml.String v
2057
+
| "integer" -> Toml.Int (Int64.of_string v)
2058
+
| "float" ->
2059
+
(match v with
2060
+
| "inf" -> Toml.Float Float.infinity
2061
+
| "-inf" -> Toml.Float Float.neg_infinity
2062
+
| "nan" -> Toml.Float Float.nan
2063
+
| _ -> Toml.Float (float_of_string v))
2064
+
| "bool" -> Toml.Bool (v = "true")
2065
+
| "datetime" -> Toml.Datetime v
2066
+
| "datetime-local" -> Toml.Datetime_local v
2067
+
| "date-local" -> Toml.Date_local v
2068
+
| "time-local" -> Toml.Time_local v
2069
+
| _ -> failwith (Printf.sprintf "Unknown type: %s" typ))
2070
+
| _ -> value
2071
+
in
2072
+
2073
+
let rec parse_value () =
2074
+
skip_ws ();
2075
+
match peek () with
2076
+
| Some '{' -> parse_object ()
2077
+
| Some '[' -> parse_array ()
2078
+
| Some '"' -> Toml.String (parse_json_string ())
2079
+
| _ -> failwith "Expected value"
2080
+
2081
+
and parse_object () =
2082
+
expect '{';
2083
+
skip_ws ();
2084
+
if peek () = Some '}' then begin
2085
+
incr pos;
2086
+
Toml.Table []
2087
+
end else begin
2088
+
let pairs = ref [] in
2089
+
let first = ref true in
2090
+
while peek () <> Some '}' do
2091
+
if not !first then expect ',';
2092
+
first := false;
2093
+
skip_ws ();
2094
+
let key = parse_json_string () in
2095
+
expect ':';
2096
+
let value = parse_value () in
2097
+
pairs := (key, convert_tagged_value value) :: !pairs
2098
+
done;
2099
+
expect '}';
2100
+
Toml.Table (List.rev !pairs)
2101
+
end
2102
+
2103
+
and parse_array () =
2104
+
expect '[';
2105
+
skip_ws ();
2106
+
if peek () = Some ']' then begin
2107
+
incr pos;
2108
+
Toml.Array []
2109
+
end else begin
2110
+
let items = ref [] in
2111
+
let first = ref true in
2112
+
while peek () <> Some ']' do
2113
+
if not !first then expect ',';
2114
+
first := false;
2115
+
items := convert_tagged_value (parse_value ()) :: !items
2116
+
done;
2117
+
expect ']';
2118
+
Toml.Array (List.rev !items)
2119
+
end
2120
+
in
2121
+
2122
+
parse_value ()
2123
+
2124
+
2125
+
(* ============================================
2126
+
Streaming TOML Encoder
2127
+
============================================ *)
2128
+
2129
+
let is_bare_key_char c =
2130
+
(c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') ||
2131
+
(c >= '0' && c <= '9') || c = '_' || c = '-'
2132
+
2133
+
let rec write_toml_string w s =
2134
+
(* Check if we need to escape *)
2135
+
let needs_escape = String.exists (fun c ->
2136
+
let code = Char.code c in
2137
+
c = '"' || c = '\\' || c = '\n' || c = '\r' || c = '\t' ||
2138
+
code < 0x20 || code = 0x7F
2139
+
) s in
2140
+
if needs_escape then begin
2141
+
Bytes.Writer.write_string w "\"";
2142
+
String.iter (fun c ->
2143
+
match c with
2144
+
| '"' -> Bytes.Writer.write_string w "\\\""
2145
+
| '\\' -> Bytes.Writer.write_string w "\\\\"
2146
+
| '\n' -> Bytes.Writer.write_string w "\\n"
2147
+
| '\r' -> Bytes.Writer.write_string w "\\r"
2148
+
| '\t' -> Bytes.Writer.write_string w "\\t"
2149
+
| '\b' -> Bytes.Writer.write_string w "\\b"
2150
+
| c when Char.code c = 0x0C -> Bytes.Writer.write_string w "\\f"
2151
+
| c when Char.code c < 0x20 || Char.code c = 0x7F ->
2152
+
Bytes.Writer.write_string w (Printf.sprintf "\\u%04X" (Char.code c))
2153
+
| c ->
2154
+
let b = Bytes.create 1 in
2155
+
Bytes.set b 0 c;
2156
+
Bytes.Writer.write_bytes w b
2157
+
) s;
2158
+
Bytes.Writer.write_string w "\""
2159
+
end else begin
2160
+
Bytes.Writer.write_string w "\"";
2161
+
Bytes.Writer.write_string w s;
2162
+
Bytes.Writer.write_string w "\""
2163
+
end
2164
+
2165
+
and write_toml_key w k =
2166
+
(* Check if it can be a bare key *)
2167
+
let is_bare = String.length k > 0 && String.for_all is_bare_key_char k in
2168
+
if is_bare then Bytes.Writer.write_string w k
2169
+
else write_toml_string w k
2170
+
2171
+
and write_toml_value w ?(inline=false) value =
2172
+
match value with
2173
+
| Toml.String s -> write_toml_string w s
2174
+
| Toml.Int i -> Bytes.Writer.write_string w (Int64.to_string i)
2175
+
| Toml.Float f ->
2176
+
if Float.is_nan f then Bytes.Writer.write_string w "nan"
2177
+
else if f = Float.infinity then Bytes.Writer.write_string w "inf"
2178
+
else if f = Float.neg_infinity then Bytes.Writer.write_string w "-inf"
2179
+
else begin
2180
+
let s = Printf.sprintf "%.17g" f in
2181
+
(* Ensure it looks like a float *)
2182
+
let s = if String.contains s '.' || String.contains s 'e' || String.contains s 'E'
2183
+
then s else s ^ ".0" in
2184
+
Bytes.Writer.write_string w s
2185
+
end
2186
+
| Toml.Bool b -> Bytes.Writer.write_string w (if b then "true" else "false")
2187
+
| Toml.Datetime s -> Bytes.Writer.write_string w s
2188
+
| Toml.Datetime_local s -> Bytes.Writer.write_string w s
2189
+
| Toml.Date_local s -> Bytes.Writer.write_string w s
2190
+
| Toml.Time_local s -> Bytes.Writer.write_string w s
2191
+
| Toml.Array items ->
2192
+
Bytes.Writer.write_string w "[";
2193
+
List.iteri (fun i item ->
2194
+
if i > 0 then Bytes.Writer.write_string w ", ";
2195
+
write_toml_value w ~inline:true item
2196
+
) items;
2197
+
Bytes.Writer.write_string w "]"
2198
+
| Toml.Table pairs when inline ->
2199
+
Bytes.Writer.write_string w "{";
2200
+
List.iteri (fun i (k, v) ->
2201
+
if i > 0 then Bytes.Writer.write_string w ", ";
2202
+
write_toml_key w k;
2203
+
Bytes.Writer.write_string w " = ";
2204
+
write_toml_value w ~inline:true v
2205
+
) pairs;
2206
+
Bytes.Writer.write_string w "}"
2207
+
| Toml.Table _ -> failwith "Cannot encode table inline without inline flag"
2208
+
2209
+
(* True streaming TOML encoder - writes directly to Bytes.Writer *)
2210
+
let encode_to_writer w value =
2211
+
let has_content = ref false in
2212
+
2213
+
let write_path path =
2214
+
List.iteri (fun i k ->
2215
+
if i > 0 then Bytes.Writer.write_string w ".";
2216
+
write_toml_key w k
2217
+
) path
2218
+
in
2219
+
2220
+
let rec encode_at_path path value =
2221
+
match value with
2222
+
| Toml.Table pairs ->
2223
+
(* Separate simple values from nested tables *)
2224
+
(* Only PURE table arrays (all items are tables) use [[array]] syntax.
2225
+
Mixed arrays (primitives + tables) must be encoded inline. *)
2226
+
let is_pure_table_array items =
2227
+
items <> [] && List.for_all (function Toml.Table _ -> true | _ -> false) items
2228
+
in
2229
+
let simple, nested = List.partition (fun (_, v) ->
2230
+
match v with
2231
+
| Toml.Table _ -> false
2232
+
| Toml.Array items -> not (is_pure_table_array items)
2233
+
| _ -> true
2234
+
) pairs in
2235
+
2236
+
(* Emit simple values first *)
2237
+
List.iter (fun (k, v) ->
2238
+
write_toml_key w k;
2239
+
Bytes.Writer.write_string w " = ";
2240
+
write_toml_value w ~inline:true v;
2241
+
Bytes.Writer.write_string w "\n";
2242
+
has_content := true
2243
+
) simple;
2244
+
2245
+
(* Then nested tables *)
2246
+
List.iter (fun (k, v) ->
2247
+
let new_path = path @ [k] in
2248
+
match v with
2249
+
| Toml.Table _ ->
2250
+
if !has_content then Bytes.Writer.write_string w "\n";
2251
+
Bytes.Writer.write_string w "[";
2252
+
write_path new_path;
2253
+
Bytes.Writer.write_string w "]\n";
2254
+
has_content := true;
2255
+
encode_at_path new_path v
2256
+
| Toml.Array items when items <> [] && List.for_all (function Toml.Table _ -> true | _ -> false) items ->
2257
+
(* Pure table array - use [[array]] syntax *)
2258
+
List.iter (fun item ->
2259
+
match item with
2260
+
| Toml.Table _ ->
2261
+
if !has_content then Bytes.Writer.write_string w "\n";
2262
+
Bytes.Writer.write_string w "[[";
2263
+
write_path new_path;
2264
+
Bytes.Writer.write_string w "]]\n";
2265
+
has_content := true;
2266
+
encode_at_path new_path item
2267
+
| _ -> assert false (* Impossible - we checked for_all above *)
2268
+
) items
2269
+
| _ ->
2270
+
write_toml_key w k;
2271
+
Bytes.Writer.write_string w " = ";
2272
+
write_toml_value w ~inline:true v;
2273
+
Bytes.Writer.write_string w "\n";
2274
+
has_content := true
2275
+
) nested
2276
+
| _ ->
2277
+
failwith "Top-level TOML must be a table"
2278
+
in
2279
+
2280
+
encode_at_path [] value
2281
+
2282
+
(* ============================================
2283
+
Public Interface - Parsing
2284
+
============================================ *)
2285
+
2286
+
let of_string input =
2287
+
try
2288
+
Ok (parse_toml input)
2289
+
with
2290
+
| Failure msg -> Error (Toml.Error.make (Toml.Error.Syntax (Toml.Error.Expected msg)))
2291
+
| Toml.Error.Error e -> Error e
2292
+
| e -> Error (Toml.Error.make (Toml.Error.Syntax (Toml.Error.Expected (Printexc.to_string e))))
2293
+
2294
+
let of_reader ?file r =
2295
+
try
2296
+
Ok (parse_toml_from_reader ?file r)
2297
+
with
2298
+
| Failure msg -> Error (Toml.Error.make (Toml.Error.Syntax (Toml.Error.Expected msg)))
2299
+
| Toml.Error.Error e -> Error e
2300
+
| e -> Error (Toml.Error.make (Toml.Error.Syntax (Toml.Error.Expected (Printexc.to_string e))))
2301
+
2302
+
let parse = parse_toml
2303
+
2304
+
let parse_reader ?file r = parse_toml_from_reader ?file r
2305
+
2306
+
(* ============================================
2307
+
Public Interface - Encoding
2308
+
============================================ *)
2309
+
2310
+
let to_writer w value = encode_to_writer w value
2311
+
2312
+
let to_string value =
2313
+
let buf = Buffer.create 256 in
2314
+
let w = Bytes.Writer.of_buffer buf in
2315
+
encode_to_writer w value;
2316
+
Buffer.contents buf
2317
+
2318
+
(* ============================================
2319
+
Codec I/O Operations
2320
+
============================================ *)
2321
+
2322
+
let decode_string c s =
2323
+
Result.bind (of_string s) (Tomlt.decode c)
2324
+
2325
+
let decode_string_exn c s =
2326
+
let toml = parse s in
2327
+
Tomlt.decode_exn c toml
2328
+
2329
+
let encode_string c v =
2330
+
let toml = Tomlt.encode c v in
2331
+
to_string toml
2332
+
2333
+
let decode_reader ?file c r =
2334
+
Result.bind (of_reader ?file r) (Tomlt.decode c)
2335
+
2336
+
let encode_writer c v w =
2337
+
let toml = Tomlt.encode c v in
2338
+
to_writer w toml
2339
+
2340
+
(* ============================================
2341
+
Tagged JSON Module
2342
+
============================================ *)
2343
+
2344
+
module Tagged_json = struct
2345
+
let encode = toml_to_tagged_json
2346
+
let decode = decode_tagged_json_string
2347
+
2348
+
let decode_and_encode_toml json_str =
2349
+
try
2350
+
let toml = decode_tagged_json_string json_str in
2351
+
Ok (to_string toml)
2352
+
with
2353
+
| Failure msg -> Error msg
2354
+
| e -> Error (Printexc.to_string e)
2355
+
end
+147
vendor/opam/tomlt/lib_bytesrw/tomlt_bytesrw.mli
+147
vendor/opam/tomlt/lib_bytesrw/tomlt_bytesrw.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bytesrw integration for {{:https://toml.io/en/v1.1.0}TOML 1.1} parsing
7
+
and encoding.
8
+
9
+
This module provides I/O operations for TOML values and codecs using
10
+
{{:https://erratique.ch/software/bytesrw}Bytesrw} for efficient streaming.
11
+
12
+
{2 Quick Start}
13
+
14
+
Parse a TOML string:
15
+
{[
16
+
let config = Tomlt_bytesrw.of_string {|
17
+
[server]
18
+
host = "localhost"
19
+
port = 8080
20
+
|} in
21
+
match config with
22
+
| Ok t ->
23
+
let server = Tomlt.Toml.find "server" t in
24
+
let host = Tomlt.Toml.to_string (Tomlt.Toml.find "host" server) in
25
+
let port = Tomlt.Toml.to_int (Tomlt.Toml.find "port" server) in
26
+
Printf.printf "Server: %s:%Ld\n" host port
27
+
| Error e -> prerr_endline (Tomlt.Toml.Error.to_string e)
28
+
]}
29
+
30
+
Use with codecs:
31
+
{[
32
+
type config = { host : string; port : int }
33
+
34
+
let config_codec = Tomlt.(Table.(
35
+
obj (fun host port -> { host; port })
36
+
|> mem "host" string ~enc:(fun c -> c.host)
37
+
|> mem "port" int ~enc:(fun c -> c.port)
38
+
|> finish
39
+
))
40
+
41
+
let config = Tomlt_bytesrw.decode_string config_codec toml_string
42
+
]}
43
+
44
+
{2 Module Overview}
45
+
46
+
- {!section:parse} - Parsing TOML from strings and readers
47
+
- {!section:encode} - Encoding TOML to strings and writers
48
+
- {!section:codec_io} - Codec I/O operations
49
+
- {!section:tagged_json} - Tagged JSON for toml-test compatibility *)
50
+
51
+
open Bytesrw
52
+
53
+
(** {1:parse Parsing (Decoding)}
54
+
55
+
Parse TOML from various sources. *)
56
+
57
+
val of_string : string -> (Tomlt.Toml.t, Tomlt.Toml.Error.t) result
58
+
(** [of_string s] parses [s] as a TOML document. *)
59
+
60
+
val of_reader : ?file:string -> Bytes.Reader.t -> (Tomlt.Toml.t, Tomlt.Toml.Error.t) result
61
+
(** [of_reader r] parses a TOML document from reader [r].
62
+
@param file Optional filename for error messages. *)
63
+
64
+
val parse : string -> Tomlt.Toml.t
65
+
(** [parse s] parses [s] as a TOML document.
66
+
@raise Tomlt.Toml.Error.Error on parse errors. *)
67
+
68
+
val parse_reader : ?file:string -> Bytes.Reader.t -> Tomlt.Toml.t
69
+
(** [parse_reader r] parses a TOML document from reader [r].
70
+
@param file Optional filename for error messages.
71
+
@raise Tomlt.Toml.Error.Error on parse errors. *)
72
+
73
+
(** {1:encode Encoding}
74
+
75
+
Encode TOML values to strings and writers. *)
76
+
77
+
val to_string : Tomlt.Toml.t -> string
78
+
(** [to_string t] encodes [t] as a TOML-formatted string.
79
+
@raise Invalid_argument if [t] is not a [Table]. *)
80
+
81
+
val to_writer : Bytes.Writer.t -> Tomlt.Toml.t -> unit
82
+
(** [to_writer w t] writes [t] as TOML to writer [w].
83
+
84
+
Use with {!Bytesrw.Bytes.Writer} to write to various destinations:
85
+
{[
86
+
(* To buffer *)
87
+
let buf = Buffer.create 256 in
88
+
Tomlt_bytesrw.to_writer (Bytes.Writer.of_buffer buf) value;
89
+
Buffer.contents buf
90
+
91
+
(* To channel *)
92
+
Tomlt_bytesrw.to_writer (Bytes.Writer.of_out_channel oc) value
93
+
]}
94
+
95
+
@raise Invalid_argument if [t] is not a [Table]. *)
96
+
97
+
(** {1:codec_io Codec I/O Operations}
98
+
99
+
Convenience functions that combine parsing/encoding with codec
100
+
operations. *)
101
+
102
+
val decode_string : 'a Tomlt.t -> string -> ('a, Tomlt.Toml.Error.t) result
103
+
(** [decode_string c s] parses TOML string [s] and decodes with codec [c]. *)
104
+
105
+
val decode_string_exn : 'a Tomlt.t -> string -> 'a
106
+
(** [decode_string_exn c s] is like [decode_string] but raises on error.
107
+
@raise Tomlt.Toml.Error.Error on parse or decode failure. *)
108
+
109
+
val encode_string : 'a Tomlt.t -> 'a -> string
110
+
(** [encode_string c v] encodes [v] using codec [c] to a TOML-formatted string. *)
111
+
112
+
val decode_reader : ?file:string -> 'a Tomlt.t -> Bytes.Reader.t ->
113
+
('a, Tomlt.Toml.Error.t) result
114
+
(** [decode_reader c r] parses TOML from reader [r] and decodes with codec [c].
115
+
@param file Optional filename for error messages. *)
116
+
117
+
val encode_writer : 'a Tomlt.t -> 'a -> Bytes.Writer.t -> unit
118
+
(** [encode_writer c v w] encodes [v] using codec [c] and writes TOML to
119
+
writer [w]. *)
120
+
121
+
(** {1:tagged_json Tagged JSON}
122
+
123
+
Functions for interoperating with the
124
+
{{:https://github.com/toml-lang/toml-test}toml-test} suite's tagged JSON
125
+
format. These functions are primarily for testing and validation. *)
126
+
127
+
module Tagged_json : sig
128
+
val encode : Tomlt.Toml.t -> string
129
+
(** [encode t] converts TOML value [t] to tagged JSON format.
130
+
131
+
The tagged JSON format wraps each value with type information:
132
+
- Strings: [{"type": "string", "value": "..."}]
133
+
- Integers: [{"type": "integer", "value": "..."}]
134
+
- Floats: [{"type": "float", "value": "..."}]
135
+
- Booleans: [{"type": "bool", "value": "true"|"false"}]
136
+
- Datetimes: [{"type": "datetime", "value": "..."}]
137
+
- Arrays: [[...]]
138
+
- Tables: [{...}] *)
139
+
140
+
val decode : string -> Tomlt.Toml.t
141
+
(** [decode s] parses tagged JSON string [s] into a TOML value.
142
+
@raise Failure if the JSON is malformed or has invalid types. *)
143
+
144
+
val decode_and_encode_toml : string -> (string, string) result
145
+
(** [decode_and_encode_toml json] decodes tagged JSON and encodes as TOML.
146
+
Used by the toml-test encoder harness. *)
147
+
end
+5
vendor/opam/tomlt/lib_eio/dune
+5
vendor/opam/tomlt/lib_eio/dune
+98
vendor/opam/tomlt/lib_eio/tomlt_eio.ml
+98
vendor/opam/tomlt/lib_eio/tomlt_eio.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Error = Tomlt.Toml.Error
7
+
8
+
type Eio.Exn.err += E of Error.t
9
+
10
+
let err e = Eio.Exn.create (E e)
11
+
12
+
let () =
13
+
Eio.Exn.register_pp (fun f -> function
14
+
| E e ->
15
+
Format.fprintf f "Toml %a" Error.pp e;
16
+
true
17
+
| _ -> false
18
+
)
19
+
20
+
let wrap_error f =
21
+
try f ()
22
+
with Error.Error e ->
23
+
raise (err e)
24
+
25
+
let parse ?file input =
26
+
try Tomlt_bytesrw.parse input
27
+
with Error.Error e ->
28
+
let bt = Printexc.get_raw_backtrace () in
29
+
let eio_exn = err e in
30
+
let eio_exn = match file with
31
+
| Some f -> Eio.Exn.add_context eio_exn "parsing %s" f
32
+
| None -> eio_exn
33
+
in
34
+
Printexc.raise_with_backtrace eio_exn bt
35
+
36
+
let of_flow ?file flow =
37
+
let input = Eio.Flow.read_all flow in
38
+
parse ?file input
39
+
40
+
let of_path ~fs path =
41
+
let file = Eio.Path.(/) fs path |> Eio.Path.native_exn in
42
+
Eio.Path.load (Eio.Path.(/) fs path)
43
+
|> parse ~file
44
+
45
+
let to_flow flow value =
46
+
let buf = Buffer.create 256 in
47
+
Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
48
+
Eio.Flow.copy_string (Buffer.contents buf) flow
49
+
50
+
let to_path ~fs path value =
51
+
Eio.Path.save ~create:(`Or_truncate 0o644) (Eio.Path.(/) fs path)
52
+
(let buf = Buffer.create 256 in
53
+
Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
54
+
Buffer.contents buf)
55
+
56
+
(* Codec-based operations *)
57
+
let decode_flow ?file codec flow =
58
+
let toml = of_flow ?file flow in
59
+
Tomlt.decode codec toml
60
+
61
+
let decode_flow_exn ?file codec flow =
62
+
let toml = of_flow ?file flow in
63
+
wrap_error (fun () -> Tomlt.decode_exn codec toml)
64
+
65
+
let decode_path codec ~fs path =
66
+
let toml = of_path ~fs path in
67
+
Tomlt.decode codec toml
68
+
69
+
let decode_path_exn codec ~fs path =
70
+
let toml = of_path ~fs path in
71
+
wrap_error (fun () -> Tomlt.decode_exn codec toml)
72
+
73
+
let encode_flow codec value flow =
74
+
let toml = Tomlt.encode codec value in
75
+
to_flow flow toml
76
+
77
+
let encode_path codec value ~fs path =
78
+
let toml = Tomlt.encode codec value in
79
+
to_path ~fs path toml
80
+
81
+
(* Time utilities *)
82
+
let current_tz_offset_s = Ptime_clock.current_tz_offset_s
83
+
let now = Ptime_clock.now
84
+
85
+
let today_date ?tz_offset_s () =
86
+
let tz_offset_s =
87
+
tz_offset_s
88
+
|> Option.fold ~none:(current_tz_offset_s ()) ~some:Option.some
89
+
|> Option.value ~default:0
90
+
in
91
+
Ptime.to_date ~tz_offset_s (now ())
92
+
93
+
(* Pre-configured ptime codecs with system timezone *)
94
+
let ptime ?frac_s () =
95
+
Tomlt.ptime ?frac_s ~get_tz:current_tz_offset_s ~now ()
96
+
97
+
let ptime_full () =
98
+
Tomlt.ptime_full ~get_tz:current_tz_offset_s ()
+146
vendor/opam/tomlt/lib_eio/tomlt_eio.mli
+146
vendor/opam/tomlt/lib_eio/tomlt_eio.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Eio integration for Tomlt.
7
+
8
+
This module provides Eio-native functions for parsing and encoding TOML,
9
+
with proper integration into Eio's exception system and system timezone
10
+
support via {{:https://erratique.ch/software/ptime}ptime.clock.os}.
11
+
12
+
{2 Quick Start}
13
+
14
+
{[
15
+
Eio_main.run @@ fun env ->
16
+
let fs = Eio.Stdenv.fs env in
17
+
18
+
(* Read and decode a config file *)
19
+
type config = { host : string; port : int }
20
+
21
+
let config_codec = Tomlt.(Table.(
22
+
obj (fun host port -> { host; port })
23
+
|> mem "host" string ~enc:(fun c -> c.host)
24
+
|> mem "port" int ~enc:(fun c -> c.port)
25
+
|> finish
26
+
))
27
+
28
+
let config = Tomlt_eio.decode_path_exn config_codec ~fs "config.toml"
29
+
30
+
(* With datetime using system timezone *)
31
+
type event = { name : string; time : Ptime.t }
32
+
33
+
let event_codec = Tomlt.(Table.(
34
+
obj (fun name time -> { name; time })
35
+
|> mem "name" string ~enc:(fun e -> e.name)
36
+
|> mem "time" (Tomlt_eio.ptime ()) ~enc:(fun e -> e.time)
37
+
|> finish
38
+
))
39
+
]}
40
+
*)
41
+
42
+
(** {1 Eio Exception Integration} *)
43
+
44
+
type Eio.Exn.err += E of Tomlt.Toml.Error.t
45
+
(** TOML errors as Eio errors. *)
46
+
47
+
val err : Tomlt.Toml.Error.t -> exn
48
+
(** [err e] creates an [Eio.Io] exception from TOML error [e]. *)
49
+
50
+
val wrap_error : (unit -> 'a) -> 'a
51
+
(** [wrap_error f] runs [f] and converts [Tomlt.Toml.Error.Error] to [Eio.Io]. *)
52
+
53
+
(** {1 Raw TOML Parsing} *)
54
+
55
+
val parse : ?file:string -> string -> Tomlt.Toml.t
56
+
(** [parse s] parses TOML string [s] with Eio error handling.
57
+
@param file optional filename for error context.
58
+
@raise Eio.Io on parse errors. *)
59
+
60
+
val of_flow : ?file:string -> _ Eio.Flow.source -> Tomlt.Toml.t
61
+
(** [of_flow flow] reads and parses TOML from an Eio flow.
62
+
@param file optional filename for error context.
63
+
@raise Eio.Io on read or parse errors. *)
64
+
65
+
val of_path : fs:_ Eio.Path.t -> string -> Tomlt.Toml.t
66
+
(** [of_path ~fs path] reads and parses TOML from a file path.
67
+
@raise Eio.Io on file or parse errors. *)
68
+
69
+
(** {1 Raw TOML Encoding} *)
70
+
71
+
val to_flow : _ Eio.Flow.sink -> Tomlt.Toml.t -> unit
72
+
(** [to_flow flow t] writes TOML value [t] to an Eio flow.
73
+
@raise Invalid_argument if [t] is not a table. *)
74
+
75
+
val to_path : fs:_ Eio.Path.t -> string -> Tomlt.Toml.t -> unit
76
+
(** [to_path ~fs path t] writes TOML value [t] to a file.
77
+
@raise Eio.Io on file errors.
78
+
@raise Invalid_argument if [t] is not a table. *)
79
+
80
+
(** {1 Codec-Based Operations}
81
+
82
+
Decode and encode typed values directly. *)
83
+
84
+
val decode_flow :
85
+
?file:string -> 'a Tomlt.t -> _ Eio.Flow.source ->
86
+
('a, Tomlt.Toml.Error.t) result
87
+
(** [decode_flow codec flow] reads TOML from [flow] and decodes with [codec].
88
+
@param file optional filename for error context. *)
89
+
90
+
val decode_flow_exn : ?file:string -> 'a Tomlt.t -> _ Eio.Flow.source -> 'a
91
+
(** [decode_flow_exn codec flow] is like {!decode_flow} but raises on errors.
92
+
@raise Eio.Io on parse or decode errors. *)
93
+
94
+
val decode_path :
95
+
'a Tomlt.t -> fs:_ Eio.Path.t -> string ->
96
+
('a, Tomlt.Toml.Error.t) result
97
+
(** [decode_path codec ~fs path] reads a TOML file and decodes with [codec]. *)
98
+
99
+
val decode_path_exn : 'a Tomlt.t -> fs:_ Eio.Path.t -> string -> 'a
100
+
(** [decode_path_exn codec ~fs path] is like {!decode_path} but raises.
101
+
@raise Eio.Io on file, parse, or decode errors. *)
102
+
103
+
val encode_flow : 'a Tomlt.t -> 'a -> _ Eio.Flow.sink -> unit
104
+
(** [encode_flow codec value flow] encodes [value] and writes to [flow]. *)
105
+
106
+
val encode_path : 'a Tomlt.t -> 'a -> fs:_ Eio.Path.t -> string -> unit
107
+
(** [encode_path codec value ~fs path] encodes [value] and writes to a file.
108
+
@raise Eio.Io on file errors. *)
109
+
110
+
(** {1 Ptime Codecs with System Timezone}
111
+
112
+
Pre-configured datetime codecs that use the system timezone.
113
+
These are convenience wrappers around {!Tomlt.ptime} and {!Tomlt.ptime_full}
114
+
with [~get_tz:current_tz_offset_s] and [~now] already applied. *)
115
+
116
+
val ptime : ?frac_s:int -> unit -> Ptime.t Tomlt.t
117
+
(** [ptime ()] is a datetime codec using the system timezone.
118
+
119
+
Equivalent to:
120
+
{[Tomlt.ptime ~get_tz:Tomlt_eio.current_tz_offset_s
121
+
~now:Tomlt_eio.now ()]}
122
+
123
+
@param frac_s Fractional seconds to include when encoding (0-12). *)
124
+
125
+
val ptime_full : unit -> Tomlt.Toml.ptime_datetime Tomlt.t
126
+
(** [ptime_full ()] preserves datetime variant information using system timezone.
127
+
128
+
Equivalent to:
129
+
{[Tomlt.ptime_full ~get_tz:Tomlt_eio.current_tz_offset_s ()]} *)
130
+
131
+
(** {1 Time Utilities}
132
+
133
+
Low-level time functions. Prefer using {!ptime} and {!ptime_full}
134
+
for datetime handling. *)
135
+
136
+
val current_tz_offset_s : unit -> int option
137
+
(** [current_tz_offset_s ()] returns the current system timezone offset in
138
+
seconds from UTC. Returns [Some offset] where positive values are east
139
+
of UTC (e.g., 3600 for +01:00) and negative values are west. *)
140
+
141
+
val now : unit -> Ptime.t
142
+
(** [now ()] returns the current time as a [Ptime.t]. *)
143
+
144
+
val today_date : ?tz_offset_s:int -> unit -> Ptime.date
145
+
(** [today_date ?tz_offset_s ()] returns today's date as [(year, month, day)].
146
+
If [tz_offset_s] is not provided, uses [current_tz_offset_s ()]. *)
+5
vendor/opam/tomlt/lib_jsont/dune
+5
vendor/opam/tomlt/lib_jsont/dune
+193
vendor/opam/tomlt/lib_jsont/tomlt_jsont.ml
+193
vendor/opam/tomlt/lib_jsont/tomlt_jsont.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Jsont codecs for TOML tagged JSON format.
7
+
8
+
This module provides bidirectional codecs between TOML values and
9
+
the tagged JSON format used by {{:https://github.com/toml-lang/toml-test}
10
+
toml-test}. *)
11
+
12
+
module Toml = Tomlt.Toml
13
+
module String_map = Map.Make(String)
14
+
15
+
(* The tagged JSON format wraps scalar values as {"type": "T", "value": "V"}
16
+
while arrays and objects are passed through with their contents recursively
17
+
encoded. *)
18
+
19
+
(* Encode TOML -> JSON (string representation) using Tomlt_bytesrw's encoder *)
20
+
let encode (v : Toml.t) : string =
21
+
Tomlt_bytesrw.Tagged_json.encode v
22
+
23
+
(* Decode JSON (string) -> TOML using Tomlt_bytesrw's decoder *)
24
+
let decode (s : string) : Toml.t =
25
+
Tomlt_bytesrw.Tagged_json.decode s
26
+
27
+
(* Convenience result-based decode *)
28
+
let decode_result (s : string) : (Toml.t, string) result =
29
+
try Ok (decode s)
30
+
with Failure msg -> Error msg
31
+
32
+
(* Tagged value type for scalar types *)
33
+
type tagged_value = {
34
+
typ : string;
35
+
value : string;
36
+
}
37
+
38
+
(* Convert tagged value to TOML *)
39
+
let tagged_to_toml (t : tagged_value) : Toml.t =
40
+
match t.typ with
41
+
| "string" -> Toml.String t.value
42
+
| "integer" -> Toml.Int (Int64.of_string t.value)
43
+
| "float" ->
44
+
let f =
45
+
match t.value with
46
+
| "nan" -> Float.nan
47
+
| "inf" | "+inf" -> Float.infinity
48
+
| "-inf" -> Float.neg_infinity
49
+
| s -> float_of_string s
50
+
in
51
+
Toml.Float f
52
+
| "bool" -> Toml.Bool (t.value = "true")
53
+
| "datetime" -> Toml.Datetime t.value
54
+
| "datetime-local" -> Toml.Datetime_local t.value
55
+
| "date-local" -> Toml.Date_local t.value
56
+
| "time-local" -> Toml.Time_local t.value
57
+
| typ -> failwith ("Unknown tagged type: " ^ typ)
58
+
59
+
(* Convert TOML scalar to tagged value *)
60
+
let toml_to_tagged (v : Toml.t) : tagged_value =
61
+
match v with
62
+
| Toml.String s -> { typ = "string"; value = s }
63
+
| Toml.Int i -> { typ = "integer"; value = Int64.to_string i }
64
+
| Toml.Float f ->
65
+
let value =
66
+
if Float.is_nan f then "nan"
67
+
else if f = Float.infinity then "inf"
68
+
else if f = Float.neg_infinity then "-inf"
69
+
else if f = 0.0 && 1.0 /. f = Float.neg_infinity then "-0"
70
+
else Printf.sprintf "%g" f
71
+
in
72
+
{ typ = "float"; value }
73
+
| Toml.Bool b -> { typ = "bool"; value = if b then "true" else "false" }
74
+
| Toml.Datetime s -> { typ = "datetime"; value = s }
75
+
| Toml.Datetime_local s -> { typ = "datetime-local"; value = s }
76
+
| Toml.Date_local s -> { typ = "date-local"; value = s }
77
+
| Toml.Time_local s -> { typ = "time-local"; value = s }
78
+
| Toml.Array _ | Toml.Table _ ->
79
+
failwith "Cannot convert non-scalar TOML value to tagged value"
80
+
81
+
(* Jsont codec for tagged values (scalars only) *)
82
+
let tagged_jsont : tagged_value Jsont.t =
83
+
Jsont.Object.(
84
+
map (fun typ value -> { typ; value })
85
+
|> mem "type" Jsont.string ~enc:(fun t -> t.typ)
86
+
|> mem "value" Jsont.string ~enc:(fun t -> t.value)
87
+
|> finish
88
+
)
89
+
90
+
(* The main recursive TOML value codec.
91
+
92
+
This is a bit tricky because:
93
+
- When decoding an object, we need to determine if it's a tagged scalar
94
+
(has "type" and "value" keys) or a table (keys map to tagged values)
95
+
- When encoding, scalars become {"type": ..., "value": ...}, arrays become
96
+
[...], and tables become {"key": <tagged>, ...}
97
+
*)
98
+
99
+
let rec toml_jsont : Toml.t Jsont.t Lazy.t = lazy (
100
+
Jsont.any
101
+
~dec_array:(Lazy.force toml_array)
102
+
~dec_object:(Lazy.force toml_object)
103
+
~enc:(fun v ->
104
+
match v with
105
+
| Toml.Array _ -> Lazy.force toml_array
106
+
| Toml.Table _ -> Lazy.force toml_table_enc
107
+
| _ -> Lazy.force toml_scalar_enc)
108
+
()
109
+
)
110
+
111
+
and toml_array : Toml.t Jsont.t Lazy.t = lazy (
112
+
Jsont.map
113
+
~dec:(fun items -> Toml.Array items)
114
+
~enc:(function
115
+
| Toml.Array items -> items
116
+
| _ -> failwith "Expected array")
117
+
(Jsont.list (Jsont.rec' toml_jsont))
118
+
)
119
+
120
+
and toml_object : Toml.t Jsont.t Lazy.t = lazy (
121
+
(* Try to decode as tagged scalar first, fall back to table *)
122
+
Jsont.Object.(
123
+
map (fun typ_opt value_opt rest ->
124
+
match typ_opt, value_opt with
125
+
| Some typ, Some value when String_map.is_empty rest ->
126
+
(* Tagged scalar value *)
127
+
tagged_to_toml { typ; value }
128
+
| _ ->
129
+
(* Regular table - include type/value if present but not a valid tagged pair *)
130
+
let pairs = String_map.bindings rest in
131
+
let pairs =
132
+
match typ_opt with
133
+
| Some typ ->
134
+
let typ_toml = Toml.String typ in
135
+
("type", typ_toml) :: pairs
136
+
| None -> pairs
137
+
in
138
+
let pairs =
139
+
match value_opt with
140
+
| Some value ->
141
+
let value_toml = Toml.String value in
142
+
("value", value_toml) :: pairs
143
+
| None -> pairs
144
+
in
145
+
Toml.Table pairs)
146
+
|> opt_mem "type" Jsont.string ~enc:(fun _ -> None)
147
+
|> opt_mem "value" Jsont.string ~enc:(fun _ -> None)
148
+
|> keep_unknown
149
+
(Mems.string_map (Jsont.rec' toml_jsont))
150
+
~enc:(fun _ -> String_map.empty) (* Encoding handled by toml_table_enc *)
151
+
|> finish
152
+
)
153
+
)
154
+
155
+
and toml_scalar_enc : Toml.t Jsont.t Lazy.t = lazy (
156
+
Jsont.map
157
+
~dec:(fun t -> tagged_to_toml t)
158
+
~enc:toml_to_tagged
159
+
tagged_jsont
160
+
)
161
+
162
+
and toml_table_enc : Toml.t Jsont.t Lazy.t = lazy (
163
+
Jsont.Object.(
164
+
map (fun m -> Toml.Table (String_map.bindings m))
165
+
|> keep_unknown
166
+
(Mems.string_map (Jsont.rec' toml_jsont))
167
+
~enc:(function
168
+
| Toml.Table pairs ->
169
+
List.fold_left (fun m (k, v) -> String_map.add k v m)
170
+
String_map.empty pairs
171
+
| _ -> failwith "Expected table")
172
+
|> finish
173
+
)
174
+
)
175
+
176
+
(* Main codec *)
177
+
let toml : Toml.t Jsont.t = Jsont.rec' toml_jsont
178
+
179
+
(* Convenience functions using jsont *)
180
+
181
+
let encode_jsont (v : Toml.t) : (string, string) result =
182
+
Jsont_bytesrw.encode_string toml v
183
+
184
+
let decode_jsont (s : string) : (Toml.t, string) result =
185
+
Jsont_bytesrw.decode_string toml s
186
+
187
+
let decode_jsont' (s : string) : (Toml.t, Jsont.Error.t) result =
188
+
Jsont_bytesrw.decode_string' toml s
189
+
190
+
let decode_jsont_exn (s : string) : Toml.t =
191
+
match decode_jsont' s with
192
+
| Ok v -> v
193
+
| Error e -> raise (Jsont.Error e)
+115
vendor/opam/tomlt/lib_jsont/tomlt_jsont.mli
+115
vendor/opam/tomlt/lib_jsont/tomlt_jsont.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Jsont codecs for TOML tagged JSON format.
7
+
8
+
This module provides bidirectional codecs between TOML values and
9
+
the tagged JSON format used by {{:https://github.com/toml-lang/toml-test}
10
+
toml-test}.
11
+
12
+
{2 Tagged JSON Format}
13
+
14
+
The toml-test suite uses a "tagged JSON" format where each TOML value
15
+
is represented as a JSON object with type information:
16
+
- Scalars: [{"type": "string", "value": "hello"}]
17
+
- Arrays: [[tagged_value, ...]]
18
+
- Tables: [{"key": tagged_value, ...}]
19
+
20
+
{2 Quick Start}
21
+
22
+
Using the native encoder (recommended for compatibility):
23
+
{v
24
+
let json = Tomlt_jsont.encode toml_value
25
+
let toml = Tomlt_jsont.decode json_string
26
+
v}
27
+
28
+
Using jsont codecs (for integration with jsont pipelines):
29
+
{v
30
+
let json = Tomlt_jsont.encode_jsont toml_value
31
+
let toml = Tomlt_jsont.decode_jsont json_string
32
+
v}
33
+
34
+
{2 Module Overview}
35
+
36
+
- {!section:native} - Native encode/decode using Tomlt.Toml.Tagged_json
37
+
- {!section:jsont} - Jsont codec for tagged JSON format
38
+
- {!section:conv} - Convenience functions *)
39
+
40
+
module Toml = Tomlt.Toml
41
+
(** Re-exported TOML module for convenience. *)
42
+
43
+
(** {1:native Native Encode/Decode}
44
+
45
+
These functions use Tomlt's built-in tagged JSON encoder/decoder,
46
+
which is highly optimized for the toml-test format. *)
47
+
48
+
val encode : Toml.t -> string
49
+
(** [encode v] encodes TOML value [v] to tagged JSON format.
50
+
This uses [Toml.Tagged_json.encode] directly. *)
51
+
52
+
val decode : string -> Toml.t
53
+
(** [decode s] decodes tagged JSON string [s] to a TOML value.
54
+
This uses [Toml.Tagged_json.decode] directly.
55
+
@raise Failure on malformed JSON or unknown types. *)
56
+
57
+
val decode_result : string -> (Toml.t, string) result
58
+
(** [decode_result s] is like [decode] but returns a result. *)
59
+
60
+
(** {1:jsont Jsont Codec}
61
+
62
+
The [toml] codec provides a jsont-based implementation of the
63
+
tagged JSON format. This allows integration with jsont pipelines
64
+
and other jsont-based tooling. *)
65
+
66
+
val toml : Toml.t Jsont.t
67
+
(** [toml] is a jsont codec for TOML values in tagged JSON format.
68
+
69
+
This codec can decode and encode the tagged JSON format used by
70
+
toml-test. On decode, it distinguishes between:
71
+
- Tagged scalars: [{"type": "T", "value": "V"}] (exactly these two keys)
72
+
- Tables: Other JSON objects
73
+
- Arrays: JSON arrays
74
+
75
+
On encode, TOML values are converted to appropriate tagged JSON. *)
76
+
77
+
(** {1:conv Convenience Functions}
78
+
79
+
These functions use the jsont codec with [Jsont_bytesrw] for
80
+
string-based encoding/decoding. *)
81
+
82
+
val encode_jsont : Toml.t -> (string, string) result
83
+
(** [encode_jsont v] encodes TOML value [v] using the jsont codec.
84
+
Returns an error string on failure. *)
85
+
86
+
val decode_jsont : string -> (Toml.t, string) result
87
+
(** [decode_jsont s] decodes tagged JSON [s] using the jsont codec.
88
+
Returns an error string on failure. *)
89
+
90
+
val decode_jsont' : string -> (Toml.t, Jsont.Error.t) result
91
+
(** [decode_jsont' s] is like [decode_jsont] but preserves the error. *)
92
+
93
+
val decode_jsont_exn : string -> Toml.t
94
+
(** [decode_jsont_exn s] is like [decode_jsont'] but raises on error.
95
+
@raise Jsont.Error.Error on decode failure. *)
96
+
97
+
(** {1:internal Internal Types}
98
+
99
+
These are exposed for advanced use cases but may change between versions. *)
100
+
101
+
type tagged_value = {
102
+
typ : string;
103
+
value : string;
104
+
}
105
+
(** A tagged scalar value with type and value strings. *)
106
+
107
+
val tagged_jsont : tagged_value Jsont.t
108
+
(** Jsont codec for tagged scalar values. *)
109
+
110
+
val tagged_to_toml : tagged_value -> Toml.t
111
+
(** Convert a tagged value to its TOML representation. *)
112
+
113
+
val toml_to_tagged : Toml.t -> tagged_value
114
+
(** Convert a TOML scalar to a tagged value.
115
+
@raise Failure if the value is not a scalar. *)
+5
vendor/opam/tomlt/lib_unix/dune
+5
vendor/opam/tomlt/lib_unix/dune
+58
vendor/opam/tomlt/lib_unix/tomlt_unix.ml
+58
vendor/opam/tomlt/lib_unix/tomlt_unix.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Bytes = Bytesrw.Bytes
7
+
8
+
(* Time utilities *)
9
+
let current_tz_offset_s = Ptime_clock.current_tz_offset_s
10
+
let now = Ptime_clock.now
11
+
12
+
let today_date ?tz_offset_s () =
13
+
let tz_offset_s =
14
+
tz_offset_s
15
+
|> Option.fold ~none:(current_tz_offset_s ()) ~some:Option.some
16
+
|> Option.value ~default:0
17
+
in
18
+
Ptime.to_date ~tz_offset_s (now ())
19
+
20
+
(* Channel-based I/O *)
21
+
let of_channel ?file ic =
22
+
let r = Bytes.Reader.of_in_channel ic in
23
+
Tomlt_bytesrw.parse_reader ?file r
24
+
25
+
let to_channel oc value =
26
+
let w = Bytes.Writer.of_out_channel oc in
27
+
Tomlt_bytesrw.to_writer w value
28
+
29
+
(* File-based I/O *)
30
+
let of_file path =
31
+
let ic = open_in path in
32
+
Fun.protect ~finally:(fun () -> close_in ic)
33
+
(fun () -> of_channel ~file:path ic)
34
+
35
+
let to_file path value =
36
+
let oc = open_out path in
37
+
Fun.protect ~finally:(fun () -> close_out oc)
38
+
(fun () -> to_channel oc value)
39
+
40
+
(* Codec-based file operations *)
41
+
let decode_file codec path =
42
+
let toml = of_file path in
43
+
Tomlt.decode codec toml
44
+
45
+
let decode_file_exn codec path =
46
+
let toml = of_file path in
47
+
Tomlt.decode_exn codec toml
48
+
49
+
let encode_file codec value path =
50
+
let toml = Tomlt.encode codec value in
51
+
to_file path toml
52
+
53
+
(* Pre-configured ptime codecs with system timezone *)
54
+
let ptime ?frac_s () =
55
+
Tomlt.ptime ?frac_s ~get_tz:current_tz_offset_s ~now ()
56
+
57
+
let ptime_full () =
58
+
Tomlt.ptime_full ~get_tz:current_tz_offset_s ()
+119
vendor/opam/tomlt/lib_unix/tomlt_unix.mli
+119
vendor/opam/tomlt/lib_unix/tomlt_unix.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unix integration for Tomlt.
7
+
8
+
This module provides Unix-native functions for parsing and encoding TOML
9
+
files using standard channels, with system timezone support via
10
+
{{:https://erratique.ch/software/ptime}ptime.clock.os}.
11
+
12
+
{2 Quick Start}
13
+
14
+
{[
15
+
(* Read and decode a config file *)
16
+
type config = { host : string; port : int }
17
+
18
+
let config_codec = Tomlt.(Table.(
19
+
obj (fun host port -> { host; port })
20
+
|> mem "host" string ~enc:(fun c -> c.host)
21
+
|> mem "port" int ~enc:(fun c -> c.port)
22
+
|> finish
23
+
))
24
+
25
+
let config = Tomlt_unix.decode_file_exn config_codec "config.toml"
26
+
27
+
(* With datetime using system timezone *)
28
+
type event = { name : string; time : Ptime.t }
29
+
30
+
let event_codec = Tomlt.(Table.(
31
+
obj (fun name time -> { name; time })
32
+
|> mem "name" string ~enc:(fun e -> e.name)
33
+
|> mem "time" (Tomlt_unix.ptime ()) ~enc:(fun e -> e.time)
34
+
|> finish
35
+
))
36
+
]}
37
+
*)
38
+
39
+
(** {1 File I/O}
40
+
41
+
Read and write TOML files directly. *)
42
+
43
+
val of_file : string -> Tomlt.Toml.t
44
+
(** [of_file path] reads and parses a TOML file.
45
+
@raise Tomlt.Error.Error on parse errors.
46
+
@raise Sys_error on file errors. *)
47
+
48
+
val to_file : string -> Tomlt.Toml.t -> unit
49
+
(** [to_file path value] writes [value] as TOML to a file.
50
+
@raise Invalid_argument if [value] is not a table.
51
+
@raise Sys_error on file errors. *)
52
+
53
+
(** {1 Channel I/O}
54
+
55
+
Read and write TOML via standard channels. *)
56
+
57
+
val of_channel : ?file:string -> in_channel -> Tomlt.Toml.t
58
+
(** [of_channel ic] reads and parses TOML from an input channel.
59
+
@param file Optional filename for error messages.
60
+
@raise Toml.Error.Error on parse errors. *)
61
+
62
+
val to_channel : out_channel -> Tomlt.Toml.t -> unit
63
+
(** [to_channel oc value] writes [value] as TOML to an output channel.
64
+
@raise Invalid_argument if [value] is not a table. *)
65
+
66
+
(** {1 Codec-Based File Operations}
67
+
68
+
Decode and encode typed values directly to/from files. *)
69
+
70
+
val decode_file : 'a Tomlt.t -> string -> ('a, Tomlt.Toml.Error.t) result
71
+
(** [decode_file codec path] reads a TOML file and decodes it with [codec].
72
+
@raise Sys_error on file errors. *)
73
+
74
+
val decode_file_exn : 'a Tomlt.t -> string -> 'a
75
+
(** [decode_file_exn codec path] is like {!decode_file} but raises on errors.
76
+
@raise Toml.Error.Error on parse or decode errors.
77
+
@raise Sys_error on file errors. *)
78
+
79
+
val encode_file : 'a Tomlt.t -> 'a -> string -> unit
80
+
(** [encode_file codec value path] encodes [value] and writes to a file.
81
+
@raise Sys_error on file errors. *)
82
+
83
+
(** {1 Ptime Codecs with System Timezone}
84
+
85
+
Pre-configured datetime codecs that use the system timezone.
86
+
These are convenience wrappers around {!Tomlt.ptime} and {!Tomlt.ptime_full}
87
+
with [~get_tz:current_tz_offset_s] and [~now] already applied. *)
88
+
89
+
val ptime : ?frac_s:int -> unit -> Ptime.t Tomlt.t
90
+
(** [ptime ()] is a datetime codec using the system timezone.
91
+
92
+
Equivalent to:
93
+
{[Tomlt.ptime ~get_tz:Tomlt_unix.current_tz_offset_s
94
+
~now:Tomlt_unix.now ()]}
95
+
96
+
@param frac_s Fractional seconds to include when encoding (0-12). *)
97
+
98
+
val ptime_full : unit -> Tomlt.Toml.ptime_datetime Tomlt.t
99
+
(** [ptime_full ()] preserves datetime variant information using system timezone.
100
+
101
+
Equivalent to:
102
+
{[Tomlt.ptime_full ~get_tz:Tomlt_unix.current_tz_offset_s ()]} *)
103
+
104
+
(** {1 Time Utilities}
105
+
106
+
Low-level time functions. Prefer using {!ptime} and {!ptime_full}
107
+
for datetime handling. *)
108
+
109
+
val current_tz_offset_s : unit -> int option
110
+
(** [current_tz_offset_s ()] returns the current system timezone offset in
111
+
seconds from UTC. Returns [Some offset] where positive values are east
112
+
of UTC (e.g., 3600 for +01:00) and negative values are west. *)
113
+
114
+
val now : unit -> Ptime.t
115
+
(** [now ()] returns the current time as a [Ptime.t]. *)
116
+
117
+
val today_date : ?tz_offset_s:int -> unit -> Ptime.date
118
+
(** [today_date ?tz_offset_s ()] returns today's date as [(year, month, day)].
119
+
If [tz_offset_s] is not provided, uses [current_tz_offset_s ()]. *)
+646
vendor/opam/tomlt/test/cookbook.ml
+646
vendor/opam/tomlt/test/cookbook.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
[@@@warning "-32"]
7
+
8
+
(** Cookbook examples - runnable implementations matching doc/cookbook.mld *)
9
+
10
+
(* ============================================
11
+
Configuration Files
12
+
============================================ *)
13
+
14
+
module Config_files = struct
15
+
(* Basic Configuration *)
16
+
type database_config = {
17
+
host : string;
18
+
port : int;
19
+
name : string;
20
+
}
21
+
22
+
let database_config_codec =
23
+
Tomlt.(Table.(
24
+
obj (fun host port name -> { host; port; name })
25
+
|> mem "host" string ~enc:(fun c -> c.host)
26
+
|> mem "port" int ~enc:(fun c -> c.port)
27
+
|> mem "name" string ~enc:(fun c -> c.name)
28
+
|> finish
29
+
))
30
+
31
+
let example_database_toml = {|
32
+
host = "localhost"
33
+
port = 5432
34
+
name = "myapp"
35
+
|}
36
+
37
+
(* Nested Configuration *)
38
+
type server_config = {
39
+
host : string;
40
+
port : int;
41
+
}
42
+
43
+
type app_config = {
44
+
name : string;
45
+
server : server_config;
46
+
debug : bool;
47
+
}
48
+
49
+
let server_config_codec =
50
+
Tomlt.(Table.(
51
+
obj (fun host port -> { host; port })
52
+
|> mem "host" string ~enc:(fun s -> s.host)
53
+
|> mem "port" int ~enc:(fun s -> s.port)
54
+
|> finish
55
+
))
56
+
57
+
let app_config_codec =
58
+
Tomlt.(Table.(
59
+
obj (fun name server debug -> { name; server; debug })
60
+
|> mem "name" string ~enc:(fun c -> c.name)
61
+
|> mem "server" server_config_codec ~enc:(fun c -> c.server)
62
+
|> mem "debug" bool ~enc:(fun c -> c.debug)
63
+
|> finish
64
+
))
65
+
66
+
let example_app_toml = {|
67
+
name = "My Application"
68
+
debug = false
69
+
70
+
[server]
71
+
host = "0.0.0.0"
72
+
port = 8080
73
+
|}
74
+
75
+
(* Multi-Environment Configuration *)
76
+
type env_config = {
77
+
database_url : string;
78
+
log_level : string;
79
+
cache_ttl : int;
80
+
}
81
+
82
+
type config = {
83
+
app_name : string;
84
+
development : env_config;
85
+
production : env_config;
86
+
}
87
+
88
+
let env_config_codec =
89
+
Tomlt.(Table.(
90
+
obj (fun database_url log_level cache_ttl ->
91
+
{ database_url; log_level; cache_ttl })
92
+
|> mem "database_url" string ~enc:(fun e -> e.database_url)
93
+
|> mem "log_level" string ~enc:(fun e -> e.log_level)
94
+
|> mem "cache_ttl" int ~enc:(fun e -> e.cache_ttl)
95
+
|> finish
96
+
))
97
+
98
+
let config_codec =
99
+
Tomlt.(Table.(
100
+
obj (fun app_name development production ->
101
+
{ app_name; development; production })
102
+
|> mem "app_name" string ~enc:(fun c -> c.app_name)
103
+
|> mem "development" env_config_codec ~enc:(fun c -> c.development)
104
+
|> mem "production" env_config_codec ~enc:(fun c -> c.production)
105
+
|> finish
106
+
))
107
+
108
+
let example_multi_env_toml = {|
109
+
app_name = "MyApp"
110
+
111
+
[development]
112
+
database_url = "postgres://localhost/dev"
113
+
log_level = "debug"
114
+
cache_ttl = 60
115
+
116
+
[production]
117
+
database_url = "postgres://prod-db/app"
118
+
log_level = "error"
119
+
cache_ttl = 3600
120
+
|}
121
+
end
122
+
123
+
(* ============================================
124
+
Optional and Absent Values
125
+
============================================ *)
126
+
127
+
module Optional_values = struct
128
+
(* Default Values with dec_absent *)
129
+
type settings = {
130
+
theme : string;
131
+
font_size : int;
132
+
show_line_numbers : bool;
133
+
}
134
+
135
+
let settings_codec =
136
+
Tomlt.(Table.(
137
+
obj (fun theme font_size show_line_numbers ->
138
+
{ theme; font_size; show_line_numbers })
139
+
|> mem "theme" string ~enc:(fun s -> s.theme)
140
+
~dec_absent:"default"
141
+
|> mem "font_size" int ~enc:(fun s -> s.font_size)
142
+
~dec_absent:12
143
+
|> mem "show_line_numbers" bool ~enc:(fun s -> s.show_line_numbers)
144
+
~dec_absent:true
145
+
|> finish
146
+
))
147
+
148
+
let example_settings_toml = {|
149
+
theme = "dark"
150
+
|}
151
+
152
+
(* Option Types with opt_mem *)
153
+
type user = {
154
+
name : string;
155
+
email : string option;
156
+
phone : string option;
157
+
}
158
+
159
+
let user_codec =
160
+
Tomlt.(Table.(
161
+
obj (fun name email phone -> { name; email; phone })
162
+
|> mem "name" string ~enc:(fun u -> u.name)
163
+
|> opt_mem "email" string ~enc:(fun u -> u.email)
164
+
|> opt_mem "phone" string ~enc:(fun u -> u.phone)
165
+
|> finish
166
+
))
167
+
168
+
let example_user_toml = {|
169
+
name = "Alice"
170
+
email = "alice@example.com"
171
+
|}
172
+
173
+
(* Conditional Omission with enc_omit *)
174
+
type retry_config = {
175
+
name : string;
176
+
retries : int;
177
+
}
178
+
179
+
let retry_config_codec =
180
+
Tomlt.(Table.(
181
+
obj (fun name retries -> { name; retries })
182
+
|> mem "name" string ~enc:(fun c -> c.name)
183
+
|> mem "retries" int ~enc:(fun c -> c.retries)
184
+
~dec_absent:0
185
+
~enc_omit:(fun r -> r = 0)
186
+
|> finish
187
+
))
188
+
end
189
+
190
+
(* ============================================
191
+
Datetimes
192
+
============================================ *)
193
+
194
+
module Datetimes = struct
195
+
(* Basic Datetime Handling *)
196
+
type event = { name : string; timestamp : Ptime.t }
197
+
198
+
let event_codec =
199
+
Tomlt.(Table.(
200
+
obj (fun name timestamp -> { name; timestamp })
201
+
|> mem "name" string ~enc:(fun e -> e.name)
202
+
|> mem "when" (ptime ()) ~enc:(fun e -> e.timestamp)
203
+
|> finish
204
+
))
205
+
206
+
let example_event_toml = {|
207
+
name = "Meeting"
208
+
when = 2024-01-15T10:30:00Z
209
+
|}
210
+
211
+
(* Strict Timestamp Validation *)
212
+
type audit_log = { action : string; timestamp : Ptime.t }
213
+
214
+
let audit_codec =
215
+
Tomlt.(Table.(
216
+
obj (fun action timestamp -> { action; timestamp })
217
+
|> mem "action" string ~enc:(fun a -> a.action)
218
+
|> mem "timestamp" (ptime_opt ()) ~enc:(fun a -> a.timestamp)
219
+
|> finish
220
+
))
221
+
222
+
let example_audit_toml = {|
223
+
action = "user_login"
224
+
timestamp = 2024-01-15T10:30:00Z
225
+
|}
226
+
227
+
(* Date-Only Fields *)
228
+
type person = { name : string; birthday : Ptime.date }
229
+
230
+
let person_codec =
231
+
Tomlt.(Table.(
232
+
obj (fun name birthday -> { name; birthday })
233
+
|> mem "name" string ~enc:(fun p -> p.name)
234
+
|> mem "birthday" ptime_date ~enc:(fun p -> p.birthday)
235
+
|> finish
236
+
))
237
+
238
+
let example_person_toml = {|
239
+
name = "Bob"
240
+
birthday = 1985-03-15
241
+
|}
242
+
243
+
(* Time-Only Fields *)
244
+
type alarm = { label : string; time : Ptime.Span.t }
245
+
246
+
let alarm_codec =
247
+
Tomlt.(Table.(
248
+
obj (fun label time -> { label; time })
249
+
|> mem "label" string ~enc:(fun a -> a.label)
250
+
|> mem "time" ptime_span ~enc:(fun a -> a.time)
251
+
|> finish
252
+
))
253
+
254
+
let example_alarm_toml = {|
255
+
label = "Wake up"
256
+
time = 07:30:00
257
+
|}
258
+
259
+
(* Preserving Datetime Format *)
260
+
type flexible_event = {
261
+
name : string;
262
+
when_ : Tomlt.Toml.ptime_datetime;
263
+
}
264
+
265
+
let flexible_codec =
266
+
Tomlt.(Table.(
267
+
obj (fun name when_ -> { name; when_ })
268
+
|> mem "name" string ~enc:(fun e -> e.name)
269
+
|> mem "when" (ptime_full ()) ~enc:(fun e -> e.when_)
270
+
|> finish
271
+
))
272
+
273
+
let example_flexible_toml = {|
274
+
name = "Birthday"
275
+
when = 1985-03-15
276
+
|}
277
+
end
278
+
279
+
(* ============================================
280
+
Arrays
281
+
============================================ *)
282
+
283
+
module Arrays = struct
284
+
(* Basic Arrays *)
285
+
type network_config = {
286
+
name : string;
287
+
ports : int list;
288
+
hosts : string list;
289
+
}
290
+
291
+
let network_config_codec =
292
+
Tomlt.(Table.(
293
+
obj (fun name ports hosts -> { name; ports; hosts })
294
+
|> mem "name" string ~enc:(fun c -> c.name)
295
+
|> mem "ports" (list int) ~enc:(fun c -> c.ports)
296
+
|> mem "hosts" (list string) ~enc:(fun c -> c.hosts)
297
+
|> finish
298
+
))
299
+
300
+
let example_network_toml = {|
301
+
name = "load-balancer"
302
+
ports = [80, 443, 8080]
303
+
hosts = ["web1.example.com", "web2.example.com"]
304
+
|}
305
+
306
+
(* Arrays of Tables *)
307
+
type product = { name : string; price : float }
308
+
type catalog = { products : product list }
309
+
310
+
let product_codec =
311
+
Tomlt.(Table.(
312
+
obj (fun name price -> { name; price })
313
+
|> mem "name" string ~enc:(fun p -> p.name)
314
+
|> mem "price" float ~enc:(fun p -> p.price)
315
+
|> finish
316
+
))
317
+
318
+
let catalog_codec =
319
+
Tomlt.(Table.(
320
+
obj (fun products -> { products })
321
+
|> mem "products" (array_of_tables product_codec)
322
+
~enc:(fun c -> c.products)
323
+
|> finish
324
+
))
325
+
326
+
let example_catalog_toml = {|
327
+
[[products]]
328
+
name = "Widget"
329
+
price = 9.99
330
+
331
+
[[products]]
332
+
name = "Gadget"
333
+
price = 19.99
334
+
|}
335
+
336
+
(* Nested Arrays *)
337
+
type matrix = { rows : int list list }
338
+
339
+
let matrix_codec =
340
+
Tomlt.(Table.(
341
+
obj (fun rows -> { rows })
342
+
|> mem "rows" (list (list int)) ~enc:(fun m -> m.rows)
343
+
|> finish
344
+
))
345
+
346
+
let example_matrix_toml = {|
347
+
rows = [[1, 2, 3], [4, 5, 6], [7, 8, 9]]
348
+
|}
349
+
end
350
+
351
+
(* ============================================
352
+
Tables
353
+
============================================ *)
354
+
355
+
module Tables = struct
356
+
(* Inline Tables *)
357
+
type point = { x : int; y : int }
358
+
359
+
let point_codec =
360
+
Tomlt.(Table.(
361
+
obj (fun x y -> { x; y })
362
+
|> mem "x" int ~enc:(fun p -> p.x)
363
+
|> mem "y" int ~enc:(fun p -> p.y)
364
+
|> inline
365
+
))
366
+
367
+
(* Deeply Nested Structures *)
368
+
type address = { street : string; city : string }
369
+
type company = { name : string; address : address }
370
+
type employee = { name : string; company : company }
371
+
372
+
let address_codec =
373
+
Tomlt.(Table.(
374
+
obj (fun street city -> { street; city })
375
+
|> mem "street" string ~enc:(fun (a : address) -> a.street)
376
+
|> mem "city" string ~enc:(fun a -> a.city)
377
+
|> finish
378
+
))
379
+
380
+
let company_codec =
381
+
Tomlt.(Table.(
382
+
obj (fun name address -> { name; address })
383
+
|> mem "name" string ~enc:(fun (c : company) -> c.name)
384
+
|> mem "address" address_codec ~enc:(fun c -> c.address)
385
+
|> finish
386
+
))
387
+
388
+
let employee_codec =
389
+
Tomlt.(Table.(
390
+
obj (fun name company -> { name; company })
391
+
|> mem "name" string ~enc:(fun (e : employee) -> e.name)
392
+
|> mem "company" company_codec ~enc:(fun e -> e.company)
393
+
|> finish
394
+
))
395
+
396
+
let example_employee_toml = {|
397
+
name = "Alice"
398
+
399
+
[company]
400
+
name = "Acme Corp"
401
+
402
+
[company.address]
403
+
street = "123 Main St"
404
+
city = "Springfield"
405
+
|}
406
+
end
407
+
408
+
(* ============================================
409
+
Unknown Members
410
+
============================================ *)
411
+
412
+
module Unknown_members = struct
413
+
(* Ignoring Unknown Members (Default) *)
414
+
let host_only_codec =
415
+
Tomlt.(Table.(
416
+
obj (fun host -> host)
417
+
|> mem "host" string ~enc:Fun.id
418
+
|> skip_unknown
419
+
|> finish
420
+
))
421
+
422
+
(* Rejecting Unknown Members *)
423
+
let strict_config_codec =
424
+
Tomlt.(Table.(
425
+
obj (fun host port -> (host, port))
426
+
|> mem "host" string ~enc:fst
427
+
|> mem "port" int ~enc:snd
428
+
|> error_unknown
429
+
|> finish
430
+
))
431
+
432
+
(* Collecting Unknown Members *)
433
+
type extensible_config = {
434
+
name : string;
435
+
extra : (string * Tomlt.Toml.t) list;
436
+
}
437
+
438
+
let extensible_config_codec =
439
+
Tomlt.(Table.(
440
+
obj (fun name extra -> { name; extra })
441
+
|> mem "name" string ~enc:(fun c -> c.name)
442
+
|> keep_unknown (Mems.assoc value) ~enc:(fun c -> c.extra)
443
+
|> finish
444
+
))
445
+
446
+
let example_extensible_toml = {|
447
+
name = "app"
448
+
foo = 42
449
+
bar = "hello"
450
+
|}
451
+
452
+
(* Typed Unknown Members *)
453
+
module StringMap = Map.Make(String)
454
+
455
+
type translations = {
456
+
default_lang : string;
457
+
strings : string StringMap.t;
458
+
}
459
+
460
+
let translations_codec =
461
+
Tomlt.(Table.(
462
+
obj (fun default_lang strings -> { default_lang; strings })
463
+
|> mem "default_lang" string ~enc:(fun t -> t.default_lang)
464
+
|> keep_unknown (Mems.string_map string) ~enc:(fun t -> t.strings)
465
+
|> finish
466
+
))
467
+
468
+
let example_translations_toml = {|
469
+
default_lang = "en"
470
+
hello = "Hello"
471
+
goodbye = "Goodbye"
472
+
thanks = "Thank you"
473
+
|}
474
+
end
475
+
476
+
(* ============================================
477
+
Validation
478
+
============================================ *)
479
+
480
+
module Validation = struct
481
+
(* Range Validation with iter *)
482
+
let port_codec =
483
+
Tomlt.(iter int
484
+
~dec:(fun p ->
485
+
if p < 0 || p > 65535 then
486
+
failwith "port must be between 0 and 65535"))
487
+
488
+
let percentage_codec =
489
+
Tomlt.(iter float
490
+
~dec:(fun p ->
491
+
if p < 0.0 || p > 100.0 then
492
+
failwith "percentage must be between 0 and 100"))
493
+
494
+
(* String Enumerations *)
495
+
type log_level = Debug | Info | Warning | Error
496
+
497
+
let log_level_codec =
498
+
Tomlt.enum [
499
+
"debug", Debug;
500
+
"info", Info;
501
+
"warning", Warning;
502
+
"error", Error;
503
+
]
504
+
505
+
type log_config = { level : log_level }
506
+
507
+
let log_config_codec =
508
+
Tomlt.(Table.(
509
+
obj (fun level -> { level })
510
+
|> mem "level" log_level_codec ~enc:(fun c -> c.level)
511
+
|> finish
512
+
))
513
+
514
+
let example_log_toml = {|
515
+
level = "info"
516
+
|}
517
+
end
518
+
519
+
(* ============================================
520
+
Recursion
521
+
============================================ *)
522
+
523
+
module Recursion = struct
524
+
type tree = Node of int * tree list
525
+
526
+
let rec tree_codec = lazy Tomlt.(
527
+
Table.(
528
+
obj (fun value children -> Node (value, children))
529
+
|> mem "value" int ~enc:(function Node (v, _) -> v)
530
+
|> mem "children" (list (rec' tree_codec))
531
+
~enc:(function Node (_, cs) -> cs)
532
+
~dec_absent:[]
533
+
|> finish
534
+
))
535
+
536
+
let tree_codec = Lazy.force tree_codec
537
+
538
+
let example_tree_toml = {|
539
+
value = 1
540
+
541
+
[[children]]
542
+
value = 2
543
+
544
+
[[children]]
545
+
value = 3
546
+
547
+
[[children.children]]
548
+
value = 4
549
+
|}
550
+
end
551
+
552
+
(* ============================================
553
+
Main - Run examples
554
+
============================================ *)
555
+
556
+
let decode_and_print name codec toml =
557
+
Printf.printf "=== %s ===\n" name;
558
+
match Tomlt_bytesrw.decode_string codec toml with
559
+
| Ok _ -> Printf.printf "OK: Decoded successfully\n\n"
560
+
| Error e -> Printf.printf "ERROR: %s\n\n" (Tomlt.Toml.Error.to_string e)
561
+
562
+
let () =
563
+
Printf.printf "Tomlt Cookbook Examples\n";
564
+
Printf.printf "=======================\n\n";
565
+
566
+
(* Config files *)
567
+
decode_and_print "Database config"
568
+
Config_files.database_config_codec
569
+
Config_files.example_database_toml;
570
+
571
+
decode_and_print "App config"
572
+
Config_files.app_config_codec
573
+
Config_files.example_app_toml;
574
+
575
+
decode_and_print "Multi-env config"
576
+
Config_files.config_codec
577
+
Config_files.example_multi_env_toml;
578
+
579
+
(* Optional values *)
580
+
decode_and_print "Settings with defaults"
581
+
Optional_values.settings_codec
582
+
Optional_values.example_settings_toml;
583
+
584
+
decode_and_print "User with optional fields"
585
+
Optional_values.user_codec
586
+
Optional_values.example_user_toml;
587
+
588
+
(* Datetimes *)
589
+
decode_and_print "Event with datetime"
590
+
Datetimes.event_codec
591
+
Datetimes.example_event_toml;
592
+
593
+
decode_and_print "Audit log (strict)"
594
+
Datetimes.audit_codec
595
+
Datetimes.example_audit_toml;
596
+
597
+
decode_and_print "Person with birthday"
598
+
Datetimes.person_codec
599
+
Datetimes.example_person_toml;
600
+
601
+
decode_and_print "Alarm with time"
602
+
Datetimes.alarm_codec
603
+
Datetimes.example_alarm_toml;
604
+
605
+
decode_and_print "Flexible event"
606
+
Datetimes.flexible_codec
607
+
Datetimes.example_flexible_toml;
608
+
609
+
(* Arrays *)
610
+
decode_and_print "Network config"
611
+
Arrays.network_config_codec
612
+
Arrays.example_network_toml;
613
+
614
+
decode_and_print "Product catalog"
615
+
Arrays.catalog_codec
616
+
Arrays.example_catalog_toml;
617
+
618
+
decode_and_print "Matrix"
619
+
Arrays.matrix_codec
620
+
Arrays.example_matrix_toml;
621
+
622
+
(* Tables *)
623
+
decode_and_print "Employee (nested)"
624
+
Tables.employee_codec
625
+
Tables.example_employee_toml;
626
+
627
+
(* Unknown members *)
628
+
decode_and_print "Extensible config"
629
+
Unknown_members.extensible_config_codec
630
+
Unknown_members.example_extensible_toml;
631
+
632
+
decode_and_print "Translations"
633
+
Unknown_members.translations_codec
634
+
Unknown_members.example_translations_toml;
635
+
636
+
(* Validation *)
637
+
decode_and_print "Log config"
638
+
Validation.log_config_codec
639
+
Validation.example_log_toml;
640
+
641
+
(* Recursion *)
642
+
decode_and_print "Tree"
643
+
Recursion.tree_codec
644
+
Recursion.example_tree_toml;
645
+
646
+
Printf.printf "All examples completed.\n"
+15
vendor/opam/tomlt/test/dune
+15
vendor/opam/tomlt/test/dune
···
1
+
(test
2
+
(name test_tomlt)
3
+
(libraries tomlt tomlt.bytesrw alcotest))
4
+
5
+
(test
6
+
(name test_codec)
7
+
(libraries tomlt tomlt.bytesrw alcotest))
8
+
9
+
(executable
10
+
(name test_debug)
11
+
(libraries tomlt tomlt.bytesrw))
12
+
13
+
(executable
14
+
(name cookbook)
15
+
(libraries tomlt tomlt.bytesrw))
+1489
vendor/opam/tomlt/test/test_codec.ml
+1489
vendor/opam/tomlt/test/test_codec.ml
···
1
+
(* Comprehensive tests for Tomlt codecs *)
2
+
3
+
open Tomlt
4
+
5
+
(* Helper to encode TOML to string via writer *)
6
+
let toml_to_string value =
7
+
let buf = Buffer.create 256 in
8
+
Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
9
+
Buffer.contents buf
10
+
11
+
(* ============================================================================
12
+
Test Helpers
13
+
============================================================================ *)
14
+
15
+
(* Decode a value from "value = X" TOML *)
16
+
let check_decode_ok name codec input expected =
17
+
let toml = Tomlt_bytesrw.parse input in
18
+
let value = Toml.find "value" toml in
19
+
let actual = decode codec value in
20
+
match actual with
21
+
| Ok v when v = expected -> ()
22
+
| Ok _ ->
23
+
Alcotest.failf "%s: decode returned unexpected value" name
24
+
| Error e ->
25
+
Alcotest.failf "%s: decode failed: %s" name (Toml.Error.to_string e)
26
+
27
+
(* Check that decode fails *)
28
+
let check_decode_error name codec input =
29
+
let toml = Tomlt_bytesrw.parse input in
30
+
let value = Toml.find "value" toml in
31
+
match decode codec value with
32
+
| Error _ -> ()
33
+
| Ok _ -> Alcotest.failf "%s: expected decode error but succeeded" name
34
+
35
+
(* Decode from a table (for table codecs) *)
36
+
let check_decode_table_ok name codec input expected =
37
+
let toml = Tomlt_bytesrw.parse input in
38
+
let value = Toml.find "value" toml in
39
+
let actual = decode codec value in
40
+
match actual with
41
+
| Ok v when v = expected -> ()
42
+
| Ok _ ->
43
+
Alcotest.failf "%s: decode returned unexpected value" name
44
+
| Error e ->
45
+
Alcotest.failf "%s: decode failed: %s" name (Toml.Error.to_string e)
46
+
47
+
(* Check table decode error *)
48
+
let check_decode_table_error name codec input =
49
+
let toml = Tomlt_bytesrw.parse input in
50
+
let value = Toml.find "value" toml in
51
+
match decode codec value with
52
+
| Error _ -> ()
53
+
| Ok _ -> Alcotest.failf "%s: expected decode error but succeeded" name
54
+
55
+
(* Roundtrip test *)
56
+
let check_roundtrip name codec value =
57
+
let toml = encode codec value in
58
+
match decode codec toml with
59
+
| Ok v when v = value -> ()
60
+
| Ok _ ->
61
+
Alcotest.failf "%s: roundtrip mismatch, got different value" name
62
+
| Error e ->
63
+
Alcotest.failf "%s: roundtrip decode failed: %s" name (Toml.Error.to_string e)
64
+
65
+
66
+
(* ============================================================================
67
+
Datetime Type Tests
68
+
============================================================================ *)
69
+
70
+
(* ---- Tz tests ---- *)
71
+
72
+
let test_tz_utc () =
73
+
Alcotest.(check string) "utc to_string" "Z" (Tz.to_string Tz.utc);
74
+
Alcotest.(check bool) "utc equal" true (Tz.equal Tz.utc Tz.utc);
75
+
match Tz.of_string "Z" with
76
+
| Ok tz -> Alcotest.(check bool) "parse Z" true (Tz.equal tz Tz.utc)
77
+
| Error e -> Alcotest.failf "failed to parse Z: %s" e
78
+
79
+
let test_tz_offset () =
80
+
let tz_pos = Tz.offset ~hours:5 ~minutes:30 in
81
+
Alcotest.(check string) "positive offset" "+05:30" (Tz.to_string tz_pos);
82
+
83
+
let tz_neg = Tz.offset ~hours:(-8) ~minutes:0 in
84
+
Alcotest.(check string) "negative offset" "-08:00" (Tz.to_string tz_neg);
85
+
86
+
let tz_zero = Tz.offset ~hours:0 ~minutes:0 in
87
+
Alcotest.(check string) "zero offset" "+00:00" (Tz.to_string tz_zero)
88
+
89
+
let test_tz_parse () =
90
+
(match Tz.of_string "+05:30" with
91
+
| Ok tz -> Alcotest.(check string) "parse +05:30" "+05:30" (Tz.to_string tz)
92
+
| Error e -> Alcotest.failf "failed to parse +05:30: %s" e);
93
+
94
+
(match Tz.of_string "-08:00" with
95
+
| Ok tz -> Alcotest.(check string) "parse -08:00" "-08:00" (Tz.to_string tz)
96
+
| Error e -> Alcotest.failf "failed to parse -08:00: %s" e);
97
+
98
+
(match Tz.of_string "z" with
99
+
| Ok tz -> Alcotest.(check bool) "parse lowercase z" true (Tz.equal tz Tz.utc)
100
+
| Error e -> Alcotest.failf "failed to parse z: %s" e)
101
+
102
+
let test_tz_compare () =
103
+
let tz1 = Tz.offset ~hours:5 ~minutes:0 in
104
+
let tz2 = Tz.offset ~hours:6 ~minutes:0 in
105
+
Alcotest.(check int) "compare less" (-1) (Int.compare (Tz.compare tz1 tz2) 0);
106
+
Alcotest.(check int) "compare greater" 1 (Int.compare (Tz.compare tz2 tz1) 0);
107
+
Alcotest.(check int) "compare equal" 0 (Tz.compare tz1 tz1);
108
+
Alcotest.(check int) "utc < offset" (-1) (Int.compare (Tz.compare Tz.utc tz1) 0)
109
+
110
+
(* ---- Date tests ---- *)
111
+
112
+
let test_date_basic () =
113
+
let d = Date.make ~year:2024 ~month:6 ~day:15 in
114
+
Alcotest.(check string) "to_string" "2024-06-15" (Date.to_string d);
115
+
Alcotest.(check int) "year" 2024 d.year;
116
+
Alcotest.(check int) "month" 6 d.month;
117
+
Alcotest.(check int) "day" 15 d.day
118
+
119
+
let test_date_equal () =
120
+
let d1 = Date.make ~year:2024 ~month:6 ~day:15 in
121
+
let d2 = Date.make ~year:2024 ~month:6 ~day:15 in
122
+
let d3 = Date.make ~year:2024 ~month:6 ~day:16 in
123
+
Alcotest.(check bool) "equal same" true (Date.equal d1 d2);
124
+
Alcotest.(check bool) "not equal diff day" false (Date.equal d1 d3)
125
+
126
+
let test_date_compare () =
127
+
let d1 = Date.make ~year:2024 ~month:6 ~day:15 in
128
+
let d2 = Date.make ~year:2024 ~month:6 ~day:16 in
129
+
let d3 = Date.make ~year:2024 ~month:7 ~day:1 in
130
+
let d4 = Date.make ~year:2025 ~month:1 ~day:1 in
131
+
Alcotest.(check int) "compare day" (-1) (Int.compare (Date.compare d1 d2) 0);
132
+
Alcotest.(check int) "compare month" (-1) (Int.compare (Date.compare d1 d3) 0);
133
+
Alcotest.(check int) "compare year" (-1) (Int.compare (Date.compare d1 d4) 0)
134
+
135
+
let test_date_parse () =
136
+
(match Date.of_string "2024-06-15" with
137
+
| Ok d ->
138
+
Alcotest.(check int) "year" 2024 d.year;
139
+
Alcotest.(check int) "month" 6 d.month;
140
+
Alcotest.(check int) "day" 15 d.day
141
+
| Error e -> Alcotest.failf "parse failed: %s" e);
142
+
143
+
(match Date.of_string "1979-05-27" with
144
+
| Ok d -> Alcotest.(check string) "roundtrip" "1979-05-27" (Date.to_string d)
145
+
| Error e -> Alcotest.failf "parse failed: %s" e)
146
+
147
+
let test_date_edge_cases () =
148
+
(* First day of year *)
149
+
let d1 = Date.make ~year:2024 ~month:1 ~day:1 in
150
+
Alcotest.(check string) "jan 1" "2024-01-01" (Date.to_string d1);
151
+
152
+
(* Last day of year *)
153
+
let d2 = Date.make ~year:2024 ~month:12 ~day:31 in
154
+
Alcotest.(check string) "dec 31" "2024-12-31" (Date.to_string d2);
155
+
156
+
(* Leading zeros in year *)
157
+
let d3 = Date.make ~year:99 ~month:1 ~day:1 in
158
+
Alcotest.(check string) "year 99" "0099-01-01" (Date.to_string d3)
159
+
160
+
(* ---- Time tests ---- *)
161
+
162
+
let test_time_basic () =
163
+
let t = Time.make ~hour:14 ~minute:30 ~second:45 () in
164
+
Alcotest.(check string) "to_string" "14:30:45" (Time.to_string t);
165
+
Alcotest.(check int) "hour" 14 t.hour;
166
+
Alcotest.(check int) "minute" 30 t.minute;
167
+
Alcotest.(check int) "second" 45 t.second;
168
+
Alcotest.(check (float 0.001)) "frac" 0.0 t.frac
169
+
170
+
let test_time_fractional () =
171
+
let t1 = Time.make ~hour:14 ~minute:30 ~second:45 ~frac:0.123 () in
172
+
Alcotest.(check string) "frac 3 digits" "14:30:45.123" (Time.to_string t1);
173
+
174
+
let t2 = Time.make ~hour:0 ~minute:0 ~second:0 ~frac:0.123456789 () in
175
+
Alcotest.(check string) "frac 9 digits" "00:00:00.123456789" (Time.to_string t2);
176
+
177
+
let t3 = Time.make ~hour:12 ~minute:0 ~second:0 ~frac:0.1 () in
178
+
Alcotest.(check string) "frac 1 digit" "12:00:00.1" (Time.to_string t3)
179
+
180
+
let test_time_equal () =
181
+
let t1 = Time.make ~hour:14 ~minute:30 ~second:45 () in
182
+
let t2 = Time.make ~hour:14 ~minute:30 ~second:45 () in
183
+
let t3 = Time.make ~hour:14 ~minute:30 ~second:46 () in
184
+
Alcotest.(check bool) "equal same" true (Time.equal t1 t2);
185
+
Alcotest.(check bool) "not equal" false (Time.equal t1 t3)
186
+
187
+
let test_time_compare () =
188
+
let t1 = Time.make ~hour:14 ~minute:30 ~second:45 () in
189
+
let t2 = Time.make ~hour:14 ~minute:30 ~second:46 () in
190
+
let t3 = Time.make ~hour:14 ~minute:31 ~second:0 () in
191
+
let t4 = Time.make ~hour:15 ~minute:0 ~second:0 () in
192
+
Alcotest.(check int) "compare second" (-1) (Int.compare (Time.compare t1 t2) 0);
193
+
Alcotest.(check int) "compare minute" (-1) (Int.compare (Time.compare t1 t3) 0);
194
+
Alcotest.(check int) "compare hour" (-1) (Int.compare (Time.compare t1 t4) 0)
195
+
196
+
let test_time_parse () =
197
+
(match Time.of_string "14:30:45" with
198
+
| Ok t ->
199
+
Alcotest.(check int) "hour" 14 t.hour;
200
+
Alcotest.(check int) "minute" 30 t.minute;
201
+
Alcotest.(check int) "second" 45 t.second
202
+
| Error e -> Alcotest.failf "parse failed: %s" e);
203
+
204
+
(match Time.of_string "00:00:00.123456" with
205
+
| Ok t ->
206
+
Alcotest.(check (float 0.000001)) "frac" 0.123456 t.frac
207
+
| Error e -> Alcotest.failf "parse failed: %s" e)
208
+
209
+
let test_time_edge_cases () =
210
+
let t1 = Time.make ~hour:0 ~minute:0 ~second:0 () in
211
+
Alcotest.(check string) "midnight" "00:00:00" (Time.to_string t1);
212
+
213
+
let t2 = Time.make ~hour:23 ~minute:59 ~second:59 () in
214
+
Alcotest.(check string) "end of day" "23:59:59" (Time.to_string t2)
215
+
216
+
(* ---- Datetime tests ---- *)
217
+
218
+
let test_datetime_basic () =
219
+
let dt = Datetime.make
220
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
221
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
222
+
~tz:Tz.utc
223
+
in
224
+
Alcotest.(check string) "to_string" "2024-06-15T14:30:00Z" (Datetime.to_string dt)
225
+
226
+
let test_datetime_with_offset () =
227
+
let dt = Datetime.make
228
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
229
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
230
+
~tz:(Tz.offset ~hours:5 ~minutes:30)
231
+
in
232
+
Alcotest.(check string) "with offset" "2024-06-15T14:30:00+05:30" (Datetime.to_string dt)
233
+
234
+
let test_datetime_with_frac () =
235
+
let dt = Datetime.make
236
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
237
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ~frac:0.123456 ())
238
+
~tz:Tz.utc
239
+
in
240
+
Alcotest.(check string) "with frac" "2024-06-15T14:30:00.123456Z" (Datetime.to_string dt)
241
+
242
+
let test_datetime_parse () =
243
+
(match Datetime.of_string "2024-06-15T14:30:00Z" with
244
+
| Ok dt ->
245
+
Alcotest.(check int) "year" 2024 dt.date.year;
246
+
Alcotest.(check int) "hour" 14 dt.time.hour;
247
+
Alcotest.(check bool) "tz" true (Tz.equal dt.tz Tz.utc)
248
+
| Error e -> Alcotest.failf "parse failed: %s" e);
249
+
250
+
(match Datetime.of_string "1979-05-27T07:32:00-08:00" with
251
+
| Ok dt ->
252
+
Alcotest.(check int) "year" 1979 dt.date.year;
253
+
Alcotest.(check string) "tz" "-08:00" (Tz.to_string dt.tz)
254
+
| Error e -> Alcotest.failf "parse failed: %s" e)
255
+
256
+
let test_datetime_equal_compare () =
257
+
let dt1 = Datetime.make
258
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
259
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
260
+
~tz:Tz.utc in
261
+
let dt2 = Datetime.make
262
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
263
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
264
+
~tz:Tz.utc in
265
+
let dt3 = Datetime.make
266
+
~date:(Date.make ~year:2024 ~month:6 ~day:16)
267
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
268
+
~tz:Tz.utc in
269
+
Alcotest.(check bool) "equal same" true (Datetime.equal dt1 dt2);
270
+
Alcotest.(check bool) "not equal" false (Datetime.equal dt1 dt3);
271
+
Alcotest.(check int) "compare" (-1) (Int.compare (Datetime.compare dt1 dt3) 0)
272
+
273
+
(* ---- Datetime_local tests ---- *)
274
+
275
+
let test_datetime_local_basic () =
276
+
let dt = Datetime_local.make
277
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
278
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
279
+
in
280
+
Alcotest.(check string) "to_string" "2024-06-15T14:30:00" (Datetime_local.to_string dt)
281
+
282
+
let test_datetime_local_parse () =
283
+
match Datetime_local.of_string "2024-06-15T14:30:00" with
284
+
| Ok dt ->
285
+
Alcotest.(check int) "year" 2024 dt.date.year;
286
+
Alcotest.(check int) "hour" 14 dt.time.hour
287
+
| Error e -> Alcotest.failf "parse failed: %s" e
288
+
289
+
let test_datetime_local_equal_compare () =
290
+
let dt1 = Datetime_local.make
291
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
292
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ()) in
293
+
let dt2 = Datetime_local.make
294
+
~date:(Date.make ~year:2024 ~month:6 ~day:15)
295
+
~time:(Time.make ~hour:14 ~minute:30 ~second:0 ()) in
296
+
Alcotest.(check bool) "equal" true (Datetime_local.equal dt1 dt2);
297
+
Alcotest.(check int) "compare" 0 (Datetime_local.compare dt1 dt2)
298
+
299
+
(* ============================================================================
300
+
Base Codec Tests
301
+
============================================================================ *)
302
+
303
+
(* ---- Bool codec ---- *)
304
+
305
+
let test_bool_codec () =
306
+
check_decode_ok "true" bool "value = true" true;
307
+
check_decode_ok "false" bool "value = false" false
308
+
309
+
let test_bool_roundtrip () =
310
+
check_roundtrip "true roundtrip" bool true;
311
+
check_roundtrip "false roundtrip" bool false
312
+
313
+
let test_bool_type_error () =
314
+
check_decode_error "string not bool" bool {|value = "true"|}
315
+
316
+
(* ---- Int codec ---- *)
317
+
318
+
let test_int_codec () =
319
+
check_decode_ok "positive" int "value = 42" 42;
320
+
check_decode_ok "negative" int "value = -17" (-17);
321
+
check_decode_ok "zero" int "value = 0" 0;
322
+
check_decode_ok "large" int "value = 1000000" 1000000
323
+
324
+
let test_int_formats () =
325
+
check_decode_ok "hex" int "value = 0xDEADBEEF" 0xDEADBEEF;
326
+
check_decode_ok "octal" int "value = 0o755" 0o755;
327
+
check_decode_ok "binary" int "value = 0b11010110" 0b11010110;
328
+
check_decode_ok "underscore" int "value = 1_000_000" 1_000_000
329
+
330
+
let test_int_roundtrip () =
331
+
check_roundtrip "positive" int 42;
332
+
check_roundtrip "negative" int (-17);
333
+
check_roundtrip "zero" int 0
334
+
335
+
let test_int_type_error () =
336
+
check_decode_error "float not int" int "value = 3.14";
337
+
check_decode_error "string not int" int {|value = "42"|}
338
+
339
+
(* ---- Int32 codec ---- *)
340
+
341
+
let test_int32_codec () =
342
+
check_decode_ok "positive" int32 "value = 42" 42l;
343
+
check_decode_ok "negative" int32 "value = -17" (-17l);
344
+
check_decode_ok "max" int32 "value = 2147483647" Int32.max_int;
345
+
check_decode_ok "min" int32 "value = -2147483648" Int32.min_int
346
+
347
+
let test_int32_roundtrip () =
348
+
check_roundtrip "positive" int32 42l;
349
+
check_roundtrip "max" int32 Int32.max_int;
350
+
check_roundtrip "min" int32 Int32.min_int
351
+
352
+
(* ---- Int64 codec ---- *)
353
+
354
+
let test_int64_codec () =
355
+
check_decode_ok "positive" int64 "value = 42" 42L;
356
+
check_decode_ok "large" int64 "value = 9223372036854775807" Int64.max_int;
357
+
check_decode_ok "large neg" int64 "value = -9223372036854775808" Int64.min_int
358
+
359
+
let test_int64_roundtrip () =
360
+
check_roundtrip "positive" int64 42L;
361
+
check_roundtrip "max" int64 Int64.max_int;
362
+
check_roundtrip "min" int64 Int64.min_int
363
+
364
+
(* ---- Float codec ---- *)
365
+
366
+
let test_float_codec () =
367
+
check_decode_ok "positive" float "value = 3.14" 3.14;
368
+
check_decode_ok "negative" float "value = -2.5" (-2.5);
369
+
check_decode_ok "zero" float "value = 0.0" 0.0;
370
+
check_decode_ok "exponent" float "value = 5e+22" 5e+22;
371
+
check_decode_ok "neg exponent" float "value = 1e-10" 1e-10
372
+
373
+
let test_float_special () =
374
+
check_decode_ok "inf" float "value = inf" Float.infinity;
375
+
check_decode_ok "neg inf" float "value = -inf" Float.neg_infinity;
376
+
check_decode_ok "pos inf" float "value = +inf" Float.infinity;
377
+
(* nan requires special handling since nan <> nan *)
378
+
let toml = Tomlt_bytesrw.parse "value = nan" in
379
+
let value = Toml.find "value" toml in
380
+
match decode float value with
381
+
| Ok f when Float.is_nan f -> ()
382
+
| Ok _ -> Alcotest.fail "expected nan"
383
+
| Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
384
+
385
+
let test_float_roundtrip () =
386
+
check_roundtrip "positive" float 3.14;
387
+
check_roundtrip "negative" float (-2.5);
388
+
check_roundtrip "zero" float 0.0
389
+
390
+
let test_float_type_error () =
391
+
check_decode_error "int not float" float "value = 42";
392
+
check_decode_error "string not float" float {|value = "3.14"|}
393
+
394
+
(* ---- Number codec ---- *)
395
+
396
+
let test_number_codec () =
397
+
check_decode_ok "float" number "value = 3.14" 3.14;
398
+
check_decode_ok "int as float" number "value = 42" 42.0;
399
+
check_decode_ok "negative int" number "value = -17" (-17.0)
400
+
401
+
let test_number_type_error () =
402
+
check_decode_error "string not number" number {|value = "42"|}
403
+
404
+
(* ---- String codec ---- *)
405
+
406
+
let test_string_codec () =
407
+
check_decode_ok "basic" string {|value = "hello"|} "hello";
408
+
check_decode_ok "empty" string {|value = ""|} "";
409
+
check_decode_ok "unicode" string {|value = "hello \u0048\u0065\u006C\u006C\u006F"|} "hello Hello"
410
+
411
+
let test_string_escapes () =
412
+
check_decode_ok "newline" string {|value = "line1\nline2"|} "line1\nline2";
413
+
check_decode_ok "tab" string {|value = "col1\tcol2"|} "col1\tcol2";
414
+
check_decode_ok "quote" string {|value = "say \"hello\""|} {|say "hello"|};
415
+
check_decode_ok "backslash" string {|value = "path\\to\\file"|} "path\\to\\file"
416
+
417
+
let test_string_multiline () =
418
+
check_decode_ok "multiline" string {|value = """
419
+
hello
420
+
world"""|} "hello\nworld";
421
+
check_decode_ok "literal" string "value = 'C:\\path\\to\\file'" "C:\\path\\to\\file"
422
+
423
+
let test_string_roundtrip () =
424
+
check_roundtrip "basic" string "hello";
425
+
check_roundtrip "empty" string "";
426
+
check_roundtrip "unicode" string "Hello, \xE4\xB8\x96\xE7\x95\x8C!"
427
+
428
+
let test_string_type_error () =
429
+
check_decode_error "int not string" string "value = 42";
430
+
check_decode_error "bool not string" string "value = true"
431
+
432
+
(* ============================================================================
433
+
Ptime Codec Tests
434
+
============================================================================ *)
435
+
436
+
(* ---- Ptime codecs ---- *)
437
+
438
+
let ptime_testable =
439
+
let pp fmt t = Format.fprintf fmt "%s" (Ptime.to_rfc3339 ~tz_offset_s:0 t) in
440
+
Alcotest.testable pp Ptime.equal
441
+
442
+
let ptime_date_testable =
443
+
let pp fmt (y, m, d) = Format.fprintf fmt "%04d-%02d-%02d" y m d in
444
+
let eq (y1, m1, d1) (y2, m2, d2) = y1 = y2 && m1 = m2 && d1 = d2 in
445
+
Alcotest.testable pp eq
446
+
447
+
let ptime_span_testable =
448
+
let pp fmt span = Format.fprintf fmt "%f" (Ptime.Span.to_float_s span) in
449
+
let eq a b = Float.abs (Ptime.Span.to_float_s a -. Ptime.Span.to_float_s b) < 0.001 in
450
+
Alcotest.testable pp eq
451
+
452
+
let test_ptime_codec () =
453
+
let input = "value = 2024-06-15T14:30:00Z" in
454
+
let expected = match Ptime.of_date_time ((2024, 6, 15), ((14, 30, 0), 0)) with
455
+
| Some t -> t | None -> failwith "invalid test datetime" in
456
+
let toml = Tomlt_bytesrw.parse input in
457
+
let value = Toml.find "value" toml in
458
+
match decode (ptime ()) value with
459
+
| Ok v -> Alcotest.(check ptime_testable) "ptime" expected v
460
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
461
+
462
+
let test_ptime_codec_offset () =
463
+
(* Test parsing datetime with offset and verify UTC conversion *)
464
+
let input = "value = 1979-05-27T00:32:00-07:00" in
465
+
(* UTC time should be 1979-05-27T07:32:00Z *)
466
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
467
+
| Some t -> t | None -> failwith "invalid test datetime" in
468
+
let toml = Tomlt_bytesrw.parse input in
469
+
let value = Toml.find "value" toml in
470
+
match decode (ptime ()) value with
471
+
| Ok v -> Alcotest.(check ptime_testable) "ptime with offset" expected v
472
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
473
+
474
+
let test_ptime_codec_roundtrip () =
475
+
let original = match Ptime.of_date_time ((2024, 12, 19), ((15, 30, 45), 0)) with
476
+
| Some t -> t | None -> failwith "invalid test datetime" in
477
+
let toml = encode (ptime ()) original in
478
+
match decode (ptime ()) toml with
479
+
| Ok v -> Alcotest.(check ptime_testable) "roundtrip" original v
480
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
481
+
482
+
let test_ptime_codec_optional_seconds () =
483
+
(* TOML 1.1 allows optional seconds *)
484
+
let input = "value = 1979-05-27T07:32Z" in
485
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
486
+
| Some t -> t | None -> failwith "invalid test datetime" in
487
+
let toml = Tomlt_bytesrw.parse input in
488
+
let value = Toml.find "value" toml in
489
+
match decode (ptime ()) value with
490
+
| Ok v -> Alcotest.(check ptime_testable) "optional seconds" expected v
491
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
492
+
493
+
let test_ptime_opt_codec () =
494
+
(* ptime_opt only accepts offset datetimes *)
495
+
let input = "value = 1979-05-27T07:32:00Z" in
496
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
497
+
| Some t -> t | None -> failwith "invalid test datetime" in
498
+
let toml = Tomlt_bytesrw.parse input in
499
+
let value = Toml.find "value" toml in
500
+
match decode (ptime_opt ()) value with
501
+
| Ok t -> Alcotest.(check ptime_testable) "ptime_opt" expected t
502
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
503
+
504
+
let test_ptime_opt_rejects_local () =
505
+
(* ptime_opt should reject local datetime *)
506
+
let input = "value = 1979-05-27T07:32:00" in
507
+
let toml = Tomlt_bytesrw.parse input in
508
+
let value = Toml.find "value" toml in
509
+
match decode (ptime_opt ()) value with
510
+
| Ok _ -> Alcotest.fail "expected error for local datetime"
511
+
| Error _ -> ()
512
+
513
+
let test_ptime_span_codec () =
514
+
let input = "value = 14:30:45" in
515
+
let expected = match Ptime.Span.of_float_s (14.0 *. 3600.0 +. 30.0 *. 60.0 +. 45.0) with
516
+
| Some s -> s | None -> failwith "invalid span" in
517
+
let toml = Tomlt_bytesrw.parse input in
518
+
let value = Toml.find "value" toml in
519
+
match decode ptime_span value with
520
+
| Ok span -> Alcotest.(check ptime_span_testable) "span" expected span
521
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
522
+
523
+
let test_ptime_span_roundtrip () =
524
+
let original = match Ptime.Span.of_float_s (7.0 *. 3600.0 +. 32.0 *. 60.0) with
525
+
| Some s -> s | None -> failwith "invalid span" in
526
+
let toml = encode ptime_span original in
527
+
match decode ptime_span toml with
528
+
| Ok v -> Alcotest.(check ptime_span_testable) "roundtrip" original v
529
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
530
+
531
+
let test_ptime_date_codec () =
532
+
let input = "value = 1979-05-27" in
533
+
let toml = Tomlt_bytesrw.parse input in
534
+
let value = Toml.find "value" toml in
535
+
match decode ptime_date value with
536
+
| Ok date -> Alcotest.(check ptime_date_testable) "date" (1979, 5, 27) date
537
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
538
+
539
+
let test_ptime_date_roundtrip () =
540
+
let original = (2024, 12, 19) in
541
+
let toml = encode ptime_date original in
542
+
match decode ptime_date toml with
543
+
| Ok v -> Alcotest.(check ptime_date_testable) "roundtrip" original v
544
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
545
+
546
+
let test_ptime_local_datetime () =
547
+
(* The new ptime () codec accepts local datetime and uses provided tz *)
548
+
let input = "value = 1979-05-27T07:32:00" in
549
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
550
+
| Some t -> t | None -> failwith "invalid test datetime" in
551
+
let toml = Tomlt_bytesrw.parse input in
552
+
let value = Toml.find "value" toml in
553
+
match decode (ptime ~tz_offset_s:0 ()) value with
554
+
| Ok v -> Alcotest.(check ptime_testable) "local datetime" expected v
555
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
556
+
557
+
let test_ptime_date_as_ptime () =
558
+
(* The new ptime () codec accepts date and assumes midnight *)
559
+
let input = "value = 1979-05-27" in
560
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((0, 0, 0), 0)) with
561
+
| Some t -> t | None -> failwith "invalid test datetime" in
562
+
let toml = Tomlt_bytesrw.parse input in
563
+
let value = Toml.find "value" toml in
564
+
match decode (ptime ~tz_offset_s:0 ()) value with
565
+
| Ok v -> Alcotest.(check ptime_testable) "date as ptime" expected v
566
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
567
+
568
+
(* ---- Unified ptime_full codec ---- *)
569
+
570
+
let ptime_full_testable =
571
+
Alcotest.testable Toml.pp_ptime_datetime (fun a b ->
572
+
match a, b with
573
+
| `Datetime (t1, tz1), `Datetime (t2, tz2) ->
574
+
Ptime.equal t1 t2 && tz1 = tz2
575
+
| `Datetime_local t1, `Datetime_local t2 ->
576
+
Ptime.equal t1 t2
577
+
| `Date d1, `Date d2 -> d1 = d2
578
+
| `Time t1, `Time t2 -> t1 = t2
579
+
| _ -> false)
580
+
581
+
let test_ptime_full_offset () =
582
+
let input = "value = 1979-05-27T07:32:00Z" in
583
+
let toml = Tomlt_bytesrw.parse input in
584
+
let value = Toml.find "value" toml in
585
+
match decode (ptime_full ()) value with
586
+
| Ok (`Datetime (ptime, Some 0)) ->
587
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
588
+
| Some t -> t | None -> failwith "invalid datetime" in
589
+
Alcotest.(check ptime_testable) "ptime" expected ptime
590
+
| Ok other -> Alcotest.failf "expected `Datetime, got %a" Toml.pp_ptime_datetime other
591
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
592
+
593
+
let test_ptime_full_local_datetime () =
594
+
let input = "value = 1979-05-27T07:32:00" in
595
+
let toml = Tomlt_bytesrw.parse input in
596
+
let value = Toml.find "value" toml in
597
+
match decode (ptime_full ~tz_offset_s:0 ()) value with
598
+
| Ok (`Datetime_local ptime) ->
599
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
600
+
| Some t -> t | None -> failwith "invalid datetime" in
601
+
Alcotest.(check ptime_testable) "ptime" expected ptime
602
+
| Ok other -> Alcotest.failf "expected `Datetime_local, got %a" Toml.pp_ptime_datetime other
603
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
604
+
605
+
let test_ptime_full_date () =
606
+
let input = "value = 1979-05-27" in
607
+
let toml = Tomlt_bytesrw.parse input in
608
+
let value = Toml.find "value" toml in
609
+
match decode (ptime_full ()) value with
610
+
| Ok (`Date (y, m, d)) ->
611
+
Alcotest.(check int) "year" 1979 y;
612
+
Alcotest.(check int) "month" 5 m;
613
+
Alcotest.(check int) "day" 27 d
614
+
| Ok other -> Alcotest.failf "expected `Date, got %a" Toml.pp_ptime_datetime other
615
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
616
+
617
+
let test_ptime_full_time () =
618
+
let input = "value = 07:32:00" in
619
+
let toml = Tomlt_bytesrw.parse input in
620
+
let value = Toml.find "value" toml in
621
+
match decode (ptime_full ()) value with
622
+
| Ok (`Time (h, m, s, ns)) ->
623
+
Alcotest.(check int) "hour" 7 h;
624
+
Alcotest.(check int) "minute" 32 m;
625
+
Alcotest.(check int) "second" 0 s;
626
+
Alcotest.(check int) "nanoseconds" 0 ns
627
+
| Ok other -> Alcotest.failf "expected `Time, got %a" Toml.pp_ptime_datetime other
628
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
629
+
630
+
let test_ptime_full_roundtrip () =
631
+
let original : Toml.ptime_datetime = `Datetime (
632
+
(match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
633
+
| Some t -> t | None -> failwith "invalid datetime"),
634
+
Some 0
635
+
) in
636
+
let toml = encode (ptime_full ()) original in
637
+
match decode (ptime_full ()) toml with
638
+
| Ok result -> Alcotest.(check ptime_full_testable) "roundtrip" original result
639
+
| Error e -> Alcotest.fail (Toml.Error.to_string e)
640
+
641
+
(* ============================================================================
642
+
Combinator Tests
643
+
============================================================================ *)
644
+
645
+
(* ---- Map combinator ---- *)
646
+
647
+
let uppercase_string =
648
+
map string ~dec:String.uppercase_ascii ~enc:String.lowercase_ascii
649
+
650
+
let test_map_combinator () =
651
+
check_decode_ok "uppercase" uppercase_string {|value = "hello"|} "HELLO"
652
+
653
+
let test_map_roundtrip () =
654
+
check_roundtrip "map roundtrip" uppercase_string "HELLO"
655
+
656
+
let doubled_int =
657
+
map int ~dec:(fun x -> x * 2) ~enc:(fun x -> x / 2)
658
+
659
+
let test_map_int () =
660
+
check_decode_ok "doubled" doubled_int "value = 21" 42;
661
+
check_roundtrip "doubled roundtrip" doubled_int 42
662
+
663
+
(* ---- Const combinator ---- *)
664
+
665
+
let test_const () =
666
+
let c = const "default_value" in
667
+
check_decode_ok "const ignores input" c "value = 42" "default_value";
668
+
check_decode_ok "const ignores string" c {|value = "ignored"|} "default_value"
669
+
670
+
(* ---- Enum combinator ---- *)
671
+
672
+
type level = Debug | Info | Warn | Error
673
+
674
+
let level_codec =
675
+
enum [
676
+
"debug", Debug;
677
+
"info", Info;
678
+
"warn", Warn;
679
+
"error", Error;
680
+
]
681
+
682
+
let test_enum () =
683
+
check_decode_ok "debug" level_codec {|value = "debug"|} Debug;
684
+
check_decode_ok "info" level_codec {|value = "info"|} Info;
685
+
check_decode_ok "warn" level_codec {|value = "warn"|} Warn;
686
+
check_decode_ok "error" level_codec {|value = "error"|} Error
687
+
688
+
let test_enum_roundtrip () =
689
+
check_roundtrip "debug" level_codec Debug;
690
+
check_roundtrip "error" level_codec Error
691
+
692
+
let test_enum_unknown () =
693
+
check_decode_error "unknown value" level_codec {|value = "trace"|}
694
+
695
+
let test_enum_type_error () =
696
+
check_decode_error "not string" level_codec "value = 42"
697
+
698
+
(* ---- Option combinator ---- *)
699
+
700
+
let test_option_codec () =
701
+
let opt_int = option int in
702
+
check_decode_ok "some" opt_int "value = 42" (Some 42)
703
+
704
+
let test_option_roundtrip () =
705
+
let opt_str = option string in
706
+
check_roundtrip "some string" opt_str (Some "hello")
707
+
708
+
(* ---- Result combinator ---- *)
709
+
710
+
let string_or_int_codec : (string, int) result t = result ~ok:string ~error:int
711
+
712
+
let test_result_codec () =
713
+
check_decode_ok "ok string" string_or_int_codec {|value = "hello"|} (Ok "hello");
714
+
check_decode_ok "error int" string_or_int_codec "value = 42" (Error 42)
715
+
716
+
let test_result_roundtrip () =
717
+
check_roundtrip "ok" string_or_int_codec (Ok "hello");
718
+
check_roundtrip "error" string_or_int_codec (Error 42)
719
+
720
+
(* ---- Recursive codec ---- *)
721
+
722
+
(* Simple recursive structure for testing rec' *)
723
+
type nested_list = {
724
+
value : int;
725
+
next : nested_list option;
726
+
}
727
+
728
+
let rec nested_list_codec = lazy (
729
+
Table.(
730
+
obj (fun value next -> { value; next })
731
+
|> mem "value" int ~enc:(fun n -> n.value)
732
+
|> opt_mem "next" (rec' nested_list_codec) ~enc:(fun n -> n.next)
733
+
|> finish
734
+
)
735
+
)
736
+
737
+
let test_recursive_codec () =
738
+
let input = {|
739
+
[value]
740
+
value = 1
741
+
742
+
[value.next]
743
+
value = 2
744
+
745
+
[value.next.next]
746
+
value = 3
747
+
|} in
748
+
let expected = {
749
+
value = 1;
750
+
next = Some {
751
+
value = 2;
752
+
next = Some { value = 3; next = None }
753
+
}
754
+
} in
755
+
check_decode_table_ok "nested list" (rec' nested_list_codec) input expected
756
+
757
+
(* ============================================================================
758
+
Array Codec Tests
759
+
============================================================================ *)
760
+
761
+
let test_list_codec () =
762
+
check_decode_ok "int list" (list int) "value = [1, 2, 3]" [1; 2; 3];
763
+
check_decode_ok "empty list" (list int) "value = []" [];
764
+
check_decode_ok "string list" (list string) {|value = ["a", "b", "c"]|} ["a"; "b"; "c"]
765
+
766
+
let test_list_roundtrip () =
767
+
check_roundtrip "int list" (list int) [1; 2; 3];
768
+
check_roundtrip "empty" (list int) [];
769
+
check_roundtrip "strings" (list string) ["hello"; "world"]
770
+
771
+
let test_array_codec () =
772
+
check_decode_ok "int array" (array int) "value = [1, 2, 3]" [|1; 2; 3|];
773
+
check_decode_ok "empty array" (array int) "value = []" [||]
774
+
775
+
let test_array_roundtrip () =
776
+
check_roundtrip "int array" (array int) [|1; 2; 3|];
777
+
check_roundtrip "empty" (array int) [||]
778
+
779
+
let test_nested_list () =
780
+
let nested = list (list int) in
781
+
check_decode_ok "nested" nested "value = [[1, 2], [3, 4], [5]]" [[1; 2]; [3; 4]; [5]];
782
+
check_roundtrip "nested roundtrip" nested [[1; 2]; [3; 4]]
783
+
784
+
let test_list_of_tables () =
785
+
let point_codec = Table.(
786
+
obj (fun x y -> (x, y))
787
+
|> mem "x" int ~enc:fst
788
+
|> mem "y" int ~enc:snd
789
+
|> finish
790
+
) in
791
+
let points_codec = list point_codec in
792
+
let input = {|value = [{x = 1, y = 2}, {x = 3, y = 4}]|} in
793
+
check_decode_ok "list of inline tables" points_codec input [(1, 2); (3, 4)]
794
+
795
+
let test_list_type_error () =
796
+
check_decode_error "not array" (list int) "value = 42";
797
+
check_decode_error "mixed types" (list int) {|value = [1, "two", 3]|}
798
+
799
+
(* ============================================================================
800
+
Table Codec Tests
801
+
============================================================================ *)
802
+
803
+
(* ---- Basic table ---- *)
804
+
805
+
type point = { x : int; y : int }
806
+
807
+
let point_codec =
808
+
Table.(
809
+
obj (fun x y -> { x; y })
810
+
|> mem "x" int ~enc:(fun p -> p.x)
811
+
|> mem "y" int ~enc:(fun p -> p.y)
812
+
|> finish
813
+
)
814
+
815
+
let test_table_codec () =
816
+
let input = {|
817
+
[value]
818
+
x = 10
819
+
y = 20
820
+
|} in
821
+
check_decode_table_ok "point" point_codec input { x = 10; y = 20 }
822
+
823
+
let test_table_roundtrip () =
824
+
check_roundtrip "point roundtrip" point_codec { x = 5; y = 15 }
825
+
826
+
let test_table_missing_member () =
827
+
let input = {|
828
+
[value]
829
+
x = 10
830
+
|} in
831
+
check_decode_table_error "missing y" point_codec input
832
+
833
+
let test_table_type_error () =
834
+
check_decode_error "not table" point_codec "value = 42"
835
+
836
+
(* ---- Optional members ---- *)
837
+
838
+
type config = {
839
+
name : string;
840
+
debug : bool;
841
+
timeout : int option;
842
+
}
843
+
844
+
let config_codec =
845
+
Table.(
846
+
obj (fun name debug timeout -> { name; debug; timeout })
847
+
|> mem "name" string ~enc:(fun c -> c.name)
848
+
|> mem "debug" bool ~enc:(fun c -> c.debug) ~dec_absent:false
849
+
|> opt_mem "timeout" int ~enc:(fun c -> c.timeout)
850
+
|> finish
851
+
)
852
+
853
+
let test_optional_members () =
854
+
let input1 = {|
855
+
[value]
856
+
name = "test"
857
+
debug = true
858
+
timeout = 30
859
+
|} in
860
+
check_decode_table_ok "with all" config_codec input1
861
+
{ name = "test"; debug = true; timeout = Some 30 };
862
+
863
+
let input2 = {|
864
+
[value]
865
+
name = "test"
866
+
|} in
867
+
check_decode_table_ok "with defaults" config_codec input2
868
+
{ name = "test"; debug = false; timeout = None }
869
+
870
+
let test_optional_roundtrip () =
871
+
let c1 = { name = "app"; debug = true; timeout = Some 60 } in
872
+
check_roundtrip "with timeout" config_codec c1;
873
+
874
+
let c2 = { name = "app"; debug = false; timeout = None } in
875
+
check_roundtrip "without timeout" config_codec c2
876
+
877
+
let test_opt_mem_omits_none () =
878
+
let c = { name = "app"; debug = false; timeout = None } in
879
+
let toml = encode config_codec c in
880
+
(* Just verify encoding doesn't crash *)
881
+
let _ = toml_to_string toml in
882
+
(* Verify None is not encoded *)
883
+
match Toml.find_opt "timeout" toml with
884
+
| None -> ()
885
+
| Some _ -> Alcotest.fail "timeout should not be encoded when None"
886
+
887
+
(* ---- enc_omit ---- *)
888
+
889
+
type with_omit = {
890
+
always : string;
891
+
maybe : string;
892
+
}
893
+
894
+
let with_omit_codec =
895
+
Table.(
896
+
obj (fun always maybe -> { always; maybe })
897
+
|> mem "always" string ~enc:(fun r -> r.always)
898
+
|> mem "maybe" string ~enc:(fun r -> r.maybe)
899
+
~dec_absent:"" ~enc_omit:(fun s -> String.length s = 0)
900
+
|> finish
901
+
)
902
+
903
+
let test_enc_omit () =
904
+
let r1 = { always = "hello"; maybe = "world" } in
905
+
let toml1 = encode with_omit_codec r1 in
906
+
(match Toml.find_opt "maybe" toml1 with
907
+
| Some _ -> ()
908
+
| None -> Alcotest.fail "maybe should be encoded when non-empty");
909
+
910
+
let r2 = { always = "hello"; maybe = "" } in
911
+
let toml2 = encode with_omit_codec r2 in
912
+
(match Toml.find_opt "maybe" toml2 with
913
+
| None -> ()
914
+
| Some _ -> Alcotest.fail "maybe should be omitted when empty")
915
+
916
+
(* ---- Nested tables ---- *)
917
+
918
+
type server = {
919
+
host : string;
920
+
port : int;
921
+
}
922
+
923
+
type app_config = {
924
+
title : string;
925
+
server : server;
926
+
}
927
+
928
+
let server_codec =
929
+
Table.(
930
+
obj (fun host port -> { host; port })
931
+
|> mem "host" string ~enc:(fun s -> s.host)
932
+
|> mem "port" int ~enc:(fun s -> s.port)
933
+
|> finish
934
+
)
935
+
936
+
let app_config_codec =
937
+
Table.(
938
+
obj (fun title server -> { title; server })
939
+
|> mem "title" string ~enc:(fun c -> c.title)
940
+
|> mem "server" server_codec ~enc:(fun c -> c.server)
941
+
|> finish
942
+
)
943
+
944
+
let test_nested_tables () =
945
+
let input = {|
946
+
[value]
947
+
title = "My App"
948
+
949
+
[value.server]
950
+
host = "localhost"
951
+
port = 8080
952
+
|} in
953
+
check_decode_table_ok "nested" app_config_codec input
954
+
{ title = "My App"; server = { host = "localhost"; port = 8080 } }
955
+
956
+
let test_nested_roundtrip () =
957
+
let config = {
958
+
title = "Production";
959
+
server = { host = "0.0.0.0"; port = 443 };
960
+
} in
961
+
check_roundtrip "nested roundtrip" app_config_codec config
962
+
963
+
(* ---- Deeply nested tables ---- *)
964
+
965
+
type deep = {
966
+
a : int;
967
+
inner : deep option;
968
+
}
969
+
970
+
let rec deep_codec = lazy (
971
+
Table.(
972
+
obj (fun a inner -> { a; inner })
973
+
|> mem "a" int ~enc:(fun d -> d.a)
974
+
|> opt_mem "inner" (rec' deep_codec) ~enc:(fun d -> d.inner)
975
+
|> finish
976
+
)
977
+
)
978
+
979
+
let test_deeply_nested () =
980
+
let input = {|
981
+
[value]
982
+
a = 1
983
+
984
+
[value.inner]
985
+
a = 2
986
+
987
+
[value.inner.inner]
988
+
a = 3
989
+
|} in
990
+
let expected = {
991
+
a = 1;
992
+
inner = Some {
993
+
a = 2;
994
+
inner = Some { a = 3; inner = None }
995
+
}
996
+
} in
997
+
check_decode_table_ok "deep" (rec' deep_codec) input expected
998
+
999
+
(* ---- Unknown member handling ---- *)
1000
+
1001
+
type strict_config = {
1002
+
name : string;
1003
+
}
1004
+
1005
+
let strict_config_codec =
1006
+
Table.(
1007
+
obj (fun name -> { name })
1008
+
|> mem "name" string ~enc:(fun c -> c.name)
1009
+
|> error_unknown
1010
+
|> finish
1011
+
)
1012
+
1013
+
let test_error_unknown () =
1014
+
let input1 = {|
1015
+
[value]
1016
+
name = "test"
1017
+
|} in
1018
+
check_decode_table_ok "known only" strict_config_codec input1 { name = "test" };
1019
+
1020
+
(* error_unknown raises an exception for unknown members *)
1021
+
let input2 = {|
1022
+
[value]
1023
+
name = "test"
1024
+
extra = 42
1025
+
|} in
1026
+
let toml = Tomlt_bytesrw.parse input2 in
1027
+
let value_toml = Toml.find "value" toml in
1028
+
try
1029
+
let _ = decode strict_config_codec value_toml in
1030
+
Alcotest.fail "expected exception for unknown member"
1031
+
with Toml.Error.Error _ -> ()
1032
+
1033
+
type extensible_config = {
1034
+
name : string;
1035
+
extras : (string * Toml.t) list;
1036
+
}
1037
+
1038
+
let extensible_config_codec =
1039
+
Table.(
1040
+
obj (fun name extras -> { name; extras })
1041
+
|> mem "name" string ~enc:(fun c -> c.name)
1042
+
|> keep_unknown (Mems.assoc value) ~enc:(fun c -> c.extras)
1043
+
|> finish
1044
+
)
1045
+
1046
+
let test_keep_unknown () =
1047
+
let input = {|
1048
+
[value]
1049
+
name = "test"
1050
+
extra1 = 42
1051
+
extra2 = "hello"
1052
+
|} in
1053
+
let toml = Tomlt_bytesrw.parse input in
1054
+
let value_toml = Toml.find "value" toml in
1055
+
match decode extensible_config_codec value_toml with
1056
+
| Ok c ->
1057
+
Alcotest.(check string) "name" "test" c.name;
1058
+
Alcotest.(check int) "extras count" 2 (List.length c.extras);
1059
+
(* Check extras contains the unknown members *)
1060
+
let has_extra1 = List.exists (fun (k, _) -> k = "extra1") c.extras in
1061
+
let has_extra2 = List.exists (fun (k, _) -> k = "extra2") c.extras in
1062
+
Alcotest.(check bool) "has extra1" true has_extra1;
1063
+
Alcotest.(check bool) "has extra2" true has_extra2
1064
+
| Error e ->
1065
+
Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1066
+
1067
+
let test_keep_unknown_roundtrip () =
1068
+
let c = {
1069
+
name = "test";
1070
+
extras = [("custom", Toml.Int 42L); ("flag", Toml.Bool true)]
1071
+
} in
1072
+
check_roundtrip "keep_unknown roundtrip" extensible_config_codec c
1073
+
1074
+
(* ---- Skip unknown (default) ---- *)
1075
+
1076
+
type lenient_config = {
1077
+
lname : string;
1078
+
}
1079
+
1080
+
let lenient_codec =
1081
+
Table.(
1082
+
obj (fun lname -> { lname })
1083
+
|> mem "name" string ~enc:(fun c -> c.lname)
1084
+
|> skip_unknown
1085
+
|> finish
1086
+
)
1087
+
1088
+
let test_skip_unknown () =
1089
+
let input = {|
1090
+
[value]
1091
+
name = "test"
1092
+
ignored = 42
1093
+
also_ignored = "hello"
1094
+
|} in
1095
+
check_decode_table_ok "skip unknown" lenient_codec input { lname = "test" }
1096
+
1097
+
(* ============================================================================
1098
+
Array of Tables Tests
1099
+
============================================================================ *)
1100
+
1101
+
type product = {
1102
+
name : string;
1103
+
price : float;
1104
+
}
1105
+
1106
+
let product_codec =
1107
+
Table.(
1108
+
obj (fun name price -> { name; price })
1109
+
|> mem "name" string ~enc:(fun p -> p.name)
1110
+
|> mem "price" float ~enc:(fun p -> p.price)
1111
+
|> finish
1112
+
)
1113
+
1114
+
let test_array_of_tables () =
1115
+
let products_codec = array_of_tables product_codec in
1116
+
let input = {|
1117
+
[[value]]
1118
+
name = "Apple"
1119
+
price = 1.50
1120
+
1121
+
[[value]]
1122
+
name = "Banana"
1123
+
price = 0.75
1124
+
|} in
1125
+
let expected = [
1126
+
{ name = "Apple"; price = 1.50 };
1127
+
{ name = "Banana"; price = 0.75 };
1128
+
] in
1129
+
check_decode_ok "products" products_codec input expected
1130
+
1131
+
let test_array_of_tables_roundtrip () =
1132
+
let products_codec = array_of_tables product_codec in
1133
+
let products = [
1134
+
{ name = "Apple"; price = 1.50 };
1135
+
{ name = "Banana"; price = 0.75 };
1136
+
] in
1137
+
check_roundtrip "products roundtrip" products_codec products
1138
+
1139
+
let test_array_of_tables_empty () =
1140
+
let products_codec = array_of_tables product_codec in
1141
+
check_decode_ok "empty" products_codec "value = []" []
1142
+
1143
+
(* ============================================================================
1144
+
Any/Value Codec Tests
1145
+
============================================================================ *)
1146
+
1147
+
let test_value_codec () =
1148
+
check_decode_ok "int" value "value = 42" (Toml.Int 42L);
1149
+
check_decode_ok "string" value {|value = "hello"|} (Toml.String "hello");
1150
+
check_decode_ok "bool" value "value = true" (Toml.Bool true);
1151
+
check_decode_ok "float" value "value = 3.14" (Toml.Float 3.14);
1152
+
check_decode_ok "array" value "value = [1, 2, 3]"
1153
+
(Toml.Array [Toml.Int 1L; Toml.Int 2L; Toml.Int 3L])
1154
+
1155
+
let test_value_roundtrip () =
1156
+
check_roundtrip "int" value (Toml.Int 42L);
1157
+
check_roundtrip "string" value (Toml.String "hello");
1158
+
check_roundtrip "bool" value (Toml.Bool true)
1159
+
1160
+
let test_value_mems_codec () =
1161
+
let input = {|
1162
+
[value]
1163
+
a = 1
1164
+
b = "hello"
1165
+
c = true
1166
+
|} in
1167
+
let toml = Tomlt_bytesrw.parse input in
1168
+
let v = Toml.find "value" toml in
1169
+
match decode value_mems v with
1170
+
| Ok pairs ->
1171
+
Alcotest.(check int) "count" 3 (List.length pairs);
1172
+
let has_a = List.exists (fun (k, _) -> k = "a") pairs in
1173
+
let has_b = List.exists (fun (k, _) -> k = "b") pairs in
1174
+
let has_c = List.exists (fun (k, _) -> k = "c") pairs in
1175
+
Alcotest.(check bool) "has a" true has_a;
1176
+
Alcotest.(check bool) "has b" true has_b;
1177
+
Alcotest.(check bool) "has c" true has_c
1178
+
| Error e ->
1179
+
Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1180
+
1181
+
type string_or_int_any = String of string | Int of int
1182
+
1183
+
let string_or_int_any_codec =
1184
+
any ()
1185
+
~dec_string:(map string ~dec:(fun s -> String s))
1186
+
~dec_int:(map int ~dec:(fun i -> Int i))
1187
+
~enc:(function
1188
+
| String _ -> map string ~enc:(function String s -> s | _ -> "")
1189
+
| Int _ -> map int ~enc:(function Int i -> i | _ -> 0))
1190
+
1191
+
let test_any_codec () =
1192
+
check_decode_ok "string" string_or_int_any_codec {|value = "hello"|} (String "hello");
1193
+
check_decode_ok "int" string_or_int_any_codec "value = 42" (Int 42)
1194
+
1195
+
let test_any_type_error () =
1196
+
check_decode_error "bool not handled" string_or_int_any_codec "value = true"
1197
+
1198
+
(* ============================================================================
1199
+
Encoding/Decoding Function Tests
1200
+
============================================================================ *)
1201
+
1202
+
let test_decode_string () =
1203
+
let toml_str = {|name = "test"|} in
1204
+
let codec = Table.(
1205
+
obj (fun name -> name)
1206
+
|> mem "name" string ~enc:Fun.id
1207
+
|> finish
1208
+
) in
1209
+
match Tomlt_bytesrw.decode_string codec toml_str with
1210
+
| Ok name -> Alcotest.(check string) "name" "test" name
1211
+
| Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1212
+
1213
+
let test_decode_string_exn () =
1214
+
let toml_str = {|value = 42|} in
1215
+
let toml = Tomlt_bytesrw.parse toml_str in
1216
+
let v = Toml.find "value" toml in
1217
+
let result = decode_exn int v in
1218
+
Alcotest.(check int) "value" 42 result
1219
+
1220
+
let test_encode_string () =
1221
+
let codec = Table.(
1222
+
obj (fun name -> name)
1223
+
|> mem "name" string ~enc:Fun.id
1224
+
|> finish
1225
+
) in
1226
+
let s = Tomlt_bytesrw.encode_string codec "test" in
1227
+
(* Just verify it produces valid TOML *)
1228
+
let _ = Tomlt_bytesrw.parse s in
1229
+
()
1230
+
1231
+
(* ============================================================================
1232
+
Edge Cases and Error Handling
1233
+
============================================================================ *)
1234
+
1235
+
let test_empty_table () =
1236
+
let empty_codec = Table.(
1237
+
obj ()
1238
+
|> finish
1239
+
) in
1240
+
let input = "[value]" in
1241
+
check_decode_table_ok "empty table" empty_codec input ()
1242
+
1243
+
let test_unicode_keys () =
1244
+
let codec = Table.(
1245
+
obj (fun v -> v)
1246
+
|> mem "\xE4\xB8\xAD\xE6\x96\x87" string ~enc:Fun.id (* "中文" in UTF-8 *)
1247
+
|> finish
1248
+
) in
1249
+
let input = {|
1250
+
[value]
1251
+
"中文" = "hello"
1252
+
|} in
1253
+
check_decode_table_ok "unicode key" codec input "hello"
1254
+
1255
+
let test_special_string_values () =
1256
+
check_decode_ok "empty" string {|value = ""|} "";
1257
+
check_decode_ok "spaces" string {|value = " "|} " ";
1258
+
check_decode_ok "newlines" string {|value = "a\nb\nc"|} "a\nb\nc"
1259
+
1260
+
let test_large_integers () =
1261
+
check_decode_ok "large" int64 "value = 9007199254740992" 9007199254740992L;
1262
+
check_decode_ok "max i64" int64 "value = 9223372036854775807" 9223372036854775807L
1263
+
1264
+
let test_codec_kind_doc () =
1265
+
Alcotest.(check string) "bool kind" "boolean" (kind bool);
1266
+
Alcotest.(check string) "int kind" "integer" (kind int);
1267
+
Alcotest.(check string) "string kind" "string" (kind string);
1268
+
Alcotest.(check string) "float kind" "float" (kind float);
1269
+
1270
+
let documented = with_doc ~kind:"custom" ~doc:"A custom codec" int in
1271
+
Alcotest.(check string) "custom kind" "custom" (kind documented);
1272
+
Alcotest.(check string) "custom doc" "A custom codec" (doc documented)
1273
+
1274
+
let test_duplicate_member_error () =
1275
+
try
1276
+
let _ = Table.(
1277
+
obj (fun a b -> (a, b))
1278
+
|> mem "same" int ~enc:fst
1279
+
|> mem "same" int ~enc:snd
1280
+
|> finish
1281
+
) in
1282
+
Alcotest.fail "should raise on duplicate member"
1283
+
with Invalid_argument _ -> ()
1284
+
1285
+
(* ============================================================================
1286
+
Test Registration
1287
+
============================================================================ *)
1288
+
1289
+
let tz_tests = [
1290
+
"utc", `Quick, test_tz_utc;
1291
+
"offset", `Quick, test_tz_offset;
1292
+
"parse", `Quick, test_tz_parse;
1293
+
"compare", `Quick, test_tz_compare;
1294
+
]
1295
+
1296
+
let date_tests = [
1297
+
"basic", `Quick, test_date_basic;
1298
+
"equal", `Quick, test_date_equal;
1299
+
"compare", `Quick, test_date_compare;
1300
+
"parse", `Quick, test_date_parse;
1301
+
"edge cases", `Quick, test_date_edge_cases;
1302
+
]
1303
+
1304
+
let time_tests = [
1305
+
"basic", `Quick, test_time_basic;
1306
+
"fractional", `Quick, test_time_fractional;
1307
+
"equal", `Quick, test_time_equal;
1308
+
"compare", `Quick, test_time_compare;
1309
+
"parse", `Quick, test_time_parse;
1310
+
"edge cases", `Quick, test_time_edge_cases;
1311
+
]
1312
+
1313
+
let datetime_tests = [
1314
+
"basic", `Quick, test_datetime_basic;
1315
+
"with offset", `Quick, test_datetime_with_offset;
1316
+
"with frac", `Quick, test_datetime_with_frac;
1317
+
"parse", `Quick, test_datetime_parse;
1318
+
"equal compare", `Quick, test_datetime_equal_compare;
1319
+
]
1320
+
1321
+
let datetime_local_tests = [
1322
+
"basic", `Quick, test_datetime_local_basic;
1323
+
"parse", `Quick, test_datetime_local_parse;
1324
+
"equal compare", `Quick, test_datetime_local_equal_compare;
1325
+
]
1326
+
1327
+
let bool_tests = [
1328
+
"codec", `Quick, test_bool_codec;
1329
+
"roundtrip", `Quick, test_bool_roundtrip;
1330
+
"type error", `Quick, test_bool_type_error;
1331
+
]
1332
+
1333
+
let int_tests = [
1334
+
"codec", `Quick, test_int_codec;
1335
+
"formats", `Quick, test_int_formats;
1336
+
"roundtrip", `Quick, test_int_roundtrip;
1337
+
"type error", `Quick, test_int_type_error;
1338
+
]
1339
+
1340
+
let int32_tests = [
1341
+
"codec", `Quick, test_int32_codec;
1342
+
"roundtrip", `Quick, test_int32_roundtrip;
1343
+
]
1344
+
1345
+
let int64_tests = [
1346
+
"codec", `Quick, test_int64_codec;
1347
+
"roundtrip", `Quick, test_int64_roundtrip;
1348
+
]
1349
+
1350
+
let float_tests = [
1351
+
"codec", `Quick, test_float_codec;
1352
+
"special", `Quick, test_float_special;
1353
+
"roundtrip", `Quick, test_float_roundtrip;
1354
+
"type error", `Quick, test_float_type_error;
1355
+
]
1356
+
1357
+
let number_tests = [
1358
+
"codec", `Quick, test_number_codec;
1359
+
"type error", `Quick, test_number_type_error;
1360
+
]
1361
+
1362
+
let string_tests = [
1363
+
"codec", `Quick, test_string_codec;
1364
+
"escapes", `Quick, test_string_escapes;
1365
+
"multiline", `Quick, test_string_multiline;
1366
+
"roundtrip", `Quick, test_string_roundtrip;
1367
+
"type error", `Quick, test_string_type_error;
1368
+
]
1369
+
1370
+
let ptime_codec_tests = [
1371
+
"ptime offset datetime", `Quick, test_ptime_codec;
1372
+
"ptime with timezone offset", `Quick, test_ptime_codec_offset;
1373
+
"ptime roundtrip", `Quick, test_ptime_codec_roundtrip;
1374
+
"ptime optional seconds", `Quick, test_ptime_codec_optional_seconds;
1375
+
"ptime_opt", `Quick, test_ptime_opt_codec;
1376
+
"ptime_opt rejects local", `Quick, test_ptime_opt_rejects_local;
1377
+
"ptime_span", `Quick, test_ptime_span_codec;
1378
+
"ptime_span roundtrip", `Quick, test_ptime_span_roundtrip;
1379
+
"ptime_date", `Quick, test_ptime_date_codec;
1380
+
"ptime_date roundtrip", `Quick, test_ptime_date_roundtrip;
1381
+
"ptime local datetime", `Quick, test_ptime_local_datetime;
1382
+
"ptime date as ptime", `Quick, test_ptime_date_as_ptime;
1383
+
]
1384
+
1385
+
let ptime_full_codec_tests = [
1386
+
"offset datetime", `Quick, test_ptime_full_offset;
1387
+
"local datetime", `Quick, test_ptime_full_local_datetime;
1388
+
"local date", `Quick, test_ptime_full_date;
1389
+
"local time", `Quick, test_ptime_full_time;
1390
+
"roundtrip", `Quick, test_ptime_full_roundtrip;
1391
+
]
1392
+
1393
+
let combinator_tests = [
1394
+
"map", `Quick, test_map_combinator;
1395
+
"map roundtrip", `Quick, test_map_roundtrip;
1396
+
"map int", `Quick, test_map_int;
1397
+
"const", `Quick, test_const;
1398
+
"enum", `Quick, test_enum;
1399
+
"enum roundtrip", `Quick, test_enum_roundtrip;
1400
+
"enum unknown", `Quick, test_enum_unknown;
1401
+
"enum type error", `Quick, test_enum_type_error;
1402
+
"option", `Quick, test_option_codec;
1403
+
"option roundtrip", `Quick, test_option_roundtrip;
1404
+
"result", `Quick, test_result_codec;
1405
+
"result roundtrip", `Quick, test_result_roundtrip;
1406
+
"recursive", `Quick, test_recursive_codec;
1407
+
]
1408
+
1409
+
let array_tests = [
1410
+
"list", `Quick, test_list_codec;
1411
+
"list roundtrip", `Quick, test_list_roundtrip;
1412
+
"array", `Quick, test_array_codec;
1413
+
"array roundtrip", `Quick, test_array_roundtrip;
1414
+
"nested list", `Quick, test_nested_list;
1415
+
"list of tables", `Quick, test_list_of_tables;
1416
+
"list type error", `Quick, test_list_type_error;
1417
+
]
1418
+
1419
+
let table_tests = [
1420
+
"basic", `Quick, test_table_codec;
1421
+
"roundtrip", `Quick, test_table_roundtrip;
1422
+
"missing member", `Quick, test_table_missing_member;
1423
+
"type error", `Quick, test_table_type_error;
1424
+
"optional members", `Quick, test_optional_members;
1425
+
"optional roundtrip", `Quick, test_optional_roundtrip;
1426
+
"opt_mem omits none", `Quick, test_opt_mem_omits_none;
1427
+
"enc_omit", `Quick, test_enc_omit;
1428
+
"nested tables", `Quick, test_nested_tables;
1429
+
"nested roundtrip", `Quick, test_nested_roundtrip;
1430
+
"deeply nested", `Quick, test_deeply_nested;
1431
+
"error unknown", `Quick, test_error_unknown;
1432
+
"keep unknown", `Quick, test_keep_unknown;
1433
+
"keep unknown roundtrip", `Quick, test_keep_unknown_roundtrip;
1434
+
"skip unknown", `Quick, test_skip_unknown;
1435
+
]
1436
+
1437
+
let array_of_tables_tests = [
1438
+
"basic", `Quick, test_array_of_tables;
1439
+
"roundtrip", `Quick, test_array_of_tables_roundtrip;
1440
+
"empty", `Quick, test_array_of_tables_empty;
1441
+
]
1442
+
1443
+
let any_value_tests = [
1444
+
"value codec", `Quick, test_value_codec;
1445
+
"value roundtrip", `Quick, test_value_roundtrip;
1446
+
"value_mems", `Quick, test_value_mems_codec;
1447
+
"any codec", `Quick, test_any_codec;
1448
+
"any type error", `Quick, test_any_type_error;
1449
+
]
1450
+
1451
+
let function_tests = [
1452
+
"decode_string", `Quick, test_decode_string;
1453
+
"decode_exn", `Quick, test_decode_string_exn;
1454
+
"encode_string", `Quick, test_encode_string;
1455
+
]
1456
+
1457
+
let edge_case_tests = [
1458
+
"empty table", `Quick, test_empty_table;
1459
+
"unicode keys", `Quick, test_unicode_keys;
1460
+
"special strings", `Quick, test_special_string_values;
1461
+
"large integers", `Quick, test_large_integers;
1462
+
"codec kind doc", `Quick, test_codec_kind_doc;
1463
+
"duplicate member error", `Quick, test_duplicate_member_error;
1464
+
]
1465
+
1466
+
let () =
1467
+
Alcotest.run "tomlt_codec" [
1468
+
"tz", tz_tests;
1469
+
"date", date_tests;
1470
+
"time", time_tests;
1471
+
"datetime", datetime_tests;
1472
+
"datetime_local", datetime_local_tests;
1473
+
"bool", bool_tests;
1474
+
"int", int_tests;
1475
+
"int32", int32_tests;
1476
+
"int64", int64_tests;
1477
+
"float", float_tests;
1478
+
"number", number_tests;
1479
+
"string", string_tests;
1480
+
"ptime_codecs", ptime_codec_tests;
1481
+
"ptime_full", ptime_full_codec_tests;
1482
+
"combinators", combinator_tests;
1483
+
"arrays", array_tests;
1484
+
"tables", table_tests;
1485
+
"array_of_tables", array_of_tables_tests;
1486
+
"any_value", any_value_tests;
1487
+
"functions", function_tests;
1488
+
"edge_cases", edge_case_tests;
1489
+
]
+1
vendor/opam/tomlt/test/test_codec.mli
+1
vendor/opam/tomlt/test/test_codec.mli
···
1
+
(* empty *)
+45
vendor/opam/tomlt/test/test_debug.ml
+45
vendor/opam/tomlt/test/test_debug.ml
···
1
+
open Tomlt
2
+
3
+
(* Helper to encode TOML to string via writer *)
4
+
let toml_to_string value =
5
+
let buf = Buffer.create 256 in
6
+
Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
7
+
Buffer.contents buf
8
+
9
+
type config = { name : string; timeout : int option }
10
+
11
+
let config_codec =
12
+
Table.(
13
+
obj (fun name timeout -> { name; timeout })
14
+
|> mem "name" string ~enc:(fun c -> c.name)
15
+
|> opt_mem "timeout" int ~enc:(fun c -> c.timeout)
16
+
|> finish
17
+
)
18
+
19
+
let () =
20
+
(* Test encoding *)
21
+
let c = { name = "app"; timeout = None } in
22
+
let toml = encode config_codec c in
23
+
Printf.printf "Encoded TOML:\n%s\n" (toml_to_string toml);
24
+
25
+
(* Show raw structure *)
26
+
Printf.printf "\nRaw structure: %s\n" (match toml with
27
+
| Toml.Table pairs ->
28
+
String.concat ", " (List.map (fun (k, v) ->
29
+
Printf.sprintf "%s=%s" k (match v with
30
+
| Toml.String s -> Printf.sprintf "\"%s\"" s
31
+
| Toml.Bool b -> string_of_bool b
32
+
| Toml.Int i -> Int64.to_string i
33
+
| _ -> "?"
34
+
)
35
+
) pairs)
36
+
| _ -> "not a table");
37
+
38
+
(* Test decoding the encoded value *)
39
+
Printf.printf "\nDecoding...\n";
40
+
match decode config_codec toml with
41
+
| Ok { name; timeout } ->
42
+
Printf.printf "Decoded: name=%s, timeout=%s\n" name
43
+
(match timeout with Some t -> string_of_int t | None -> "None")
44
+
| Error e ->
45
+
Printf.printf "Decode error: %s\n" (Toml.Error.to_string e)
+1
vendor/opam/tomlt/test/test_debug.mli
+1
vendor/opam/tomlt/test/test_debug.mli
···
1
+
(* empty *)
+1170
vendor/opam/tomlt/test/test_tomlt.ml
+1170
vendor/opam/tomlt/test/test_tomlt.ml
···
1
+
(* Comprehensive test suite for tomlt - TOML 1.1 codec *)
2
+
3
+
open Tomlt.Toml
4
+
5
+
(* Helper to encode TOML to string via writer *)
6
+
let to_toml_string value =
7
+
let buf = Buffer.create 256 in
8
+
Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
9
+
Buffer.contents buf
10
+
11
+
(* Helper to parse and extract value *)
12
+
let parse_toml s =
13
+
match Tomlt_bytesrw.of_string s with
14
+
| Ok v -> v
15
+
| Error e -> Alcotest.fail (Error.to_string e)
16
+
17
+
let parse_error s =
18
+
match Tomlt_bytesrw.of_string s with
19
+
| Ok _ -> Alcotest.fail "Expected parse error"
20
+
| Error _ -> ()
21
+
22
+
(* Custom testable for t *)
23
+
let rec pp_t fmt = function
24
+
| String s -> Format.fprintf fmt "String %S" s
25
+
| Int i -> Format.fprintf fmt "Int %Ld" i
26
+
| Float f -> Format.fprintf fmt "Float %f" f
27
+
| Bool b -> Format.fprintf fmt "Bool %b" b
28
+
| Datetime s -> Format.fprintf fmt "Datetime %S" s
29
+
| Datetime_local s -> Format.fprintf fmt "Datetime_local %S" s
30
+
| Date_local s -> Format.fprintf fmt "Date_local %S" s
31
+
| Time_local s -> Format.fprintf fmt "Time_local %S" s
32
+
| Array items ->
33
+
Format.fprintf fmt "Array [%a]"
34
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ") pp_t)
35
+
items
36
+
| Table pairs ->
37
+
Format.fprintf fmt "Table [%a]"
38
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
39
+
(fun fmt (k, v) -> Format.fprintf fmt "(%S, %a)" k pp_t v))
40
+
pairs
41
+
42
+
let rec equal_t a b =
43
+
match a, b with
44
+
| String s1, String s2 -> String.equal s1 s2
45
+
| Int i1, Int i2 -> Int64.equal i1 i2
46
+
| Float f1, Float f2 ->
47
+
Float.equal f1 f2 || (Float.is_nan f1 && Float.is_nan f2)
48
+
| Bool b1, Bool b2 -> Bool.equal b1 b2
49
+
| Datetime s1, Datetime s2 -> String.equal s1 s2
50
+
| Datetime_local s1, Datetime_local s2 -> String.equal s1 s2
51
+
| Date_local s1, Date_local s2 -> String.equal s1 s2
52
+
| Time_local s1, Time_local s2 -> String.equal s1 s2
53
+
| Array a1, Array a2 ->
54
+
List.length a1 = List.length a2 &&
55
+
List.for_all2 equal_t a1 a2
56
+
| Table p1, Table p2 ->
57
+
List.length p1 = List.length p2 &&
58
+
List.for_all2 (fun (k1, v1) (k2, v2) ->
59
+
String.equal k1 k2 && equal_t v1 v2
60
+
) (List.sort Stdlib.compare p1) (List.sort Stdlib.compare p2)
61
+
| _ -> false
62
+
63
+
let value_testable = Alcotest.testable pp_t equal_t
64
+
65
+
(* Helper to get a key from a table *)
66
+
let get key = function
67
+
| Table pairs -> List.assoc key pairs
68
+
| _ -> Alcotest.fail "Expected table"
69
+
70
+
(* ============================================
71
+
Comments
72
+
============================================ *)
73
+
74
+
let test_comment_full_line () =
75
+
let t = parse_toml "# This is a comment\nkey = \"value\"" in
76
+
Alcotest.(check value_testable) "full line comment" (String "value") (get "key" t)
77
+
78
+
let test_comment_inline () =
79
+
let t = parse_toml "key = \"value\" # inline comment" in
80
+
Alcotest.(check value_testable) "inline comment" (String "value") (get "key" t)
81
+
82
+
let test_comment_hash_in_string () =
83
+
let t = parse_toml "key = \"# not a comment\"" in
84
+
Alcotest.(check value_testable) "hash in string" (String "# not a comment") (get "key" t)
85
+
86
+
let test_comment_empty () =
87
+
let t = parse_toml "#\nkey = 1" in
88
+
Alcotest.(check value_testable) "empty comment" (Int 1L) (get "key" t)
89
+
90
+
let comment_tests = [
91
+
"full line comment", `Quick, test_comment_full_line;
92
+
"inline comment", `Quick, test_comment_inline;
93
+
"hash in string", `Quick, test_comment_hash_in_string;
94
+
"empty comment", `Quick, test_comment_empty;
95
+
]
96
+
97
+
(* ============================================
98
+
Keys - Bare, Quoted, Dotted
99
+
============================================ *)
100
+
101
+
let test_bare_key () =
102
+
let t = parse_toml "key = \"value\"" in
103
+
Alcotest.(check value_testable) "simple bare key" (String "value") (get "key" t)
104
+
105
+
let test_bare_key_underscore () =
106
+
let t = parse_toml "bare_key = \"value\"" in
107
+
Alcotest.(check value_testable) "bare key with underscore" (String "value") (get "bare_key" t)
108
+
109
+
let test_bare_key_dash () =
110
+
let t = parse_toml "bare-key = \"value\"" in
111
+
Alcotest.(check value_testable) "bare key with dash" (String "value") (get "bare-key" t)
112
+
113
+
let test_bare_key_numeric () =
114
+
let t = parse_toml "1234 = \"value\"" in
115
+
Alcotest.(check value_testable) "numeric bare key" (String "value") (get "1234" t)
116
+
117
+
let test_quoted_key_basic () =
118
+
let t = parse_toml "\"127.0.0.1\" = \"value\"" in
119
+
Alcotest.(check value_testable) "quoted key with dots" (String "value") (get "127.0.0.1" t)
120
+
121
+
let test_quoted_key_spaces () =
122
+
let t = parse_toml "\"character encoding\" = \"value\"" in
123
+
Alcotest.(check value_testable) "quoted key with spaces" (String "value") (get "character encoding" t)
124
+
125
+
let test_quoted_key_literal () =
126
+
let t = parse_toml "'key' = \"value\"" in
127
+
Alcotest.(check value_testable) "literal quoted key" (String "value") (get "key" t)
128
+
129
+
let test_empty_quoted_key () =
130
+
let t = parse_toml "\"\" = \"blank\"" in
131
+
Alcotest.(check value_testable) "empty quoted key" (String "blank") (get "" t)
132
+
133
+
let test_dotted_key () =
134
+
let t = parse_toml "physical.color = \"orange\"" in
135
+
match get "physical" t with
136
+
| Table pairs ->
137
+
Alcotest.(check value_testable) "dotted key" (String "orange") (List.assoc "color" pairs)
138
+
| _ -> Alcotest.fail "Expected nested table"
139
+
140
+
let test_dotted_key_quoted () =
141
+
let t = parse_toml "site.\"google.com\" = true" in
142
+
match get "site" t with
143
+
| Table pairs ->
144
+
Alcotest.(check value_testable) "dotted key with quoted part" (Bool true) (List.assoc "google.com" pairs)
145
+
| _ -> Alcotest.fail "Expected nested table"
146
+
147
+
let test_dotted_key_whitespace () =
148
+
let t = parse_toml "fruit . color = \"yellow\"" in
149
+
match get "fruit" t with
150
+
| Table pairs ->
151
+
Alcotest.(check value_testable) "dotted key with whitespace" (String "yellow") (List.assoc "color" pairs)
152
+
| _ -> Alcotest.fail "Expected nested table"
153
+
154
+
let test_duplicate_key_error () =
155
+
parse_error "name = \"Tom\"\nname = \"Pradyun\""
156
+
157
+
let test_bare_quoted_equivalent () =
158
+
parse_error "spelling = \"favorite\"\n\"spelling\" = \"favourite\""
159
+
160
+
let key_tests = [
161
+
"bare key", `Quick, test_bare_key;
162
+
"bare key underscore", `Quick, test_bare_key_underscore;
163
+
"bare key dash", `Quick, test_bare_key_dash;
164
+
"bare key numeric", `Quick, test_bare_key_numeric;
165
+
"quoted key basic", `Quick, test_quoted_key_basic;
166
+
"quoted key spaces", `Quick, test_quoted_key_spaces;
167
+
"quoted key literal", `Quick, test_quoted_key_literal;
168
+
"empty quoted key", `Quick, test_empty_quoted_key;
169
+
"dotted key", `Quick, test_dotted_key;
170
+
"dotted key quoted", `Quick, test_dotted_key_quoted;
171
+
"dotted key whitespace", `Quick, test_dotted_key_whitespace;
172
+
"duplicate key error", `Quick, test_duplicate_key_error;
173
+
"bare quoted equivalent", `Quick, test_bare_quoted_equivalent;
174
+
]
175
+
176
+
(* ============================================
177
+
Strings - Basic, Literal, Multiline
178
+
============================================ *)
179
+
180
+
let test_basic_string () =
181
+
let t = parse_toml {|str = "hello world"|} in
182
+
Alcotest.(check value_testable) "basic string" (String "hello world") (get "str" t)
183
+
184
+
let test_basic_string_escapes () =
185
+
let t = parse_toml {|str = "tab\there"|} in
186
+
Alcotest.(check value_testable) "tab escape" (String "tab\there") (get "str" t)
187
+
188
+
let test_basic_string_newline () =
189
+
let t = parse_toml {|str = "line1\nline2"|} in
190
+
Alcotest.(check value_testable) "newline escape" (String "line1\nline2") (get "str" t)
191
+
192
+
let test_basic_string_backslash () =
193
+
let t = parse_toml {|str = "back\\slash"|} in
194
+
Alcotest.(check value_testable) "backslash escape" (String "back\\slash") (get "str" t)
195
+
196
+
let test_basic_string_quote () =
197
+
let t = parse_toml {|str = "say \"hello\""|} in
198
+
Alcotest.(check value_testable) "quote escape" (String "say \"hello\"") (get "str" t)
199
+
200
+
let test_basic_string_unicode_u () =
201
+
let t = parse_toml {|str = "\u0041"|} in
202
+
Alcotest.(check value_testable) "unicode \\u escape" (String "A") (get "str" t)
203
+
204
+
let test_basic_string_unicode_U () =
205
+
let t = parse_toml {|str = "\U0001F600"|} in
206
+
(* U+1F600 is the grinning face emoji *)
207
+
Alcotest.(check value_testable) "unicode \\U escape" (String "\xF0\x9F\x98\x80") (get "str" t)
208
+
209
+
let test_basic_string_hex_escape () =
210
+
let t = parse_toml {|str = "\xE9"|} in
211
+
(* U+00E9 is e-acute *)
212
+
Alcotest.(check value_testable) "hex escape" (String "\xC3\xA9") (get "str" t)
213
+
214
+
let test_basic_string_escape_e () =
215
+
let t = parse_toml {|str = "\e"|} in
216
+
Alcotest.(check value_testable) "escape \\e" (String "\x1B") (get "str" t)
217
+
218
+
let test_literal_string () =
219
+
let t = parse_toml {|str = 'C:\Users\nodejs\templates'|} in
220
+
Alcotest.(check value_testable) "literal string" (String {|C:\Users\nodejs\templates|}) (get "str" t)
221
+
222
+
let test_literal_string_no_escape () =
223
+
let t = parse_toml {|str = '<\i\c*\s*>'|} in
224
+
Alcotest.(check value_testable) "literal no escape" (String {|<\i\c*\s*>|}) (get "str" t)
225
+
226
+
let test_multiline_basic () =
227
+
let t = parse_toml {|str = """
228
+
Roses are red
229
+
Violets are blue"""|} in
230
+
Alcotest.(check value_testable) "multiline basic" (String "Roses are red\nViolets are blue") (get "str" t)
231
+
232
+
let test_multiline_basic_trim () =
233
+
let t = parse_toml {|str = """\
234
+
The quick brown \
235
+
fox jumps over \
236
+
the lazy dog.\
237
+
"""|} in
238
+
Alcotest.(check value_testable) "multiline trim" (String "The quick brown fox jumps over the lazy dog.") (get "str" t)
239
+
240
+
let test_multiline_basic_quotes () =
241
+
let t = parse_toml {|str = """Here are two quotation marks: "". Simple."""|} in
242
+
Alcotest.(check value_testable) "multiline with quotes" (String {|Here are two quotation marks: "". Simple.|}) (get "str" t)
243
+
244
+
let test_multiline_literal () =
245
+
let t = parse_toml {|str = '''
246
+
The first newline is
247
+
trimmed in literal strings.
248
+
All other whitespace
249
+
is preserved.
250
+
'''|} in
251
+
let expected = "The first newline is\ntrimmed in literal strings.\n All other whitespace\n is preserved.\n" in
252
+
Alcotest.(check value_testable) "multiline literal" (String expected) (get "str" t)
253
+
254
+
let test_multiline_literal_no_escape () =
255
+
let t = parse_toml {|str = '''I [dw]on't need \d{2} apples'''|} in
256
+
Alcotest.(check value_testable) "multiline literal no escape" (String {|I [dw]on't need \d{2} apples|}) (get "str" t)
257
+
258
+
let string_tests = [
259
+
"basic string", `Quick, test_basic_string;
260
+
"basic string escapes", `Quick, test_basic_string_escapes;
261
+
"basic string newline", `Quick, test_basic_string_newline;
262
+
"basic string backslash", `Quick, test_basic_string_backslash;
263
+
"basic string quote", `Quick, test_basic_string_quote;
264
+
"basic string unicode u", `Quick, test_basic_string_unicode_u;
265
+
"basic string unicode U", `Quick, test_basic_string_unicode_U;
266
+
"basic string hex escape", `Quick, test_basic_string_hex_escape;
267
+
"basic string escape e", `Quick, test_basic_string_escape_e;
268
+
"literal string", `Quick, test_literal_string;
269
+
"literal string no escape", `Quick, test_literal_string_no_escape;
270
+
"multiline basic", `Quick, test_multiline_basic;
271
+
"multiline basic trim", `Quick, test_multiline_basic_trim;
272
+
"multiline basic quotes", `Quick, test_multiline_basic_quotes;
273
+
"multiline literal", `Quick, test_multiline_literal;
274
+
"multiline literal no escape", `Quick, test_multiline_literal_no_escape;
275
+
]
276
+
277
+
(* ============================================
278
+
Integers - Decimal, Hex, Octal, Binary
279
+
============================================ *)
280
+
281
+
let test_integer_positive () =
282
+
let t = parse_toml "int = +99" in
283
+
Alcotest.(check value_testable) "positive integer" (Int 99L) (get "int" t)
284
+
285
+
let test_integer_plain () =
286
+
let t = parse_toml "int = 42" in
287
+
Alcotest.(check value_testable) "plain integer" (Int 42L) (get "int" t)
288
+
289
+
let test_integer_zero () =
290
+
let t = parse_toml "int = 0" in
291
+
Alcotest.(check value_testable) "zero" (Int 0L) (get "int" t)
292
+
293
+
let test_integer_negative () =
294
+
let t = parse_toml "int = -17" in
295
+
Alcotest.(check value_testable) "negative integer" (Int (-17L)) (get "int" t)
296
+
297
+
let test_integer_underscore () =
298
+
let t = parse_toml "int = 1_000" in
299
+
Alcotest.(check value_testable) "underscore separator" (Int 1000L) (get "int" t)
300
+
301
+
let test_integer_underscore_multi () =
302
+
let t = parse_toml "int = 5_349_221" in
303
+
Alcotest.(check value_testable) "multiple underscores" (Int 5349221L) (get "int" t)
304
+
305
+
let test_integer_hex () =
306
+
let t = parse_toml "int = 0xDEADBEEF" in
307
+
Alcotest.(check value_testable) "hexadecimal" (Int 0xDEADBEEFL) (get "int" t)
308
+
309
+
let test_integer_hex_lower () =
310
+
let t = parse_toml "int = 0xdeadbeef" in
311
+
Alcotest.(check value_testable) "hex lowercase" (Int 0xdeadbeefL) (get "int" t)
312
+
313
+
let test_integer_hex_underscore () =
314
+
let t = parse_toml "int = 0xdead_beef" in
315
+
Alcotest.(check value_testable) "hex with underscore" (Int 0xdeadbeefL) (get "int" t)
316
+
317
+
let test_integer_octal () =
318
+
let t = parse_toml "int = 0o755" in
319
+
Alcotest.(check value_testable) "octal" (Int 0o755L) (get "int" t)
320
+
321
+
let test_integer_binary () =
322
+
let t = parse_toml "int = 0b11010110" in
323
+
Alcotest.(check value_testable) "binary" (Int 0b11010110L) (get "int" t)
324
+
325
+
let test_integer_leading_zero_error () =
326
+
parse_error "int = 007"
327
+
328
+
let test_integer_large () =
329
+
let t = parse_toml "int = 9223372036854775807" in
330
+
Alcotest.(check value_testable) "max int64" (Int Int64.max_int) (get "int" t)
331
+
332
+
let test_integer_negative_large () =
333
+
let t = parse_toml "int = -9223372036854775808" in
334
+
Alcotest.(check value_testable) "min int64" (Int Int64.min_int) (get "int" t)
335
+
336
+
let integer_tests = [
337
+
"positive integer", `Quick, test_integer_positive;
338
+
"plain integer", `Quick, test_integer_plain;
339
+
"zero", `Quick, test_integer_zero;
340
+
"negative integer", `Quick, test_integer_negative;
341
+
"underscore separator", `Quick, test_integer_underscore;
342
+
"multiple underscores", `Quick, test_integer_underscore_multi;
343
+
"hexadecimal", `Quick, test_integer_hex;
344
+
"hex lowercase", `Quick, test_integer_hex_lower;
345
+
"hex with underscore", `Quick, test_integer_hex_underscore;
346
+
"octal", `Quick, test_integer_octal;
347
+
"binary", `Quick, test_integer_binary;
348
+
"leading zero error", `Quick, test_integer_leading_zero_error;
349
+
"max int64", `Quick, test_integer_large;
350
+
"min int64", `Quick, test_integer_negative_large;
351
+
]
352
+
353
+
(* ============================================
354
+
Floats - Fractional, Exponent, Special
355
+
============================================ *)
356
+
357
+
let test_float_positive () =
358
+
let t = parse_toml "flt = +1.0" in
359
+
Alcotest.(check value_testable) "positive float" (Float 1.0) (get "flt" t)
360
+
361
+
let test_float_fractional () =
362
+
let t = parse_toml "flt = 3.1415" in
363
+
Alcotest.(check value_testable) "fractional" (Float 3.1415) (get "flt" t)
364
+
365
+
let test_float_negative () =
366
+
let t = parse_toml "flt = -0.01" in
367
+
Alcotest.(check value_testable) "negative float" (Float (-0.01)) (get "flt" t)
368
+
369
+
let test_float_exponent () =
370
+
let t = parse_toml "flt = 5e+22" in
371
+
Alcotest.(check value_testable) "exponent" (Float 5e+22) (get "flt" t)
372
+
373
+
let test_float_exponent_no_sign () =
374
+
let t = parse_toml "flt = 1e06" in
375
+
Alcotest.(check value_testable) "exponent no sign" (Float 1e06) (get "flt" t)
376
+
377
+
let test_float_exponent_negative () =
378
+
let t = parse_toml "flt = -2E-2" in
379
+
Alcotest.(check value_testable) "negative exponent" (Float (-2E-2)) (get "flt" t)
380
+
381
+
let test_float_both () =
382
+
let t = parse_toml "flt = 6.626e-34" in
383
+
Alcotest.(check value_testable) "fractional and exponent" (Float 6.626e-34) (get "flt" t)
384
+
385
+
let test_float_underscore () =
386
+
let t = parse_toml "flt = 224_617.445_991_228" in
387
+
Alcotest.(check value_testable) "underscore in float" (Float 224617.445991228) (get "flt" t)
388
+
389
+
let test_float_inf () =
390
+
let t = parse_toml "flt = inf" in
391
+
Alcotest.(check value_testable) "infinity" (Float Float.infinity) (get "flt" t)
392
+
393
+
let test_float_pos_inf () =
394
+
let t = parse_toml "flt = +inf" in
395
+
Alcotest.(check value_testable) "positive infinity" (Float Float.infinity) (get "flt" t)
396
+
397
+
let test_float_neg_inf () =
398
+
let t = parse_toml "flt = -inf" in
399
+
Alcotest.(check value_testable) "negative infinity" (Float Float.neg_infinity) (get "flt" t)
400
+
401
+
let test_float_nan () =
402
+
let t = parse_toml "flt = nan" in
403
+
match get "flt" t with
404
+
| Float f when Float.is_nan f -> ()
405
+
| _ -> Alcotest.fail "Expected NaN"
406
+
407
+
let test_float_pos_nan () =
408
+
let t = parse_toml "flt = +nan" in
409
+
match get "flt" t with
410
+
| Float f when Float.is_nan f -> ()
411
+
| _ -> Alcotest.fail "Expected NaN"
412
+
413
+
let test_float_neg_nan () =
414
+
let t = parse_toml "flt = -nan" in
415
+
match get "flt" t with
416
+
| Float f when Float.is_nan f -> ()
417
+
| _ -> Alcotest.fail "Expected NaN"
418
+
419
+
let test_float_no_leading_digit () =
420
+
parse_error "flt = .7"
421
+
422
+
let test_float_no_trailing_digit () =
423
+
parse_error "flt = 7."
424
+
425
+
let float_tests = [
426
+
"positive float", `Quick, test_float_positive;
427
+
"fractional", `Quick, test_float_fractional;
428
+
"negative float", `Quick, test_float_negative;
429
+
"exponent", `Quick, test_float_exponent;
430
+
"exponent no sign", `Quick, test_float_exponent_no_sign;
431
+
"negative exponent", `Quick, test_float_exponent_negative;
432
+
"fractional and exponent", `Quick, test_float_both;
433
+
"underscore in float", `Quick, test_float_underscore;
434
+
"infinity", `Quick, test_float_inf;
435
+
"positive infinity", `Quick, test_float_pos_inf;
436
+
"negative infinity", `Quick, test_float_neg_inf;
437
+
"nan", `Quick, test_float_nan;
438
+
"positive nan", `Quick, test_float_pos_nan;
439
+
"negative nan", `Quick, test_float_neg_nan;
440
+
"no leading digit", `Quick, test_float_no_leading_digit;
441
+
"no trailing digit", `Quick, test_float_no_trailing_digit;
442
+
]
443
+
444
+
(* ============================================
445
+
Booleans
446
+
============================================ *)
447
+
448
+
let test_bool_true () =
449
+
let t = parse_toml "bool = true" in
450
+
Alcotest.(check value_testable) "true" (Bool true) (get "bool" t)
451
+
452
+
let test_bool_false () =
453
+
let t = parse_toml "bool = false" in
454
+
Alcotest.(check value_testable) "false" (Bool false) (get "bool" t)
455
+
456
+
let test_bool_case_sensitive () =
457
+
parse_error "bool = True"
458
+
459
+
let boolean_tests = [
460
+
"true", `Quick, test_bool_true;
461
+
"false", `Quick, test_bool_false;
462
+
"case sensitive", `Quick, test_bool_case_sensitive;
463
+
]
464
+
465
+
(* ============================================
466
+
Date-Times
467
+
============================================ *)
468
+
469
+
let test_datetime_offset () =
470
+
let t = parse_toml "dt = 1979-05-27T07:32:00Z" in
471
+
Alcotest.(check value_testable) "offset datetime UTC" (Datetime "1979-05-27T07:32:00Z") (get "dt" t)
472
+
473
+
let test_datetime_offset_negative () =
474
+
let t = parse_toml "dt = 1979-05-27T00:32:00-07:00" in
475
+
Alcotest.(check value_testable) "offset datetime negative" (Datetime "1979-05-27T00:32:00-07:00") (get "dt" t)
476
+
477
+
let test_datetime_offset_frac () =
478
+
let t = parse_toml "dt = 1979-05-27T00:32:00.5-07:00" in
479
+
Alcotest.(check value_testable) "offset datetime fractional" (Datetime "1979-05-27T00:32:00.5-07:00") (get "dt" t)
480
+
481
+
let test_datetime_space_separator () =
482
+
let t = parse_toml "dt = 1979-05-27 07:32:00Z" in
483
+
Alcotest.(check value_testable) "space separator" (Datetime "1979-05-27T07:32:00Z") (get "dt" t)
484
+
485
+
let test_datetime_local () =
486
+
let t = parse_toml "dt = 1979-05-27T07:32:00" in
487
+
Alcotest.(check value_testable) "local datetime" (Datetime_local "1979-05-27T07:32:00") (get "dt" t)
488
+
489
+
let test_datetime_local_frac () =
490
+
let t = parse_toml "dt = 1979-05-27T07:32:00.5" in
491
+
Alcotest.(check value_testable) "local datetime fractional" (Datetime_local "1979-05-27T07:32:00.5") (get "dt" t)
492
+
493
+
let test_date_local () =
494
+
let t = parse_toml "dt = 1979-05-27" in
495
+
Alcotest.(check value_testable) "local date" (Date_local "1979-05-27") (get "dt" t)
496
+
497
+
let test_time_local () =
498
+
let t = parse_toml "dt = 07:32:00" in
499
+
Alcotest.(check value_testable) "local time" (Time_local "07:32:00") (get "dt" t)
500
+
501
+
let test_time_local_frac () =
502
+
let t = parse_toml "dt = 00:32:00.999999" in
503
+
Alcotest.(check value_testable) "local time fractional" (Time_local "00:32:00.999999") (get "dt" t)
504
+
505
+
let datetime_tests = [
506
+
"offset datetime UTC", `Quick, test_datetime_offset;
507
+
"offset datetime negative", `Quick, test_datetime_offset_negative;
508
+
"offset datetime fractional", `Quick, test_datetime_offset_frac;
509
+
"space separator", `Quick, test_datetime_space_separator;
510
+
"local datetime", `Quick, test_datetime_local;
511
+
"local datetime fractional", `Quick, test_datetime_local_frac;
512
+
"local date", `Quick, test_date_local;
513
+
"local time", `Quick, test_time_local;
514
+
"local time fractional", `Quick, test_time_local_frac;
515
+
]
516
+
517
+
(* ============================================
518
+
Arrays
519
+
============================================ *)
520
+
521
+
let test_array_integers () =
522
+
let t = parse_toml "arr = [1, 2, 3]" in
523
+
Alcotest.(check value_testable) "integer array"
524
+
(Array [Int 1L; Int 2L; Int 3L])
525
+
(get "arr" t)
526
+
527
+
let test_array_strings () =
528
+
let t = parse_toml {|arr = ["red", "yellow", "green"]|} in
529
+
Alcotest.(check value_testable) "string array"
530
+
(Array [String "red"; String "yellow"; String "green"])
531
+
(get "arr" t)
532
+
533
+
let test_array_nested () =
534
+
let t = parse_toml "arr = [[1, 2], [3, 4, 5]]" in
535
+
Alcotest.(check value_testable) "nested array"
536
+
(Array [
537
+
Array [Int 1L; Int 2L];
538
+
Array [Int 3L; Int 4L; Int 5L]
539
+
])
540
+
(get "arr" t)
541
+
542
+
let test_array_mixed () =
543
+
let t = parse_toml "arr = [0.1, 0.2, 1, 2]" in
544
+
Alcotest.(check value_testable) "mixed types"
545
+
(Array [Float 0.1; Float 0.2; Int 1L; Int 2L])
546
+
(get "arr" t)
547
+
548
+
let test_array_empty () =
549
+
let t = parse_toml "arr = []" in
550
+
Alcotest.(check value_testable) "empty array" (Array []) (get "arr" t)
551
+
552
+
let test_array_multiline () =
553
+
let t = parse_toml "arr = [\n 1,\n 2,\n 3\n]" in
554
+
Alcotest.(check value_testable) "multiline array"
555
+
(Array [Int 1L; Int 2L; Int 3L])
556
+
(get "arr" t)
557
+
558
+
let test_array_trailing_comma () =
559
+
let t = parse_toml "arr = [1, 2, 3,]" in
560
+
Alcotest.(check value_testable) "trailing comma"
561
+
(Array [Int 1L; Int 2L; Int 3L])
562
+
(get "arr" t)
563
+
564
+
let test_array_with_inline_tables () =
565
+
let t = parse_toml {|arr = [{x = 1}, {x = 2}]|} in
566
+
match get "arr" t with
567
+
| Array [Table [("x", Int 1L)]; Table [("x", Int 2L)]] -> ()
568
+
| _ -> Alcotest.fail "Expected array of inline tables"
569
+
570
+
let array_tests = [
571
+
"integer array", `Quick, test_array_integers;
572
+
"string array", `Quick, test_array_strings;
573
+
"nested array", `Quick, test_array_nested;
574
+
"mixed types", `Quick, test_array_mixed;
575
+
"empty array", `Quick, test_array_empty;
576
+
"multiline array", `Quick, test_array_multiline;
577
+
"trailing comma", `Quick, test_array_trailing_comma;
578
+
"with inline tables", `Quick, test_array_with_inline_tables;
579
+
]
580
+
581
+
(* ============================================
582
+
Tables
583
+
============================================ *)
584
+
585
+
let test_table_basic () =
586
+
let t = parse_toml "[table]\nkey = \"value\"" in
587
+
match get "table" t with
588
+
| Table pairs ->
589
+
Alcotest.(check value_testable) "basic table" (String "value") (List.assoc "key" pairs)
590
+
| _ -> Alcotest.fail "Expected table"
591
+
592
+
let test_table_multiple () =
593
+
let t = parse_toml "[table1]\nkey1 = 1\n\n[table2]\nkey2 = 2" in
594
+
let t1 = get "table1" t and t2 = get "table2" t in
595
+
(match t1 with
596
+
| Table pairs -> Alcotest.(check value_testable) "table1" (Int 1L) (List.assoc "key1" pairs)
597
+
| _ -> Alcotest.fail "Expected table1");
598
+
(match t2 with
599
+
| Table pairs -> Alcotest.(check value_testable) "table2" (Int 2L) (List.assoc "key2" pairs)
600
+
| _ -> Alcotest.fail "Expected table2")
601
+
602
+
let test_table_dotted_header () =
603
+
let t = parse_toml "[dog.\"tater.man\"]\ntype = \"pug\"" in
604
+
match get "dog" t with
605
+
| Table pairs ->
606
+
(match List.assoc "tater.man" pairs with
607
+
| Table inner ->
608
+
Alcotest.(check value_testable) "nested quoted" (String "pug") (List.assoc "type" inner)
609
+
| _ -> Alcotest.fail "Expected nested table")
610
+
| _ -> Alcotest.fail "Expected dog table"
611
+
612
+
let test_table_implicit_parent () =
613
+
let t = parse_toml "[x.y.z.w]\nkey = 1" in
614
+
(* x, x.y, x.y.z should all be implicitly created *)
615
+
match get "x" t with
616
+
| Table _ -> ()
617
+
| _ -> Alcotest.fail "Expected x table"
618
+
619
+
let test_table_empty () =
620
+
let t = parse_toml "[empty]\n[other]\nkey = 1" in
621
+
match get "empty" t with
622
+
| Table [] -> ()
623
+
| Table _ -> () (* May have implicit content *)
624
+
| _ -> Alcotest.fail "Expected empty table"
625
+
626
+
let test_table_duplicate_error () =
627
+
parse_error "[fruit]\napple = 1\n\n[fruit]\norange = 2"
628
+
629
+
let test_table_super_after () =
630
+
let t = parse_toml "[x.y]\na = 1\n[x]\nb = 2" in
631
+
match get "x" t with
632
+
| Table pairs ->
633
+
Alcotest.(check value_testable) "super table b" (Int 2L) (List.assoc "b" pairs)
634
+
| _ -> Alcotest.fail "Expected x table"
635
+
636
+
let table_tests = [
637
+
"basic table", `Quick, test_table_basic;
638
+
"multiple tables", `Quick, test_table_multiple;
639
+
"dotted header", `Quick, test_table_dotted_header;
640
+
"implicit parent", `Quick, test_table_implicit_parent;
641
+
"empty table", `Quick, test_table_empty;
642
+
"duplicate error", `Quick, test_table_duplicate_error;
643
+
"super after", `Quick, test_table_super_after;
644
+
]
645
+
646
+
(* ============================================
647
+
Inline Tables
648
+
============================================ *)
649
+
650
+
let test_inline_table_basic () =
651
+
let t = parse_toml {|name = { first = "Tom", last = "Preston-Werner" }|} in
652
+
match get "name" t with
653
+
| Table pairs ->
654
+
Alcotest.(check value_testable) "first" (String "Tom") (List.assoc "first" pairs);
655
+
Alcotest.(check value_testable) "last" (String "Preston-Werner") (List.assoc "last" pairs)
656
+
| _ -> Alcotest.fail "Expected inline table"
657
+
658
+
let test_inline_table_compact () =
659
+
let t = parse_toml "point = {x=1, y=2}" in
660
+
match get "point" t with
661
+
| Table pairs ->
662
+
Alcotest.(check value_testable) "x" (Int 1L) (List.assoc "x" pairs);
663
+
Alcotest.(check value_testable) "y" (Int 2L) (List.assoc "y" pairs)
664
+
| _ -> Alcotest.fail "Expected inline table"
665
+
666
+
let test_inline_table_dotted_key () =
667
+
let t = parse_toml "animal = { type.name = \"pug\" }" in
668
+
match get "animal" t with
669
+
| Table pairs ->
670
+
(match List.assoc "type" pairs with
671
+
| Table inner ->
672
+
Alcotest.(check value_testable) "nested" (String "pug") (List.assoc "name" inner)
673
+
| _ -> Alcotest.fail "Expected type table")
674
+
| _ -> Alcotest.fail "Expected animal table"
675
+
676
+
let test_inline_table_empty () =
677
+
let t = parse_toml "empty = {}" in
678
+
Alcotest.(check value_testable) "empty inline table" (Table []) (get "empty" t)
679
+
680
+
let test_inline_table_trailing_comma () =
681
+
let t = parse_toml "x = {a = 1, b = 2,}" in
682
+
match get "x" t with
683
+
| Table pairs ->
684
+
Alcotest.(check value_testable) "a" (Int 1L) (List.assoc "a" pairs);
685
+
Alcotest.(check value_testable) "b" (Int 2L) (List.assoc "b" pairs)
686
+
| _ -> Alcotest.fail "Expected inline table"
687
+
688
+
let test_inline_table_nested () =
689
+
let t = parse_toml "x = { a = { b = 1 } }" in
690
+
match get "x" t with
691
+
| Table pairs ->
692
+
(match List.assoc "a" pairs with
693
+
| Table inner ->
694
+
Alcotest.(check value_testable) "nested" (Int 1L) (List.assoc "b" inner)
695
+
| _ -> Alcotest.fail "Expected nested table")
696
+
| _ -> Alcotest.fail "Expected x table"
697
+
698
+
let inline_table_tests = [
699
+
"basic inline table", `Quick, test_inline_table_basic;
700
+
"compact", `Quick, test_inline_table_compact;
701
+
"dotted key", `Quick, test_inline_table_dotted_key;
702
+
"empty", `Quick, test_inline_table_empty;
703
+
"trailing comma", `Quick, test_inline_table_trailing_comma;
704
+
"nested", `Quick, test_inline_table_nested;
705
+
]
706
+
707
+
(* ============================================
708
+
Array of Tables
709
+
============================================ *)
710
+
711
+
let test_array_of_tables_basic () =
712
+
let t = parse_toml "[[product]]\nname = \"Hammer\"\n\n[[product]]\nname = \"Nail\"" in
713
+
match get "product" t with
714
+
| Array [Table p1; Table p2] ->
715
+
Alcotest.(check value_testable) "first" (String "Hammer") (List.assoc "name" p1);
716
+
Alcotest.(check value_testable) "second" (String "Nail") (List.assoc "name" p2)
717
+
| _ -> Alcotest.fail "Expected array of tables"
718
+
719
+
let test_array_of_tables_empty () =
720
+
let t = parse_toml "[[product]]\nname = \"Hammer\"\n\n[[product]]\n\n[[product]]\nname = \"Nail\"" in
721
+
match get "product" t with
722
+
| Array [_; Table []; _] -> ()
723
+
| Array items when List.length items = 3 -> ()
724
+
| _ -> Alcotest.fail "Expected 3 elements"
725
+
726
+
let test_array_of_tables_subtable () =
727
+
let t = parse_toml "[[fruits]]\nname = \"apple\"\n\n[fruits.physical]\ncolor = \"red\"" in
728
+
match get "fruits" t with
729
+
| Array [Table pairs] ->
730
+
Alcotest.(check value_testable) "name" (String "apple") (List.assoc "name" pairs);
731
+
(match List.assoc "physical" pairs with
732
+
| Table inner ->
733
+
Alcotest.(check value_testable) "color" (String "red") (List.assoc "color" inner)
734
+
| _ -> Alcotest.fail "Expected physical table")
735
+
| _ -> Alcotest.fail "Expected array of tables"
736
+
737
+
let test_array_of_tables_nested () =
738
+
let t = parse_toml "[[fruits]]\nname = \"apple\"\n\n[[fruits.varieties]]\nname = \"red delicious\"\n\n[[fruits.varieties]]\nname = \"granny smith\"" in
739
+
match get "fruits" t with
740
+
| Array [Table pairs] ->
741
+
Alcotest.(check value_testable) "name" (String "apple") (List.assoc "name" pairs);
742
+
(match List.assoc "varieties" pairs with
743
+
| Array [Table v1; Table v2] ->
744
+
Alcotest.(check value_testable) "v1" (String "red delicious") (List.assoc "name" v1);
745
+
Alcotest.(check value_testable) "v2" (String "granny smith") (List.assoc "name" v2)
746
+
| _ -> Alcotest.fail "Expected varieties array")
747
+
| _ -> Alcotest.fail "Expected fruits array"
748
+
749
+
let test_array_of_tables_static_error () =
750
+
parse_error "fruits = []\n\n[[fruits]]"
751
+
752
+
let array_of_tables_tests = [
753
+
"basic", `Quick, test_array_of_tables_basic;
754
+
"empty element", `Quick, test_array_of_tables_empty;
755
+
"subtable", `Quick, test_array_of_tables_subtable;
756
+
"nested", `Quick, test_array_of_tables_nested;
757
+
"static array error", `Quick, test_array_of_tables_static_error;
758
+
]
759
+
760
+
(* ============================================
761
+
Encoding / Round-trip
762
+
============================================ *)
763
+
764
+
let test_encode_roundtrip_basic () =
765
+
let original = Table [
766
+
("name", String "test");
767
+
("count", Int 42L);
768
+
("enabled", Bool true);
769
+
] in
770
+
let encoded = to_toml_string original in
771
+
let decoded = parse_toml encoded in
772
+
Alcotest.(check value_testable) "roundtrip basic" original decoded
773
+
774
+
let test_encode_roundtrip_nested () =
775
+
let original = Table [
776
+
("server", Table [
777
+
("host", String "localhost");
778
+
("port", Int 8080L);
779
+
]);
780
+
] in
781
+
let encoded = to_toml_string original in
782
+
let decoded = parse_toml encoded in
783
+
Alcotest.(check value_testable) "roundtrip nested" original decoded
784
+
785
+
let test_encode_roundtrip_array () =
786
+
let original = Table [
787
+
("items", Array [Int 1L; Int 2L; Int 3L]);
788
+
] in
789
+
let encoded = to_toml_string original in
790
+
let decoded = parse_toml encoded in
791
+
Alcotest.(check value_testable) "roundtrip array" original decoded
792
+
793
+
let test_encode_roundtrip_special_string () =
794
+
let original = Table [
795
+
("str", String "line1\nline2\ttab");
796
+
] in
797
+
let encoded = to_toml_string original in
798
+
let decoded = parse_toml encoded in
799
+
Alcotest.(check value_testable) "roundtrip special string" original decoded
800
+
801
+
let test_encode_roundtrip_float () =
802
+
let original = Table [
803
+
("pi", Float 3.14159);
804
+
("inf", Float Float.infinity);
805
+
("neg_inf", Float Float.neg_infinity);
806
+
] in
807
+
let encoded = to_toml_string original in
808
+
let decoded = parse_toml encoded in
809
+
Alcotest.(check value_testable) "roundtrip float" original decoded
810
+
811
+
let test_encode_roundtrip_datetime () =
812
+
let original = Table [
813
+
("dt", Datetime "1979-05-27T07:32:00Z");
814
+
("ld", Date_local "1979-05-27");
815
+
("lt", Time_local "07:32:00");
816
+
] in
817
+
let encoded = to_toml_string original in
818
+
let decoded = parse_toml encoded in
819
+
Alcotest.(check value_testable) "roundtrip datetime" original decoded
820
+
821
+
let encode_tests = [
822
+
"roundtrip basic", `Quick, test_encode_roundtrip_basic;
823
+
"roundtrip nested", `Quick, test_encode_roundtrip_nested;
824
+
"roundtrip array", `Quick, test_encode_roundtrip_array;
825
+
"roundtrip special string", `Quick, test_encode_roundtrip_special_string;
826
+
"roundtrip float", `Quick, test_encode_roundtrip_float;
827
+
"roundtrip datetime", `Quick, test_encode_roundtrip_datetime;
828
+
]
829
+
830
+
(* ============================================
831
+
Edge Cases and Error Handling
832
+
============================================ *)
833
+
834
+
let test_error_invalid_escape () =
835
+
parse_error {|str = "\q"|}
836
+
837
+
let test_error_unterminated_string () =
838
+
parse_error {|str = "hello|}
839
+
840
+
let test_error_unterminated_multiline () =
841
+
parse_error {|str = """hello|}
842
+
843
+
let test_error_bare_key_only () =
844
+
parse_error "key"
845
+
846
+
let test_error_missing_value () =
847
+
parse_error "key ="
848
+
849
+
let test_error_invalid_integer () =
850
+
parse_error "int = 1__2"
851
+
852
+
let test_error_invalid_float () =
853
+
parse_error "flt = 1.2.3"
854
+
855
+
let test_error_redefine_as_table () =
856
+
parse_error "a = 1\n[a]\nb = 2"
857
+
858
+
let test_error_inline_extend () =
859
+
parse_error "[product]\ntype = { name = \"Nail\" }\ntype.edible = false"
860
+
861
+
let test_unicode_key () =
862
+
let t = parse_toml {|"ʎǝʞ" = "value"|} in
863
+
Alcotest.(check value_testable) "unicode key" (String "value") (get "ʎǝʞ" t)
864
+
865
+
let test_crlf_newlines () =
866
+
let t = parse_toml "key1 = 1\r\nkey2 = 2" in
867
+
Alcotest.(check value_testable) "key1" (Int 1L) (get "key1" t);
868
+
Alcotest.(check value_testable) "key2" (Int 2L) (get "key2" t)
869
+
870
+
let edge_case_tests = [
871
+
"invalid escape", `Quick, test_error_invalid_escape;
872
+
"unterminated string", `Quick, test_error_unterminated_string;
873
+
"unterminated multiline", `Quick, test_error_unterminated_multiline;
874
+
"bare key only", `Quick, test_error_bare_key_only;
875
+
"missing value", `Quick, test_error_missing_value;
876
+
"invalid integer", `Quick, test_error_invalid_integer;
877
+
"invalid float", `Quick, test_error_invalid_float;
878
+
"redefine as table", `Quick, test_error_redefine_as_table;
879
+
"inline extend", `Quick, test_error_inline_extend;
880
+
"unicode key", `Quick, test_unicode_key;
881
+
"crlf newlines", `Quick, test_crlf_newlines;
882
+
]
883
+
884
+
(* ============================================
885
+
Ptime Conversions
886
+
============================================ *)
887
+
888
+
let ptime_testable =
889
+
let pp fmt t = Format.fprintf fmt "%s" (Ptime.to_rfc3339 ~tz_offset_s:0 t) in
890
+
Alcotest.testable pp Ptime.equal
891
+
892
+
let date_testable =
893
+
let pp fmt (y, m, d) = Format.fprintf fmt "%04d-%02d-%02d" y m d in
894
+
let eq (y1, m1, d1) (y2, m2, d2) = y1 = y2 && m1 = m2 && d1 = d2 in
895
+
Alcotest.testable pp eq
896
+
897
+
let test_datetime_of_ptime () =
898
+
let ptime = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
899
+
| Some t -> t | None -> Alcotest.fail "invalid test datetime"
900
+
in
901
+
let v = datetime_of_ptime ptime in
902
+
Alcotest.(check value_testable) "datetime_of_ptime UTC"
903
+
(Datetime "1979-05-27T07:32:00Z") v
904
+
905
+
let test_datetime_of_ptime_with_tz () =
906
+
let ptime = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
907
+
| Some t -> t | None -> Alcotest.fail "invalid test datetime"
908
+
in
909
+
let v = datetime_of_ptime ~tz_offset_s:(-25200) ptime in (* -07:00 = -25200s *)
910
+
Alcotest.(check value_testable) "datetime_of_ptime with tz"
911
+
(Datetime "1979-05-27T00:32:00-07:00") v
912
+
913
+
let test_datetime_of_ptime_with_frac () =
914
+
let ptime = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
915
+
| Some t -> t | None -> Alcotest.fail "invalid test datetime"
916
+
in
917
+
let v = datetime_of_ptime ~frac_s:3 ptime in
918
+
Alcotest.(check value_testable) "datetime_of_ptime with frac"
919
+
(Datetime "1979-05-27T07:32:00.000Z") v
920
+
921
+
let test_to_ptime () =
922
+
let v = Datetime "1979-05-27T07:32:00Z" in
923
+
let ptime = to_ptime v in
924
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
925
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime"
926
+
in
927
+
Alcotest.(check ptime_testable) "to_ptime" expected ptime
928
+
929
+
let test_to_ptime_with_offset () =
930
+
let v = Datetime "1979-05-27T00:32:00-07:00" in
931
+
let ptime = to_ptime v in
932
+
(* UTC time should be 1979-05-27T07:32:00Z *)
933
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
934
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime"
935
+
in
936
+
Alcotest.(check ptime_testable) "to_ptime with offset" expected ptime
937
+
938
+
let test_to_ptime_tz () =
939
+
let v = Datetime "1979-05-27T00:32:00-07:00" in
940
+
match to_ptime_tz v with
941
+
| Some (_, Some tz) ->
942
+
Alcotest.(check int) "timezone offset" (-25200) tz
943
+
| Some (_, None) ->
944
+
Alcotest.fail "expected timezone offset"
945
+
| None ->
946
+
Alcotest.fail "expected ptime result"
947
+
948
+
let test_to_ptime_opt_local () =
949
+
let v = Datetime_local "1979-05-27T07:32:00" in
950
+
Alcotest.(check (option ptime_testable)) "local datetime returns None"
951
+
None (to_ptime_opt v)
952
+
953
+
let test_to_ptime_optional_seconds () =
954
+
(* TOML 1.1 allows optional seconds *)
955
+
let v = Datetime "1979-05-27T07:32Z" in
956
+
let ptime = to_ptime v in
957
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
958
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime"
959
+
in
960
+
Alcotest.(check ptime_testable) "to_ptime optional seconds" expected ptime
961
+
962
+
let test_date_of_ptime () =
963
+
let ptime = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
964
+
| Some t -> t | None -> Alcotest.fail "invalid test datetime"
965
+
in
966
+
let v = date_of_ptime ptime in
967
+
Alcotest.(check value_testable) "date_of_ptime"
968
+
(Date_local "1979-05-27") v
969
+
970
+
let test_to_date () =
971
+
let v = Date_local "1979-05-27" in
972
+
let date = to_date v in
973
+
Alcotest.(check date_testable) "to_date" (1979, 5, 27) date
974
+
975
+
let test_to_date_opt_invalid () =
976
+
let v = Date_local "1979-02-30" in (* Invalid date *)
977
+
Alcotest.(check (option date_testable)) "invalid date returns None"
978
+
None (to_date_opt v)
979
+
980
+
let test_ptime_roundtrip () =
981
+
let original = match Ptime.of_date_time ((2024, 12, 19), ((15, 30, 45), 0)) with
982
+
| Some t -> t | None -> Alcotest.fail "invalid test datetime"
983
+
in
984
+
let v = datetime_of_ptime original in
985
+
let roundtrip = to_ptime v in
986
+
Alcotest.(check ptime_testable) "ptime roundtrip" original roundtrip
987
+
988
+
let ptime_tests = [
989
+
"datetime_of_ptime", `Quick, test_datetime_of_ptime;
990
+
"datetime_of_ptime with tz", `Quick, test_datetime_of_ptime_with_tz;
991
+
"datetime_of_ptime with frac", `Quick, test_datetime_of_ptime_with_frac;
992
+
"to_ptime", `Quick, test_to_ptime;
993
+
"to_ptime with offset", `Quick, test_to_ptime_with_offset;
994
+
"to_ptime_tz", `Quick, test_to_ptime_tz;
995
+
"to_ptime_opt local", `Quick, test_to_ptime_opt_local;
996
+
"to_ptime optional seconds", `Quick, test_to_ptime_optional_seconds;
997
+
"date_of_ptime", `Quick, test_date_of_ptime;
998
+
"to_date", `Quick, test_to_date;
999
+
"to_date_opt invalid", `Quick, test_to_date_opt_invalid;
1000
+
"ptime roundtrip", `Quick, test_ptime_roundtrip;
1001
+
]
1002
+
1003
+
(* ============================================
1004
+
Unified Ptime Datetime
1005
+
============================================ *)
1006
+
1007
+
let ptime_datetime_testable =
1008
+
Alcotest.testable pp_ptime_datetime (fun a b ->
1009
+
match a, b with
1010
+
| `Datetime (t1, tz1), `Datetime (t2, tz2) ->
1011
+
Ptime.equal t1 t2 && tz1 = tz2
1012
+
| `Datetime_local t1, `Datetime_local t2 ->
1013
+
Ptime.equal t1 t2
1014
+
| `Date d1, `Date d2 -> d1 = d2
1015
+
| `Time t1, `Time t2 -> t1 = t2
1016
+
| _ -> false)
1017
+
1018
+
let test_unified_offset_datetime () =
1019
+
let v = Datetime "1979-05-27T07:32:00Z" in
1020
+
match to_ptime_datetime v with
1021
+
| Some (`Datetime (ptime, Some 0)) ->
1022
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
1023
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime" in
1024
+
Alcotest.(check ptime_testable) "ptime value" expected ptime
1025
+
| Some (`Datetime (_, tz)) ->
1026
+
Alcotest.failf "expected tz=Some 0, got %s"
1027
+
(match tz with Some n -> string_of_int n | None -> "None")
1028
+
| Some other ->
1029
+
Alcotest.failf "expected `Datetime, got %a" pp_ptime_datetime other
1030
+
| None ->
1031
+
Alcotest.fail "expected Some, got None"
1032
+
1033
+
let test_unified_offset_datetime_with_tz () =
1034
+
let v = Datetime "1979-05-27T00:32:00-07:00" in
1035
+
match to_ptime_datetime v with
1036
+
| Some (`Datetime (ptime, Some tz)) ->
1037
+
(* UTC time should be 1979-05-27T07:32:00Z *)
1038
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
1039
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime" in
1040
+
Alcotest.(check ptime_testable) "ptime value" expected ptime;
1041
+
Alcotest.(check int) "timezone" (-25200) tz
1042
+
| _ -> Alcotest.fail "expected `Datetime with tz"
1043
+
1044
+
let test_unified_local_datetime () =
1045
+
let v = Datetime_local "1979-05-27T07:32:00" in
1046
+
(* Use explicit UTC for testing *)
1047
+
match to_ptime_datetime ~tz_offset_s:0 v with
1048
+
| Some (`Datetime_local ptime) ->
1049
+
let expected = match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
1050
+
| Some t -> t | None -> Alcotest.fail "invalid expected datetime" in
1051
+
Alcotest.(check ptime_testable) "ptime value" expected ptime
1052
+
| Some other ->
1053
+
Alcotest.failf "expected `Datetime_local, got %a" pp_ptime_datetime other
1054
+
| None ->
1055
+
Alcotest.fail "expected Some, got None"
1056
+
1057
+
let test_unified_local_date () =
1058
+
let v = Date_local "1979-05-27" in
1059
+
match to_ptime_datetime v with
1060
+
| Some (`Date (year, month, day)) ->
1061
+
Alcotest.(check int) "year" 1979 year;
1062
+
Alcotest.(check int) "month" 5 month;
1063
+
Alcotest.(check int) "day" 27 day
1064
+
| Some other ->
1065
+
Alcotest.failf "expected `Date, got %a" pp_ptime_datetime other
1066
+
| None ->
1067
+
Alcotest.fail "expected Some, got None"
1068
+
1069
+
let test_unified_local_time () =
1070
+
let v = Time_local "07:32:00" in
1071
+
match to_ptime_datetime v with
1072
+
| Some (`Time (hour, minute, second, ns)) ->
1073
+
Alcotest.(check int) "hour" 7 hour;
1074
+
Alcotest.(check int) "minute" 32 minute;
1075
+
Alcotest.(check int) "second" 0 second;
1076
+
Alcotest.(check int) "nanoseconds" 0 ns
1077
+
| Some other ->
1078
+
Alcotest.failf "expected `Time, got %a" pp_ptime_datetime other
1079
+
| None ->
1080
+
Alcotest.fail "expected Some, got None"
1081
+
1082
+
let test_unified_local_time_frac () =
1083
+
let v = Time_local "07:32:00.123456789" in
1084
+
match to_ptime_datetime v with
1085
+
| Some (`Time (hour, minute, second, ns)) ->
1086
+
Alcotest.(check int) "hour" 7 hour;
1087
+
Alcotest.(check int) "minute" 32 minute;
1088
+
Alcotest.(check int) "second" 0 second;
1089
+
Alcotest.(check int) "nanoseconds" 123456789 ns
1090
+
| Some other ->
1091
+
Alcotest.failf "expected `Time, got %a" pp_ptime_datetime other
1092
+
| None ->
1093
+
Alcotest.fail "expected Some, got None"
1094
+
1095
+
let test_unified_roundtrip_offset () =
1096
+
let original = `Datetime (
1097
+
(match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
1098
+
| Some t -> t | None -> Alcotest.fail "invalid datetime"),
1099
+
Some (-25200)
1100
+
) in
1101
+
let toml = ptime_datetime_to_toml original in
1102
+
match to_ptime_datetime toml with
1103
+
| Some result -> Alcotest.(check ptime_datetime_testable) "roundtrip" original result
1104
+
| None -> Alcotest.fail "roundtrip failed"
1105
+
1106
+
let test_unified_roundtrip_local () =
1107
+
let original = `Datetime_local (
1108
+
match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
1109
+
| Some t -> t | None -> Alcotest.fail "invalid datetime"
1110
+
) in
1111
+
let toml = ptime_datetime_to_toml original in
1112
+
match to_ptime_datetime ~tz_offset_s:0 toml with
1113
+
| Some result -> Alcotest.(check ptime_datetime_testable) "roundtrip" original result
1114
+
| None -> Alcotest.fail "roundtrip failed"
1115
+
1116
+
let test_unified_roundtrip_date () =
1117
+
let original = `Date (1979, 5, 27) in
1118
+
let toml = ptime_datetime_to_toml original in
1119
+
match to_ptime_datetime toml with
1120
+
| Some result -> Alcotest.(check ptime_datetime_testable) "roundtrip" original result
1121
+
| None -> Alcotest.fail "roundtrip failed"
1122
+
1123
+
let test_unified_roundtrip_time () =
1124
+
let original = `Time (7, 32, 45, 123000000) in
1125
+
let toml = ptime_datetime_to_toml original in
1126
+
match to_ptime_datetime toml with
1127
+
| Some result -> Alcotest.(check ptime_datetime_testable) "roundtrip" original result
1128
+
| None -> Alcotest.fail "roundtrip failed"
1129
+
1130
+
let test_unified_not_datetime () =
1131
+
let v = String "not a datetime" in
1132
+
Alcotest.(check (option ptime_datetime_testable)) "non-datetime"
1133
+
None (to_ptime_datetime v)
1134
+
1135
+
let unified_datetime_tests = [
1136
+
"offset datetime", `Quick, test_unified_offset_datetime;
1137
+
"offset datetime with tz", `Quick, test_unified_offset_datetime_with_tz;
1138
+
"local datetime", `Quick, test_unified_local_datetime;
1139
+
"local date", `Quick, test_unified_local_date;
1140
+
"local time", `Quick, test_unified_local_time;
1141
+
"local time frac", `Quick, test_unified_local_time_frac;
1142
+
"roundtrip offset", `Quick, test_unified_roundtrip_offset;
1143
+
"roundtrip local", `Quick, test_unified_roundtrip_local;
1144
+
"roundtrip date", `Quick, test_unified_roundtrip_date;
1145
+
"roundtrip time", `Quick, test_unified_roundtrip_time;
1146
+
"not datetime", `Quick, test_unified_not_datetime;
1147
+
]
1148
+
1149
+
(* ============================================
1150
+
Main
1151
+
============================================ *)
1152
+
1153
+
let () =
1154
+
Alcotest.run "tomlt" [
1155
+
"comments", comment_tests;
1156
+
"keys", key_tests;
1157
+
"strings", string_tests;
1158
+
"integers", integer_tests;
1159
+
"floats", float_tests;
1160
+
"booleans", boolean_tests;
1161
+
"datetimes", datetime_tests;
1162
+
"arrays", array_tests;
1163
+
"tables", table_tests;
1164
+
"inline_tables", inline_table_tests;
1165
+
"array_of_tables", array_of_tables_tests;
1166
+
"encoding", encode_tests;
1167
+
"edge_cases", edge_case_tests;
1168
+
"ptime", ptime_tests;
1169
+
"unified_datetime", unified_datetime_tests;
1170
+
]
+1
vendor/opam/tomlt/test/test_tomlt.mli
+1
vendor/opam/tomlt/test/test_tomlt.mli
···
1
+
(* empty *)
+3
vendor/opam/tomlt/test_jsont/dune
+3
vendor/opam/tomlt/test_jsont/dune
+166
vendor/opam/tomlt/test_jsont/test_tomlt_jsont.ml
+166
vendor/opam/tomlt/test_jsont/test_tomlt_jsont.ml
···
1
+
(* Tests for tomlt-jsont module *)
2
+
3
+
open Alcotest
4
+
5
+
module Toml = Tomlt.Toml
6
+
7
+
(* Test jsont decode/encode *)
8
+
let test_jsont_decode_encode name json expected_toml () =
9
+
(* Test jsont decode *)
10
+
match Tomlt_jsont.decode_jsont json with
11
+
| Error e -> Alcotest.fail ("decode failed: " ^ e)
12
+
| Ok toml ->
13
+
check bool (name ^ " jsont decode") true (Toml.equal toml expected_toml);
14
+
(* Test jsont encode then decode roundtrip *)
15
+
match Tomlt_jsont.encode_jsont toml with
16
+
| Error e -> Alcotest.fail ("encode failed: " ^ e)
17
+
| Ok json' ->
18
+
match Tomlt_jsont.decode_jsont json' with
19
+
| Error e -> Alcotest.fail ("roundtrip decode failed: " ^ e)
20
+
| Ok toml' ->
21
+
check bool (name ^ " jsont roundtrip") true (Toml.equal toml toml')
22
+
23
+
(* Test native encode/decode with table documents *)
24
+
let test_native_roundtrip name toml () =
25
+
let json = Tomlt_jsont.encode toml in
26
+
let toml' = Tomlt_jsont.decode json in
27
+
check bool (name ^ " roundtrip") true (Toml.equal toml toml')
28
+
29
+
(* Test cases for jsont codec (handles scalar tagged values correctly) *)
30
+
let jsont_tests = [
31
+
"string", `Quick, test_jsont_decode_encode "string"
32
+
{|{"type":"string","value":"hello"}|}
33
+
(Toml.String "hello");
34
+
35
+
"integer", `Quick, test_jsont_decode_encode "integer"
36
+
{|{"type":"integer","value":"42"}|}
37
+
(Toml.Int 42L);
38
+
39
+
"float", `Quick, test_jsont_decode_encode "float"
40
+
{|{"type":"float","value":"3.14"}|}
41
+
(Toml.Float 3.14);
42
+
43
+
"bool true", `Quick, test_jsont_decode_encode "bool true"
44
+
{|{"type":"bool","value":"true"}|}
45
+
(Toml.Bool true);
46
+
47
+
"bool false", `Quick, test_jsont_decode_encode "bool false"
48
+
{|{"type":"bool","value":"false"}|}
49
+
(Toml.Bool false);
50
+
51
+
"datetime", `Quick, test_jsont_decode_encode "datetime"
52
+
{|{"type":"datetime","value":"1979-05-27T07:32:00Z"}|}
53
+
(Toml.Datetime "1979-05-27T07:32:00Z");
54
+
55
+
"datetime-local", `Quick, test_jsont_decode_encode "datetime-local"
56
+
{|{"type":"datetime-local","value":"1979-05-27T07:32:00"}|}
57
+
(Toml.Datetime_local "1979-05-27T07:32:00");
58
+
59
+
"date-local", `Quick, test_jsont_decode_encode "date-local"
60
+
{|{"type":"date-local","value":"1979-05-27"}|}
61
+
(Toml.Date_local "1979-05-27");
62
+
63
+
"time-local", `Quick, test_jsont_decode_encode "time-local"
64
+
{|{"type":"time-local","value":"07:32:00"}|}
65
+
(Toml.Time_local "07:32:00");
66
+
67
+
"array of integers", `Quick, test_jsont_decode_encode "array of integers"
68
+
{|[{"type":"integer","value":"1"},{"type":"integer","value":"2"},{"type":"integer","value":"3"}]|}
69
+
(Toml.Array [Toml.Int 1L; Toml.Int 2L; Toml.Int 3L]);
70
+
71
+
"array of strings", `Quick, test_jsont_decode_encode "array of strings"
72
+
{|[{"type":"string","value":"a"},{"type":"string","value":"b"}]|}
73
+
(Toml.Array [Toml.String "a"; Toml.String "b"]);
74
+
75
+
"empty table", `Quick, test_jsont_decode_encode "empty table"
76
+
{|{}|}
77
+
(Toml.Table []);
78
+
79
+
"simple table", `Quick, test_jsont_decode_encode "simple table"
80
+
{|{"name":{"type":"string","value":"test"}}|}
81
+
(Toml.Table [("name", Toml.String "test")]);
82
+
83
+
"table with multiple types", `Quick, test_jsont_decode_encode "table with multiple types"
84
+
{|{"name":{"type":"string","value":"test"},"count":{"type":"integer","value":"5"},"enabled":{"type":"bool","value":"true"}}|}
85
+
(* Note: jsont uses String_map which sorts keys alphabetically *)
86
+
(Toml.Table [
87
+
("count", Toml.Int 5L);
88
+
("enabled", Toml.Bool true);
89
+
("name", Toml.String "test")
90
+
]);
91
+
92
+
"nested table", `Quick, test_jsont_decode_encode "nested table"
93
+
{|{"outer":{"inner":{"type":"string","value":"value"}}}|}
94
+
(Toml.Table [("outer", Toml.Table [("inner", Toml.String "value")])]);
95
+
96
+
"table with array", `Quick, test_jsont_decode_encode "table with array"
97
+
{|{"items":[{"type":"integer","value":"1"},{"type":"integer","value":"2"}]}|}
98
+
(Toml.Table [("items", Toml.Array [Toml.Int 1L; Toml.Int 2L])]);
99
+
]
100
+
101
+
(* Test cases for native encode/decode (roundtrip with table documents) *)
102
+
let native_tests = [
103
+
"empty table", `Quick, test_native_roundtrip "empty table"
104
+
(Toml.Table []);
105
+
106
+
"simple table", `Quick, test_native_roundtrip "simple table"
107
+
(Toml.Table [("key", Toml.String "value")]);
108
+
109
+
"table with all types", `Quick, test_native_roundtrip "table with all types"
110
+
(Toml.Table [
111
+
("string", Toml.String "hello");
112
+
("integer", Toml.Int 42L);
113
+
("float", Toml.Float 3.14);
114
+
("bool", Toml.Bool true);
115
+
("datetime", Toml.Datetime "1979-05-27T07:32:00Z");
116
+
("datetime_local", Toml.Datetime_local "1979-05-27T07:32:00");
117
+
("date_local", Toml.Date_local "1979-05-27");
118
+
("time_local", Toml.Time_local "07:32:00");
119
+
]);
120
+
121
+
"nested table", `Quick, test_native_roundtrip "nested table"
122
+
(Toml.Table [
123
+
("outer", Toml.Table [
124
+
("inner", Toml.String "value")
125
+
])
126
+
]);
127
+
128
+
"table with array", `Quick, test_native_roundtrip "table with array"
129
+
(Toml.Table [
130
+
("items", Toml.Array [Toml.Int 1L; Toml.Int 2L; Toml.Int 3L])
131
+
]);
132
+
133
+
"complex document", `Quick, test_native_roundtrip "complex document"
134
+
(Toml.Table [
135
+
("title", Toml.String "TOML Example");
136
+
("database", Toml.Table [
137
+
("server", Toml.String "192.168.1.1");
138
+
("ports", Toml.Array [Toml.Int 8000L; Toml.Int 8001L; Toml.Int 8002L]);
139
+
("enabled", Toml.Bool true);
140
+
]);
141
+
]);
142
+
]
143
+
144
+
(* Test native compatibility with existing tests *)
145
+
let compatibility_tests = [
146
+
"valid toml roundtrip", `Quick, (fun () ->
147
+
let toml_str = {|
148
+
[server]
149
+
host = "localhost"
150
+
port = 8080
151
+
|} in
152
+
match Tomlt_bytesrw.of_string toml_str with
153
+
| Error _ -> Alcotest.fail "TOML parse failed"
154
+
| Ok toml ->
155
+
let json = Tomlt_jsont.encode toml in
156
+
let toml' = Tomlt_jsont.decode json in
157
+
check bool "roundtrip" true (Toml.equal toml toml')
158
+
);
159
+
]
160
+
161
+
let () =
162
+
run "tomlt_jsont" [
163
+
"jsont", jsont_tests;
164
+
"native", native_tests;
165
+
"compatibility", compatibility_tests;
166
+
]
+44
vendor/opam/tomlt/tomlt.opam
+44
vendor/opam/tomlt/tomlt.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "TOML 1.1 codec library for OCaml"
4
+
description: """
5
+
Tomlt is a type-safe TOML 1.1 codec library for OCaml, providing
6
+
bidirectional encoding and decoding using a combinator-based approach
7
+
inspired by Jsont. The core library provides value types and codec
8
+
combinators. Optional subpackages provide I/O support:
9
+
- tomlt.bytesrw: Streaming parser/encoder using Bytesrw
10
+
- tomlt.eio: Eio integration with system clock
11
+
- tomlt.unix: Unix I/O with system clock
12
+
- tomlt.jsont: Jsont codecs for toml-test JSON format"""
13
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
14
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
15
+
license: "ISC"
16
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-tomlt"
17
+
bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-tomlt/issues"
18
+
depends: [
19
+
"dune" {>= "3.0"}
20
+
"ocaml" {>= "4.14.0"}
21
+
"ptime" {>= "1.0.0"}
22
+
"alcotest" {with-test}
23
+
"odoc" {with-doc}
24
+
]
25
+
depopts: [
26
+
"bytesrw" {>= "0.1.0"}
27
+
"uutf" {>= "1.0.0"}
28
+
"eio"
29
+
"jsont"
30
+
]
31
+
build: [
32
+
["dune" "subst"] {dev}
33
+
[
34
+
"dune"
35
+
"build"
36
+
"-p"
37
+
name
38
+
"-j"
39
+
jobs
40
+
"@install"
41
+
"@runtest" {with-test}
42
+
"@doc" {with-doc}
43
+
]
44
+
]