anil.recoil.org
Yaml encoder/decoder for OCaml jsont codecs
init import
+14
dune-project
+14
dune-project
···
1
+
(lang dune 3.18)
2
+
(name yamlt)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(package
7
+
(name yamlt)
8
+
(synopsis "YAML codec using Jsont type descriptions")
9
+
(description "Allows the same Jsont.t codec definitions to work for both JSON and YAML")
10
+
(depends
11
+
(ocaml (>= 4.14.0))
12
+
yamlrw
13
+
jsont
14
+
bytesrw))
+4
lib/dune
+4
lib/dune
+869
lib/yamlt.ml
+869
lib/yamlt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Bytesrw
7
+
open Jsont.Repr
8
+
open Yamlrw
9
+
10
+
(* YAML format *)
11
+
12
+
type yaml_format = Block | Flow | Layout
13
+
14
+
(* Decoder *)
15
+
16
+
type decoder = {
17
+
parser : Parser.t;
18
+
file : string;
19
+
locs : bool;
20
+
_layout : bool; (* For future layout preservation *)
21
+
max_depth : int;
22
+
max_nodes : int;
23
+
mutable node_count : int;
24
+
mutable current : Event.spanned option;
25
+
_anchors : (string, Jsont.json) Hashtbl.t; (* For future anchor resolution *)
26
+
meta_none : Jsont.Meta.t;
27
+
}
28
+
29
+
let make_decoder
30
+
?(locs = false) ?(layout = false) ?(file = "-")
31
+
?(max_depth = 100) ?(max_nodes = 10_000_000) parser =
32
+
let meta_none = Jsont.Meta.make (Jsont.Textloc.(set_file none) file) in
33
+
{ parser; file; locs; _layout = layout; max_depth; max_nodes;
34
+
node_count = 0; current = None;
35
+
_anchors = Hashtbl.create 16; meta_none }
36
+
37
+
(* Decoder helpers *)
38
+
39
+
let check_depth d ~nest =
40
+
if nest > d.max_depth then
41
+
Jsont.Error.msgf Jsont.Meta.none "Maximum nesting depth %d exceeded" d.max_depth
42
+
43
+
let check_nodes d =
44
+
d.node_count <- d.node_count + 1;
45
+
if d.node_count > d.max_nodes then
46
+
Jsont.Error.msgf Jsont.Meta.none "Maximum node count %d exceeded" d.max_nodes
47
+
48
+
let meta_of_span d span =
49
+
if not d.locs then d.meta_none else
50
+
let start = span.Span.start and stop = span.Span.stop in
51
+
let first_byte = start.Position.index in
52
+
let last_byte = max first_byte (stop.Position.index - 1) in
53
+
(* line_pos is (line_number, byte_position_of_line_start) *)
54
+
let first_line = (start.Position.line, start.Position.index - start.Position.column + 1) in
55
+
let last_line = (stop.Position.line, stop.Position.index - stop.Position.column + 1) in
56
+
let textloc = Jsont.Textloc.make ~file:d.file
57
+
~first_byte ~last_byte ~first_line ~last_line in
58
+
Jsont.Meta.make textloc
59
+
60
+
let next_event d =
61
+
d.current <- Parser.next d.parser;
62
+
d.current
63
+
64
+
let peek_event d =
65
+
match d.current with
66
+
| Some _ -> d.current
67
+
| None -> next_event d
68
+
69
+
let skip_event d =
70
+
d.current <- None
71
+
72
+
let _expect_event d pred name =
73
+
match peek_event d with
74
+
| Some ev when pred ev.Event.event -> skip_event d; ev
75
+
| Some ev ->
76
+
let span = ev.Event.span in
77
+
let meta = meta_of_span d span in
78
+
Jsont.Error.msgf meta "Expected %s but found %a" name Event.pp ev.Event.event
79
+
| None ->
80
+
Jsont.Error.msgf Jsont.Meta.none "Expected %s but reached end of stream" name
81
+
82
+
(* Error helpers *)
83
+
84
+
let _err_expected_scalar d ev =
85
+
let meta = meta_of_span d ev.Event.span in
86
+
Jsont.Error.msgf meta "Expected scalar but found %a" Event.pp ev.Event.event
87
+
88
+
let err_type_mismatch d span t ~fnd =
89
+
let meta = meta_of_span d span in
90
+
Jsont.Error.msgf meta "Expected %s but found %s"
91
+
(Jsont.Repr.kinded_sort t) fnd
92
+
93
+
(* YAML scalar resolution *)
94
+
95
+
let is_null_scalar s =
96
+
s = "" || s = "~" ||
97
+
s = "null" || s = "Null" || s = "NULL"
98
+
99
+
let bool_of_scalar_opt s =
100
+
match s with
101
+
| "true" | "True" | "TRUE"
102
+
| "yes" | "Yes" | "YES"
103
+
| "on" | "On" | "ON" -> Some true
104
+
| "false" | "False" | "FALSE"
105
+
| "no" | "No" | "NO"
106
+
| "off" | "Off" | "OFF" -> Some false
107
+
| _ -> None
108
+
109
+
let float_of_scalar_opt s =
110
+
(* Handle YAML special floats *)
111
+
match s with
112
+
| ".inf" | ".Inf" | ".INF" -> Some Float.infinity
113
+
| "+.inf" | "+.Inf" | "+.INF" -> Some Float.infinity
114
+
| "-.inf" | "-.Inf" | "-.INF" -> Some Float.neg_infinity
115
+
| ".nan" | ".NaN" | ".NAN" -> Some Float.nan
116
+
| _ ->
117
+
(* Try parsing as number, allowing underscores *)
118
+
let s' = String.concat "" (String.split_on_char '_' s) in
119
+
(* Try int first (supports 0o, 0x, 0b) then float *)
120
+
match int_of_string_opt s' with
121
+
| Some i -> Some (float_of_int i)
122
+
| None -> float_of_string_opt s'
123
+
124
+
let _int_of_scalar_opt s =
125
+
(* Handle hex, octal, and regular integers with underscores *)
126
+
let s' = String.concat "" (String.split_on_char '_' s) in
127
+
int_of_string_opt s'
128
+
129
+
(* Decode a scalar value according to expected type *)
130
+
let rec decode_scalar_as :
131
+
type a. decoder -> Event.spanned -> string -> Scalar_style.t -> a t -> a =
132
+
fun d ev value style t ->
133
+
check_nodes d;
134
+
let meta = meta_of_span d ev.Event.span in
135
+
match t with
136
+
| Null map ->
137
+
if is_null_scalar value then map.dec meta ()
138
+
else err_type_mismatch d ev.span t ~fnd:("scalar " ^ value)
139
+
| Bool map ->
140
+
(match bool_of_scalar_opt value with
141
+
| Some b -> map.dec meta b
142
+
| None ->
143
+
(* For explicitly quoted strings, fail *)
144
+
if style <> `Plain then
145
+
err_type_mismatch d ev.span t ~fnd:("string " ^ value)
146
+
else
147
+
err_type_mismatch d ev.span t ~fnd:("scalar " ^ value))
148
+
| Number map ->
149
+
(* Handle null -> nan mapping like jsont *)
150
+
if is_null_scalar value then map.dec meta Float.nan
151
+
else
152
+
(match float_of_scalar_opt value with
153
+
| Some f -> map.dec meta f
154
+
| None -> err_type_mismatch d ev.span t ~fnd:("scalar " ^ value))
155
+
| String map ->
156
+
(* Don't decode null values as strings - they should fail so outer combinators
157
+
like 'option' or 'any' can handle them properly *)
158
+
if is_null_scalar value then
159
+
err_type_mismatch d ev.span t ~fnd:"null"
160
+
else
161
+
(* Strings accept any non-null scalar value *)
162
+
map.dec meta value
163
+
| Map m ->
164
+
(* Handle Map combinators (e.g., from Jsont.option) *)
165
+
m.dec (decode_scalar_as d ev value style m.dom)
166
+
| Rec lazy_t ->
167
+
(* Handle recursive types *)
168
+
decode_scalar_as d ev value style (Lazy.force lazy_t)
169
+
| _ ->
170
+
err_type_mismatch d ev.span t ~fnd:"scalar"
171
+
172
+
(* Forward declaration for mutual recursion *)
173
+
let rec decode : type a. decoder -> nest:int -> a t -> a =
174
+
fun d ~nest t ->
175
+
check_depth d ~nest;
176
+
match peek_event d with
177
+
| None -> Jsont.Error.msgf Jsont.Meta.none "Unexpected end of YAML stream"
178
+
| Some ev ->
179
+
match ev.Event.event, t with
180
+
(* Scalar events *)
181
+
| Event.Scalar { value; style; anchor; _ }, _ ->
182
+
skip_event d;
183
+
let result = decode_scalar d ~nest ev value style t in
184
+
(* Store anchor if present - TODO: implement anchor storage *)
185
+
(match anchor with
186
+
| Some _name ->
187
+
(* We need generic JSON for anchors - decode as json and convert back *)
188
+
()
189
+
| None -> ());
190
+
result
191
+
192
+
(* Alias *)
193
+
| Event.Alias { anchor }, _ ->
194
+
skip_event d;
195
+
decode_alias d ev anchor t
196
+
197
+
(* Map combinator - must come before specific event matches *)
198
+
| _, Map m ->
199
+
m.dec (decode d ~nest m.dom)
200
+
201
+
(* Recursive types - must come before specific event matches *)
202
+
| _, Rec lazy_t ->
203
+
decode d ~nest (Lazy.force lazy_t)
204
+
205
+
(* Sequence -> Array *)
206
+
| Event.Sequence_start _, Array map ->
207
+
decode_array d ~nest ev map
208
+
209
+
| Event.Sequence_start _, Any map ->
210
+
decode_any_sequence d ~nest ev t map
211
+
212
+
| Event.Sequence_start _, _ ->
213
+
err_type_mismatch d ev.span t ~fnd:"sequence"
214
+
215
+
(* Mapping -> Object *)
216
+
| Event.Mapping_start _, Object map ->
217
+
decode_object d ~nest ev map
218
+
219
+
| Event.Mapping_start _, Any map ->
220
+
decode_any_mapping d ~nest ev t map
221
+
222
+
| Event.Mapping_start _, _ ->
223
+
err_type_mismatch d ev.span t ~fnd:"mapping"
224
+
225
+
(* Unexpected events *)
226
+
| Event.Sequence_end, _ ->
227
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected sequence end"
228
+
| Event.Mapping_end, _ ->
229
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected mapping end"
230
+
| Event.Document_start _, _ ->
231
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected document start"
232
+
| Event.Document_end _, _ ->
233
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected document end"
234
+
| Event.Stream_start _, _ ->
235
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected stream start"
236
+
| Event.Stream_end, _ ->
237
+
Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected stream end"
238
+
239
+
and decode_scalar : type a. decoder -> nest:int -> Event.spanned -> string -> Scalar_style.t -> a t -> a =
240
+
fun d ~nest ev value style t ->
241
+
match t with
242
+
| Any map -> decode_any_scalar d ev value style t map
243
+
| Map m -> m.dec (decode_scalar d ~nest ev value style m.dom)
244
+
| Rec lazy_t -> decode_scalar d ~nest ev value style (Lazy.force lazy_t)
245
+
| _ -> decode_scalar_as d ev value style t
246
+
247
+
and decode_any_scalar : type a. decoder -> Event.spanned -> string -> Scalar_style.t -> a t -> a any_map -> a =
248
+
fun d ev value style t map ->
249
+
check_nodes d;
250
+
(* Determine which decoder to use based on scalar content *)
251
+
if is_null_scalar value then
252
+
match map.dec_null with
253
+
| Some t' -> decode_scalar_as d ev value style t'
254
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Null
255
+
else if style = `Plain then
256
+
(* Try bool, then number, then string *)
257
+
match bool_of_scalar_opt value with
258
+
| Some _ ->
259
+
(match map.dec_bool with
260
+
| Some t' -> decode_scalar_as d ev value style t'
261
+
| None ->
262
+
match map.dec_string with
263
+
| Some t' -> decode_scalar_as d ev value style t'
264
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Bool)
265
+
| None ->
266
+
match float_of_scalar_opt value with
267
+
| Some _ ->
268
+
(match map.dec_number with
269
+
| Some t' -> decode_scalar_as d ev value style t'
270
+
| None ->
271
+
match map.dec_string with
272
+
| Some t' -> decode_scalar_as d ev value style t'
273
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Number)
274
+
| None ->
275
+
(* Plain scalar that's not bool/number -> string *)
276
+
match map.dec_string with
277
+
| Some t' -> decode_scalar_as d ev value style t'
278
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.String
279
+
else
280
+
(* Quoted scalars are strings *)
281
+
match map.dec_string with
282
+
| Some t' -> decode_scalar_as d ev value style t'
283
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.String
284
+
285
+
and decode_alias : type a. decoder -> Event.spanned -> string -> a t -> a =
286
+
fun d ev anchor t ->
287
+
check_nodes d;
288
+
match Hashtbl.find_opt d._anchors anchor with
289
+
| None ->
290
+
let meta = meta_of_span d ev.span in
291
+
Jsont.Error.msgf meta "Unknown anchor: %s" anchor
292
+
| Some json ->
293
+
(* Decode the stored JSON value through the type *)
294
+
let t' = Jsont.Repr.unsafe_to_t t in
295
+
match Jsont.Json.decode' t' json with
296
+
| Ok v -> v
297
+
| Error e -> raise (Jsont.Error e)
298
+
299
+
and decode_array : type a elt b. decoder -> nest:int -> Event.spanned -> (a, elt, b) array_map -> a =
300
+
fun d ~nest start_ev map ->
301
+
skip_event d; (* consume Sequence_start *)
302
+
check_nodes d;
303
+
let meta = meta_of_span d start_ev.span in
304
+
let builder = ref (map.dec_empty ()) in
305
+
let idx = ref 0 in
306
+
let rec loop () =
307
+
match peek_event d with
308
+
| Some { Event.event = Event.Sequence_end; span } ->
309
+
skip_event d;
310
+
let end_meta = meta_of_span d span in
311
+
map.dec_finish end_meta !idx !builder
312
+
| Some _ ->
313
+
let i = !idx in
314
+
(try
315
+
if map.dec_skip i !builder then begin
316
+
(* Skip this element by decoding as ignore *)
317
+
let _ : unit = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore) in
318
+
()
319
+
end else begin
320
+
let elt = decode d ~nest:(nest + 1) map.elt in
321
+
builder := map.dec_add i elt !builder
322
+
end
323
+
with Jsont.Error e ->
324
+
let imeta = Jsont.Meta.none in
325
+
Jsont.Repr.error_push_array meta map (i, imeta) e);
326
+
incr idx;
327
+
loop ()
328
+
| None ->
329
+
Jsont.Error.msgf meta "Unclosed sequence"
330
+
in
331
+
loop ()
332
+
333
+
and decode_any_sequence : type a. decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =
334
+
fun d ~nest ev t map ->
335
+
match map.dec_array with
336
+
| Some t' ->
337
+
(* The t' decoder might be wrapped (e.g., Map for option types)
338
+
Directly decode the array and let the wrapper handle it *)
339
+
(match t' with
340
+
| Array array_map ->
341
+
decode_array d ~nest ev array_map
342
+
| _ ->
343
+
(* For wrapped types like Map (Array ...), use full decode *)
344
+
decode d ~nest t')
345
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Array
346
+
347
+
and decode_object : type o. decoder -> nest:int -> Event.spanned -> (o, o) object_map -> o =
348
+
fun d ~nest start_ev map ->
349
+
skip_event d; (* consume Mapping_start *)
350
+
check_nodes d;
351
+
let meta = meta_of_span d start_ev.span in
352
+
let dict = decode_object_members d ~nest meta map String_map.empty Dict.empty in
353
+
let dict = Dict.add object_meta_arg meta dict in
354
+
apply_dict map.dec dict
355
+
356
+
and decode_object_members : type o.
357
+
decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->
358
+
mem_dec String_map.t -> Dict.t -> Dict.t =
359
+
fun d ~nest obj_meta map mem_miss dict ->
360
+
(* Merge expected member decoders *)
361
+
let u _ _ _ = assert false in
362
+
let mem_miss = String_map.union u mem_miss map.mem_decs in
363
+
match map.shape with
364
+
| Object_basic umems ->
365
+
decode_object_basic d ~nest obj_meta map umems mem_miss dict
366
+
| Object_cases (umems_opt, cases) ->
367
+
(* Wrap umems_opt to hide existential types *)
368
+
let umems = Unknown_mems umems_opt in
369
+
decode_object_cases d ~nest obj_meta map umems cases mem_miss [] dict
370
+
371
+
and decode_object_basic : type o mems builder.
372
+
decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->
373
+
(o, mems, builder) unknown_mems ->
374
+
mem_dec String_map.t -> Dict.t -> Dict.t =
375
+
fun d ~nest obj_meta map umems mem_miss dict ->
376
+
let ubuilder = ref (match umems with
377
+
| Unknown_skip | Unknown_error -> Obj.magic ()
378
+
| Unknown_keep (mmap, _) -> mmap.dec_empty ()) in
379
+
let mem_miss = ref mem_miss in
380
+
let dict = ref dict in
381
+
let rec loop () =
382
+
match peek_event d with
383
+
| Some { Event.event = Event.Mapping_end; _ } ->
384
+
skip_event d;
385
+
(* Finalize *)
386
+
finish_object obj_meta map umems !ubuilder !mem_miss !dict
387
+
| Some ev ->
388
+
(* Expect a scalar key *)
389
+
let name, name_meta = decode_mapping_key d ev in
390
+
(* Look up member decoder *)
391
+
(match String_map.find_opt name map.mem_decs with
392
+
| Some (Mem_dec mem) ->
393
+
mem_miss := String_map.remove name !mem_miss;
394
+
(try
395
+
let v = decode d ~nest:(nest + 1) mem.type' in
396
+
dict := Dict.add mem.id v !dict
397
+
with Jsont.Error e ->
398
+
Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)
399
+
| None ->
400
+
(* Unknown member *)
401
+
match umems with
402
+
| Unknown_skip ->
403
+
let _ : unit = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore) in
404
+
()
405
+
| Unknown_error ->
406
+
Jsont.Repr.unexpected_mems_error obj_meta map ~fnd:[(name, name_meta)]
407
+
| Unknown_keep (mmap, _) ->
408
+
(try
409
+
let v = decode d ~nest:(nest + 1) mmap.mems_type in
410
+
ubuilder := mmap.dec_add name_meta name v !ubuilder
411
+
with Jsont.Error e ->
412
+
Jsont.Repr.error_push_object obj_meta map (name, name_meta) e));
413
+
loop ()
414
+
| None ->
415
+
Jsont.Error.msgf obj_meta "Unclosed mapping"
416
+
in
417
+
loop ()
418
+
419
+
and finish_object : type o mems builder.
420
+
Jsont.Meta.t -> (o, o) object_map -> (o, mems, builder) unknown_mems ->
421
+
builder -> mem_dec String_map.t -> Dict.t -> Dict.t =
422
+
fun meta map umems ubuilder mem_miss dict ->
423
+
let dict = Dict.add object_meta_arg meta dict in
424
+
let dict = match umems with
425
+
| Unknown_skip | Unknown_error -> dict
426
+
| Unknown_keep (mmap, _) -> Dict.add mmap.id (mmap.dec_finish meta ubuilder) dict
427
+
in
428
+
(* Check for missing required members *)
429
+
let add_default _ (Mem_dec mem_map) dict =
430
+
match mem_map.dec_absent with
431
+
| Some v -> Dict.add mem_map.id v dict
432
+
| None -> raise Exit
433
+
in
434
+
try String_map.fold add_default mem_miss dict
435
+
with Exit ->
436
+
let no_default _ (Mem_dec mm) = Option.is_none mm.dec_absent in
437
+
let exp = String_map.filter no_default mem_miss in
438
+
Jsont.Repr.missing_mems_error meta map ~exp ~fnd:[]
439
+
440
+
and decode_object_cases : type o cases tag.
441
+
decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->
442
+
unknown_mems_option ->
443
+
(o, cases, tag) object_cases ->
444
+
mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =
445
+
fun d ~nest obj_meta map umems cases mem_miss delayed dict ->
446
+
match peek_event d with
447
+
| Some { Event.event = Event.Mapping_end; _ } ->
448
+
skip_event d;
449
+
(* No tag found - use dec_absent if available *)
450
+
(match cases.tag.dec_absent with
451
+
| Some tag ->
452
+
decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss delayed dict
453
+
| None ->
454
+
(* Missing required case tag *)
455
+
let exp = String_map.singleton cases.tag.name (Mem_dec cases.tag) in
456
+
let fnd = List.map (fun ((n, _), _) -> n) delayed in
457
+
Jsont.Repr.missing_mems_error obj_meta map ~exp ~fnd)
458
+
| Some ev ->
459
+
let name, name_meta = decode_mapping_key d ev in
460
+
if String.equal name cases.tag.name then begin
461
+
(* Found the case tag *)
462
+
let tag = decode d ~nest:(nest + 1) cases.tag.type' in
463
+
decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss delayed dict
464
+
end else begin
465
+
(* Not the case tag - check if known member or delay *)
466
+
match String_map.find_opt name map.mem_decs with
467
+
| Some (Mem_dec mem) ->
468
+
let mem_miss = String_map.remove name mem_miss in
469
+
(try
470
+
let v = decode d ~nest:(nest + 1) mem.type' in
471
+
let dict = Dict.add mem.id v dict in
472
+
decode_object_cases d ~nest obj_meta map umems cases mem_miss delayed dict
473
+
with Jsont.Error e ->
474
+
Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)
475
+
| None ->
476
+
(* Unknown member - decode as generic JSON and delay *)
477
+
let v = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.json) in
478
+
let delayed = ((name, name_meta), v) :: delayed in
479
+
decode_object_cases d ~nest obj_meta map umems cases mem_miss delayed dict
480
+
end
481
+
| None ->
482
+
Jsont.Error.msgf obj_meta "Unclosed mapping"
483
+
484
+
and decode_with_case_tag : type o cases tag.
485
+
decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->
486
+
unknown_mems_option ->
487
+
(o, cases, tag) object_cases -> tag ->
488
+
mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =
489
+
fun d ~nest obj_meta map umems cases tag mem_miss delayed dict ->
490
+
let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in
491
+
match List.find_opt eq_tag cases.cases with
492
+
| None ->
493
+
Jsont.Repr.unexpected_case_tag_error obj_meta map cases tag
494
+
| Some (Case case) ->
495
+
(* Continue decoding with the case's object map *)
496
+
let case_dict = decode_case_remaining d ~nest obj_meta case.object_map
497
+
umems mem_miss delayed dict in
498
+
let case_value = apply_dict case.object_map.dec case_dict in
499
+
Dict.add cases.id (case.dec case_value) dict
500
+
501
+
and decode_case_remaining : type o.
502
+
decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->
503
+
unknown_mems_option ->
504
+
mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =
505
+
fun d ~nest obj_meta case_map _umems mem_miss delayed dict ->
506
+
(* First, process delayed members against the case map *)
507
+
let u _ _ _ = assert false in
508
+
let mem_miss = String_map.union u mem_miss case_map.mem_decs in
509
+
let dict, mem_miss = List.fold_left (fun (dict, mem_miss) ((name, meta), json) ->
510
+
match String_map.find_opt name case_map.mem_decs with
511
+
| Some (Mem_dec mem) ->
512
+
let t' = Jsont.Repr.unsafe_to_t mem.type' in
513
+
(match Jsont.Json.decode' t' json with
514
+
| Ok v ->
515
+
let dict = Dict.add mem.id v dict in
516
+
let mem_miss = String_map.remove name mem_miss in
517
+
(dict, mem_miss)
518
+
| Error e ->
519
+
Jsont.Repr.error_push_object obj_meta case_map (name, meta) e)
520
+
| None ->
521
+
(* Unknown for case too - skip them *)
522
+
(dict, mem_miss)
523
+
) (dict, mem_miss) delayed in
524
+
(* Then continue reading remaining members using case's own unknown handling *)
525
+
match case_map.shape with
526
+
| Object_basic case_umems ->
527
+
decode_object_basic d ~nest obj_meta case_map case_umems mem_miss dict
528
+
| Object_cases _ ->
529
+
(* Nested cases shouldn't happen - use skip for safety *)
530
+
decode_object_basic d ~nest obj_meta case_map Unknown_skip mem_miss dict
531
+
532
+
and decode_any_mapping : type a. decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =
533
+
fun d ~nest ev t map ->
534
+
match map.dec_object with
535
+
| Some t' -> decode d ~nest t'
536
+
| None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Object
537
+
538
+
and decode_mapping_key : decoder -> Event.spanned -> string * Jsont.Meta.t =
539
+
fun d ev ->
540
+
match ev.Event.event with
541
+
| Event.Scalar { value; _ } ->
542
+
skip_event d;
543
+
let meta = meta_of_span d ev.span in
544
+
(value, meta)
545
+
| _ ->
546
+
let meta = meta_of_span d ev.span in
547
+
Jsont.Error.msgf meta "Mapping keys must be scalars (strings), found %a"
548
+
Event.pp ev.event
549
+
550
+
(* Skip stream/document wrappers *)
551
+
let skip_to_content d =
552
+
let rec loop () =
553
+
match peek_event d with
554
+
| Some { Event.event = Event.Stream_start _; _ } -> skip_event d; loop ()
555
+
| Some { Event.event = Event.Document_start _; _ } -> skip_event d; loop ()
556
+
| _ -> ()
557
+
in
558
+
loop ()
559
+
560
+
let skip_end_wrappers d =
561
+
let rec loop () =
562
+
match peek_event d with
563
+
| Some { Event.event = Event.Document_end _; _ } -> skip_event d; loop ()
564
+
| Some { Event.event = Event.Stream_end; _ } -> skip_event d; loop ()
565
+
| None -> ()
566
+
| Some ev ->
567
+
let meta = meta_of_span d ev.span in
568
+
Jsont.Error.msgf meta "Expected end of document but found %a" Event.pp ev.event
569
+
in
570
+
loop ()
571
+
572
+
(* Public decode API *)
573
+
574
+
let decode' ?layout ?locs ?file ?max_depth ?max_nodes t reader =
575
+
let parser = Parser.of_reader reader in
576
+
let d = make_decoder ?layout ?locs ?file ?max_depth ?max_nodes parser in
577
+
try
578
+
skip_to_content d;
579
+
let t' = Jsont.Repr.of_t t in
580
+
let v = decode d ~nest:0 t' in
581
+
skip_end_wrappers d;
582
+
Ok v
583
+
with
584
+
| Jsont.Error e -> Error e
585
+
| Error.Yamlrw_error err ->
586
+
let msg = Error.to_string err in
587
+
Error (Jsont.Error.make_msg Jsont.Error.Context.empty Jsont.Meta.none msg)
588
+
589
+
let decode ?layout ?locs ?file ?max_depth ?max_nodes t reader =
590
+
Result.map_error Jsont.Error.to_string
591
+
(decode' ?layout ?locs ?file ?max_depth ?max_nodes t reader)
592
+
593
+
let decode_string' ?layout ?locs ?file ?max_depth ?max_nodes t s =
594
+
decode' ?layout ?locs ?file ?max_depth ?max_nodes t (Bytes.Reader.of_string s)
595
+
596
+
let decode_string ?layout ?locs ?file ?max_depth ?max_nodes t s =
597
+
decode ?layout ?locs ?file ?max_depth ?max_nodes t (Bytes.Reader.of_string s)
598
+
599
+
(* Encoder *)
600
+
601
+
type encoder = {
602
+
emitter : Emitter.t;
603
+
format : yaml_format;
604
+
_indent : int; (* Stored for future use in custom formatting *)
605
+
explicit_doc : bool;
606
+
scalar_style : Scalar_style.t;
607
+
}
608
+
609
+
let make_encoder
610
+
?(format = Block) ?(indent = 2) ?(explicit_doc = false)
611
+
?(scalar_style = `Any) emitter =
612
+
{ emitter; format; _indent = indent; explicit_doc; scalar_style }
613
+
614
+
let layout_style_of_format = function
615
+
| Block -> `Block
616
+
| Flow -> `Flow
617
+
| Layout -> `Any
618
+
619
+
(* Choose appropriate scalar style for a string *)
620
+
let choose_scalar_style ~preferred s =
621
+
if preferred <> `Any then preferred
622
+
else if String.contains s '\n' then `Literal
623
+
else if String.length s > 80 then `Folded
624
+
else `Plain
625
+
626
+
(* Encode null *)
627
+
let encode_null e _meta =
628
+
Emitter.emit e.emitter (Event.Scalar {
629
+
anchor = None;
630
+
tag = None;
631
+
value = "null";
632
+
plain_implicit = true;
633
+
quoted_implicit = true;
634
+
style = `Plain;
635
+
})
636
+
637
+
(* Encode boolean *)
638
+
let encode_bool e _meta b =
639
+
Emitter.emit e.emitter (Event.Scalar {
640
+
anchor = None;
641
+
tag = None;
642
+
value = if b then "true" else "false";
643
+
plain_implicit = true;
644
+
quoted_implicit = true;
645
+
style = `Plain;
646
+
})
647
+
648
+
(* Encode number *)
649
+
let encode_number e _meta f =
650
+
let value =
651
+
if Float.is_nan f then ".nan"
652
+
else if f = Float.infinity then ".inf"
653
+
else if f = Float.neg_infinity then "-.inf"
654
+
else
655
+
let s = Printf.sprintf "%.17g" f in
656
+
(* Ensure it looks like a number *)
657
+
if String.contains s '.' || String.contains s 'e' || String.contains s 'E'
658
+
then s
659
+
else s ^ ".0"
660
+
in
661
+
Emitter.emit e.emitter (Event.Scalar {
662
+
anchor = None;
663
+
tag = None;
664
+
value;
665
+
plain_implicit = true;
666
+
quoted_implicit = true;
667
+
style = `Plain;
668
+
})
669
+
670
+
(* Encode string *)
671
+
let encode_string e _meta s =
672
+
let style = choose_scalar_style ~preferred:e.scalar_style s in
673
+
Emitter.emit e.emitter (Event.Scalar {
674
+
anchor = None;
675
+
tag = None;
676
+
value = s;
677
+
plain_implicit = true;
678
+
quoted_implicit = true;
679
+
style;
680
+
})
681
+
682
+
let rec encode : type a. encoder -> a t -> a -> unit =
683
+
fun e t v ->
684
+
match t with
685
+
| Null map ->
686
+
let meta = map.enc_meta v in
687
+
let () = map.enc v in
688
+
encode_null e meta
689
+
690
+
| Bool map ->
691
+
let meta = map.enc_meta v in
692
+
let b = map.enc v in
693
+
encode_bool e meta b
694
+
695
+
| Number map ->
696
+
let meta = map.enc_meta v in
697
+
let f = map.enc v in
698
+
encode_number e meta f
699
+
700
+
| String map ->
701
+
let meta = map.enc_meta v in
702
+
let s = map.enc v in
703
+
encode_string e meta s
704
+
705
+
| Array map ->
706
+
encode_array e map v
707
+
708
+
| Object map ->
709
+
encode_object e map v
710
+
711
+
| Any map ->
712
+
let t' = map.enc v in
713
+
encode e t' v
714
+
715
+
| Map m ->
716
+
encode e m.dom (m.enc v)
717
+
718
+
| Rec lazy_t ->
719
+
encode e (Lazy.force lazy_t) v
720
+
721
+
and encode_array : type a elt b. encoder -> (a, elt, b) array_map -> a -> unit =
722
+
fun e map v ->
723
+
let style = layout_style_of_format e.format in
724
+
Emitter.emit e.emitter (Event.Sequence_start {
725
+
anchor = None;
726
+
tag = None;
727
+
implicit = true;
728
+
style;
729
+
});
730
+
let _ = map.enc (fun () _idx elt ->
731
+
encode e map.elt elt;
732
+
()
733
+
) () v in
734
+
Emitter.emit e.emitter Event.Sequence_end
735
+
736
+
and encode_object : type o. encoder -> (o, o) object_map -> o -> unit =
737
+
fun e map v ->
738
+
let style = layout_style_of_format e.format in
739
+
Emitter.emit e.emitter (Event.Mapping_start {
740
+
anchor = None;
741
+
tag = None;
742
+
implicit = true;
743
+
style;
744
+
});
745
+
(* Encode each member *)
746
+
List.iter (fun (Mem_enc mem) ->
747
+
let mem_v = mem.enc v in
748
+
if not (mem.enc_omit mem_v) then begin
749
+
(* Emit key *)
750
+
Emitter.emit e.emitter (Event.Scalar {
751
+
anchor = None;
752
+
tag = None;
753
+
value = mem.name;
754
+
plain_implicit = true;
755
+
quoted_implicit = true;
756
+
style = `Plain;
757
+
});
758
+
(* Emit value *)
759
+
encode e mem.type' mem_v
760
+
end
761
+
) map.mem_encs;
762
+
(* Handle case objects *)
763
+
(match map.shape with
764
+
| Object_basic _ -> ()
765
+
| Object_cases (_, cases) ->
766
+
let Case_value (case_map, case_v) = cases.enc_case (cases.enc v) in
767
+
(* Emit case tag *)
768
+
if not (cases.tag.enc_omit (case_map.tag)) then begin
769
+
Emitter.emit e.emitter (Event.Scalar {
770
+
anchor = None;
771
+
tag = None;
772
+
value = cases.tag.name;
773
+
plain_implicit = true;
774
+
quoted_implicit = true;
775
+
style = `Plain;
776
+
});
777
+
encode e cases.tag.type' case_map.tag
778
+
end;
779
+
(* Emit case members *)
780
+
List.iter (fun (Mem_enc mem) ->
781
+
let mem_v = mem.enc case_v in
782
+
if not (mem.enc_omit mem_v) then begin
783
+
Emitter.emit e.emitter (Event.Scalar {
784
+
anchor = None;
785
+
tag = None;
786
+
value = mem.name;
787
+
plain_implicit = true;
788
+
quoted_implicit = true;
789
+
style = `Plain;
790
+
});
791
+
encode e mem.type' mem_v
792
+
end
793
+
) case_map.object_map.mem_encs);
794
+
Emitter.emit e.emitter Event.Mapping_end
795
+
796
+
(* Public encode API *)
797
+
798
+
let encode' ?buf:_ ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer =
799
+
let config = {
800
+
Emitter.default_config with
801
+
indent = Option.value ~default:2 indent;
802
+
layout_style = (match format with
803
+
| Some Flow -> `Flow
804
+
| _ -> `Block);
805
+
} in
806
+
let emitter = Emitter.of_writer ~config writer in
807
+
let e = make_encoder ?format ?indent ?explicit_doc ?scalar_style emitter in
808
+
try
809
+
Emitter.emit e.emitter (Event.Stream_start { encoding = `Utf8 });
810
+
Emitter.emit e.emitter (Event.Document_start {
811
+
version = None;
812
+
implicit = not e.explicit_doc;
813
+
});
814
+
let t' = Jsont.Repr.of_t t in
815
+
encode e t' v;
816
+
Emitter.emit e.emitter (Event.Document_end { implicit = not e.explicit_doc });
817
+
Emitter.emit e.emitter Event.Stream_end;
818
+
if eod then Emitter.flush e.emitter;
819
+
Ok ()
820
+
with
821
+
| Jsont.Error err -> Error err
822
+
| Error.Yamlrw_error err ->
823
+
let msg = Error.to_string err in
824
+
Error (Jsont.Error.make_msg Jsont.Error.Context.empty Jsont.Meta.none msg)
825
+
826
+
let encode ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer =
827
+
Result.map_error Jsont.Error.to_string
828
+
(encode' ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer)
829
+
830
+
let encode_string' ?buf ?format ?indent ?explicit_doc ?scalar_style t v =
831
+
let b = Buffer.create 256 in
832
+
let writer = Bytes.Writer.of_buffer b in
833
+
match encode' ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod:true writer with
834
+
| Ok () -> Ok (Buffer.contents b)
835
+
| Error e -> Error e
836
+
837
+
let encode_string ?buf ?format ?indent ?explicit_doc ?scalar_style t v =
838
+
Result.map_error Jsont.Error.to_string
839
+
(encode_string' ?buf ?format ?indent ?explicit_doc ?scalar_style t v)
840
+
841
+
(* Recode *)
842
+
843
+
let recode ?layout ?locs ?file ?max_depth ?max_nodes
844
+
?buf ?format ?indent ?explicit_doc ?scalar_style t reader writer ~eod =
845
+
let format = match layout, format with
846
+
| Some true, None -> Some Layout
847
+
| _, f -> f
848
+
in
849
+
let layout = match layout, format with
850
+
| None, Some Layout -> Some true
851
+
| l, _ -> l
852
+
in
853
+
match decode' ?layout ?locs ?file ?max_depth ?max_nodes t reader with
854
+
| Ok v -> encode ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer
855
+
| Error e -> Error (Jsont.Error.to_string e)
856
+
857
+
let recode_string ?layout ?locs ?file ?max_depth ?max_nodes
858
+
?buf ?format ?indent ?explicit_doc ?scalar_style t s =
859
+
let format = match layout, format with
860
+
| Some true, None -> Some Layout
861
+
| _, f -> f
862
+
in
863
+
let layout = match layout, format with
864
+
| None, Some Layout -> Some true
865
+
| l, _ -> l
866
+
in
867
+
match decode_string' ?layout ?locs ?file ?max_depth ?max_nodes t s with
868
+
| Ok v -> encode_string ?buf ?format ?indent ?explicit_doc ?scalar_style t v
869
+
| Error e -> Error (Jsont.Error.to_string e)
+178
lib/yamlt.mli
+178
lib/yamlt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML codec using Jsont type descriptions.
7
+
8
+
This module provides YAML streaming encode/decode that interprets
9
+
{!Jsont.t} type descriptions, allowing the same codec definitions
10
+
to work for both JSON and YAML.
11
+
12
+
{b Example:}
13
+
{[
14
+
(* Define a codec once using Jsont *)
15
+
module Config = struct
16
+
type t = { name: string; port: int }
17
+
let make name port = { name; port }
18
+
let jsont =
19
+
Jsont.Object.map ~kind:"Config" make
20
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.name)
21
+
|> Jsont.Object.mem "port" Jsont.int ~enc:(fun c -> c.port)
22
+
|> Jsont.Object.finish
23
+
end
24
+
25
+
(* Use the same codec for both JSON and YAML *)
26
+
let from_json = Jsont_bytesrw.decode_string Config.jsont json_str
27
+
let from_yaml = Yamlt.decode_string Config.jsont yaml_str
28
+
]}
29
+
30
+
See notes about {{!yaml_mapping}YAML to JSON mapping} and
31
+
{{!yaml_scalars}YAML scalar resolution}.
32
+
*)
33
+
34
+
open Bytesrw
35
+
36
+
(** {1:decode Decode} *)
37
+
38
+
val decode :
39
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
40
+
?max_depth:int -> ?max_nodes:int ->
41
+
'a Jsont.t -> Bytes.Reader.t -> ('a, string) result
42
+
(** [decode t r] decodes a value from YAML reader [r] according to type [t].
43
+
{ul
44
+
{- If [layout] is [true], style information is preserved in {!Jsont.Meta.t}
45
+
values (for potential round-tripping). Defaults to [false].}
46
+
{- If [locs] is [true], source locations are preserved in {!Jsont.Meta.t}
47
+
values and error messages are precisely located. Defaults to [false].}
48
+
{- [file] is the file path for error messages.
49
+
Defaults to {!Jsont.Textloc.file_none}.}
50
+
{- [max_depth] limits nesting depth to prevent stack overflow
51
+
(billion laughs protection). Defaults to [100].}
52
+
{- [max_nodes] limits total decoded nodes
53
+
(billion laughs protection). Defaults to [10_000_000].}}
54
+
55
+
The YAML input must contain exactly one document. Multi-document
56
+
streams are not supported; use {!decode_all} for those. *)
57
+
58
+
val decode' :
59
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
60
+
?max_depth:int -> ?max_nodes:int ->
61
+
'a Jsont.t -> Bytes.Reader.t -> ('a, Jsont.Error.t) result
62
+
(** [decode'] is like {!val-decode} but preserves the error structure. *)
63
+
64
+
val decode_string :
65
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
66
+
?max_depth:int -> ?max_nodes:int ->
67
+
'a Jsont.t -> string -> ('a, string) result
68
+
(** [decode_string] is like {!val-decode} but decodes directly from a string. *)
69
+
70
+
val decode_string' :
71
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
72
+
?max_depth:int -> ?max_nodes:int ->
73
+
'a Jsont.t -> string -> ('a, Jsont.Error.t) result
74
+
(** [decode_string'] is like {!val-decode'} but decodes directly from a string. *)
75
+
76
+
(** {1:encode Encode} *)
77
+
78
+
(** YAML output format. *)
79
+
type yaml_format =
80
+
| Block (** Block style (indented) - default. Clean, readable YAML. *)
81
+
| Flow (** Flow style (JSON-like). Compact, single-line collections. *)
82
+
| Layout (** Preserve layout from {!Jsont.Meta.t} when available. *)
83
+
84
+
val encode :
85
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
86
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
87
+
'a Jsont.t -> 'a -> eod:bool -> Bytes.Writer.t -> (unit, string) result
88
+
(** [encode t v w] encodes value [v] according to type [t] to YAML on [w].
89
+
{ul
90
+
{- If [buf] is specified, it is used as a buffer for output slices.
91
+
Defaults to a buffer of length {!Bytesrw.Bytes.Writer.slice_length}[ w].}
92
+
{- [format] controls the output style. Defaults to {!Block}.}
93
+
{- [indent] is the indentation width in spaces. Defaults to [2].}
94
+
{- [explicit_doc] if [true], emits explicit document markers
95
+
([---] and [...]). Defaults to [false].}
96
+
{- [scalar_style] is the preferred style for string scalars.
97
+
Defaults to [`Any] (auto-detect based on content).}
98
+
{- [eod] indicates whether {!Bytesrw.Bytes.Slice.eod} should be
99
+
written on [w] after encoding.}} *)
100
+
101
+
val encode' :
102
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
103
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
104
+
'a Jsont.t -> 'a -> eod:bool -> Bytes.Writer.t -> (unit, Jsont.Error.t) result
105
+
(** [encode'] is like {!val-encode} but preserves the error structure. *)
106
+
107
+
val encode_string :
108
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
109
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
110
+
'a Jsont.t -> 'a -> (string, string) result
111
+
(** [encode_string] is like {!val-encode} but writes to a string. *)
112
+
113
+
val encode_string' :
114
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
115
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
116
+
'a Jsont.t -> 'a -> (string, Jsont.Error.t) result
117
+
(** [encode_string'] is like {!val-encode'} but writes to a string. *)
118
+
119
+
(** {1:recode Recode}
120
+
121
+
The defaults in these functions are those of {!val-decode} and
122
+
{!val-encode}, except if [layout] is [true], [format] defaults to
123
+
{!Layout} and vice-versa. *)
124
+
125
+
val recode :
126
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
127
+
?max_depth:int -> ?max_nodes:int ->
128
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
129
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
130
+
'a Jsont.t -> Bytes.Reader.t -> Bytes.Writer.t -> eod:bool ->
131
+
(unit, string) result
132
+
(** [recode t r w] is {!val-decode} followed by {!val-encode}. *)
133
+
134
+
val recode_string :
135
+
?layout:bool -> ?locs:bool -> ?file:Jsont.Textloc.fpath ->
136
+
?max_depth:int -> ?max_nodes:int ->
137
+
?buf:Stdlib.Bytes.t -> ?format:yaml_format -> ?indent:int ->
138
+
?explicit_doc:bool -> ?scalar_style:Yamlrw.Scalar_style.t ->
139
+
'a Jsont.t -> string -> (string, string) result
140
+
(** [recode_string] is like {!val-recode} but operates on strings. *)
141
+
142
+
(** {1:yaml_mapping YAML to JSON Mapping}
143
+
144
+
YAML is a superset of JSON. This module maps YAML structures to
145
+
the JSON data model that {!Jsont.t} describes:
146
+
147
+
{ul
148
+
{- YAML scalars map to JSON null, boolean, number, or string
149
+
depending on content and the expected type}
150
+
{- YAML sequences map to JSON arrays}
151
+
{- YAML mappings map to JSON objects (keys must be strings)}
152
+
{- YAML aliases are resolved during decoding}
153
+
{- YAML tags are used to guide type resolution when present}}
154
+
155
+
{b Limitations:}
156
+
{ul
157
+
{- Only string keys are supported in mappings (JSON object compatibility)}
158
+
{- Anchors and aliases are resolved; the alias structure is not preserved}
159
+
{- Multi-document streams require {!decode_all}}} *)
160
+
161
+
(** {1:yaml_scalars YAML Scalar Resolution}
162
+
163
+
YAML scalars are resolved to JSON types as follows:
164
+
165
+
{b Null:} [null], [Null], [NULL], [~], or empty string
166
+
167
+
{b Boolean:} [true], [True], [TRUE], [false], [False], [FALSE],
168
+
[yes], [Yes], [YES], [no], [No], [NO], [on], [On], [ON],
169
+
[off], [Off], [OFF]
170
+
171
+
{b Number:} Decimal integers, floats, hex ([0x...]), octal ([0o...]),
172
+
infinity ([.inf], [-.inf]), NaN ([.nan])
173
+
174
+
{b String:} Anything else, or explicitly quoted scalars
175
+
176
+
When decoding against a specific {!Jsont.t} type, the expected type
177
+
takes precedence over automatic resolution. For example, decoding
178
+
["yes"] against {!Jsont.string} yields the string ["yes"], not [true]. *)
+51
tests/bin/dune
+51
tests/bin/dune
···
1
+
(executable
2
+
(name test_scalars)
3
+
(public_name test_scalars)
4
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
5
+
6
+
(executable
7
+
(name test_objects)
8
+
(public_name test_objects)
9
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
10
+
11
+
(executable
12
+
(name test_arrays)
13
+
(public_name test_arrays)
14
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
15
+
16
+
(executable
17
+
(name test_formats)
18
+
(public_name test_formats)
19
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
20
+
21
+
(executable
22
+
(name test_roundtrip)
23
+
(public_name test_roundtrip)
24
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
25
+
26
+
(executable
27
+
(name test_complex)
28
+
(public_name test_complex)
29
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
30
+
31
+
(executable
32
+
(name test_edge)
33
+
(public_name test_edge)
34
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
35
+
(executable (name test_null_fix) (libraries yamlt jsont jsont.bytesrw bytesrw))
36
+
37
+
(executable
38
+
(name test_null_complete)
39
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
40
+
41
+
(executable
42
+
(name test_opt_array)
43
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
44
+
45
+
(executable
46
+
(name test_array_variants)
47
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
48
+
49
+
(executable
50
+
(name test_some_vs_option)
51
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
+27
tests/bin/test_array_variants.ml
+27
tests/bin/test_array_variants.ml
···
1
+
let () =
2
+
let codec1 =
3
+
Jsont.Object.map ~kind:"Test" (fun arr -> arr)
4
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.string) ~enc:(fun arr -> arr)
5
+
|> Jsont.Object.finish
6
+
in
7
+
8
+
let yaml1 = "values: [a, b, c]" in
9
+
10
+
Printf.printf "Test 1: Non-optional array:\n";
11
+
(match Yamlt.decode_string codec1 yaml1 with
12
+
| Ok arr -> Printf.printf "Result: [%d items]\n" (Array.length arr)
13
+
| Error e -> Printf.printf "Error: %s\n" e);
14
+
15
+
let codec2 =
16
+
Jsont.Object.map ~kind:"Test" (fun arr -> arr)
17
+
|> Jsont.Object.mem "values" (Jsont.option (Jsont.array Jsont.string)) ~enc:(fun arr -> arr)
18
+
|> Jsont.Object.finish
19
+
in
20
+
21
+
Printf.printf "\nTest 2: Jsont.option (Jsont.array):\n";
22
+
(match Yamlt.decode_string codec2 yaml1 with
23
+
| Ok arr ->
24
+
(match arr with
25
+
| None -> Printf.printf "Result: None\n"
26
+
| Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))
27
+
| Error e -> Printf.printf "Error: %s\n" e)
+330
tests/bin/test_arrays.ml
+330
tests/bin/test_arrays.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test array codec functionality with Yamlt *)
7
+
8
+
9
+
(* Helper to read file *)
10
+
let read_file path =
11
+
let ic = open_in path in
12
+
let len = in_channel_length ic in
13
+
let s = really_input_string ic len in
14
+
close_in ic;
15
+
s
16
+
17
+
(* Helper to show results *)
18
+
let show_result label = function
19
+
| Ok v -> Printf.printf "%s: %s\n" label v
20
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
21
+
22
+
let show_result_both label json_result yaml_result =
23
+
Printf.printf "JSON: ";
24
+
show_result label json_result;
25
+
Printf.printf "YAML: ";
26
+
show_result label yaml_result
27
+
28
+
(* Test: Simple int array *)
29
+
let test_int_array file =
30
+
let module M = struct
31
+
type numbers = { values: int array }
32
+
33
+
let numbers_codec =
34
+
Jsont.Object.map ~kind:"Numbers" (fun values -> { values })
35
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n -> n.values)
36
+
|> Jsont.Object.finish
37
+
38
+
let show n =
39
+
Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map string_of_int n.values)))
40
+
end in
41
+
42
+
let yaml = read_file file in
43
+
let json = read_file (file ^ ".json") in
44
+
let json_result = Jsont_bytesrw.decode_string M.numbers_codec json in
45
+
let yaml_result = Yamlt.decode_string M.numbers_codec yaml in
46
+
47
+
show_result_both "int_array"
48
+
(Result.map M.show json_result)
49
+
(Result.map M.show yaml_result)
50
+
51
+
(* Test: String array *)
52
+
let test_string_array file =
53
+
let module M = struct
54
+
type tags = { items: string array }
55
+
56
+
let tags_codec =
57
+
Jsont.Object.map ~kind:"Tags" (fun items -> { items })
58
+
|> Jsont.Object.mem "items" (Jsont.array Jsont.string) ~enc:(fun t -> t.items)
59
+
|> Jsont.Object.finish
60
+
61
+
let show t =
62
+
Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map (Printf.sprintf "%S") t.items)))
63
+
end in
64
+
65
+
let yaml = read_file file in
66
+
let json = read_file (file ^ ".json") in
67
+
let json_result = Jsont_bytesrw.decode_string M.tags_codec json in
68
+
let yaml_result = Yamlt.decode_string M.tags_codec yaml in
69
+
70
+
show_result_both "string_array"
71
+
(Result.map M.show json_result)
72
+
(Result.map M.show yaml_result)
73
+
74
+
(* Test: Float/number array *)
75
+
let test_float_array file =
76
+
let module M = struct
77
+
type measurements = { values: float array }
78
+
79
+
let measurements_codec =
80
+
Jsont.Object.map ~kind:"Measurements" (fun values -> { values })
81
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:(fun m -> m.values)
82
+
|> Jsont.Object.finish
83
+
84
+
let show m =
85
+
Printf.sprintf "[%s]"
86
+
(String.concat "; " (Array.to_list (Array.map (Printf.sprintf "%.2f") m.values)))
87
+
end in
88
+
89
+
let yaml = read_file file in
90
+
let json = read_file (file ^ ".json") in
91
+
let json_result = Jsont_bytesrw.decode_string M.measurements_codec json in
92
+
let yaml_result = Yamlt.decode_string M.measurements_codec yaml in
93
+
94
+
show_result_both "float_array"
95
+
(Result.map M.show json_result)
96
+
(Result.map M.show yaml_result)
97
+
98
+
(* Test: Empty array *)
99
+
let test_empty_array file =
100
+
let module M = struct
101
+
type empty = { items: int array }
102
+
103
+
let empty_codec =
104
+
Jsont.Object.map ~kind:"Empty" (fun items -> { items })
105
+
|> Jsont.Object.mem "items" (Jsont.array Jsont.int) ~enc:(fun e -> e.items)
106
+
|> Jsont.Object.finish
107
+
108
+
let show e =
109
+
Printf.sprintf "length=%d" (Stdlib.Array.length e.items)
110
+
end in
111
+
112
+
let yaml = read_file file in
113
+
let json = read_file (file ^ ".json") in
114
+
let json_result = Jsont_bytesrw.decode_string M.empty_codec json in
115
+
let yaml_result = Yamlt.decode_string M.empty_codec yaml in
116
+
117
+
show_result_both "empty_array"
118
+
(Result.map M.show json_result)
119
+
(Result.map M.show yaml_result)
120
+
121
+
(* Test: Array of objects *)
122
+
let test_object_array file =
123
+
let module M = struct
124
+
type person = { name: string; age: int }
125
+
type people = { persons: person array }
126
+
127
+
let person_codec =
128
+
Jsont.Object.map ~kind:"Person" (fun name age -> { name; age })
129
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
130
+
|> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)
131
+
|> Jsont.Object.finish
132
+
133
+
let people_codec =
134
+
Jsont.Object.map ~kind:"People" (fun persons -> { persons })
135
+
|> Jsont.Object.mem "persons" (Jsont.array person_codec) ~enc:(fun p -> p.persons)
136
+
|> Jsont.Object.finish
137
+
138
+
let show_person p = Printf.sprintf "{%s,%d}" p.name p.age
139
+
let show ps =
140
+
Printf.sprintf "[%s]"
141
+
(String.concat "; " (Array.to_list (Array.map show_person ps.persons)))
142
+
end in
143
+
144
+
let yaml = read_file file in
145
+
let json = read_file (file ^ ".json") in
146
+
let json_result = Jsont_bytesrw.decode_string M.people_codec json in
147
+
let yaml_result = Yamlt.decode_string M.people_codec yaml in
148
+
149
+
show_result_both "object_array"
150
+
(Result.map M.show json_result)
151
+
(Result.map M.show yaml_result)
152
+
153
+
(* Test: Nested arrays *)
154
+
let test_nested_arrays file =
155
+
let module M = struct
156
+
type matrix = { data: int array array }
157
+
158
+
let matrix_codec =
159
+
Jsont.Object.map ~kind:"Matrix" (fun data -> { data })
160
+
|> Jsont.Object.mem "data" (Jsont.array (Jsont.array Jsont.int))
161
+
~enc:(fun m -> m.data)
162
+
|> Jsont.Object.finish
163
+
164
+
let show_row row =
165
+
Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map string_of_int row)))
166
+
167
+
let show m =
168
+
Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map show_row m.data)))
169
+
end in
170
+
171
+
let yaml = read_file file in
172
+
let json = read_file (file ^ ".json") in
173
+
let json_result = Jsont_bytesrw.decode_string M.matrix_codec json in
174
+
let yaml_result = Yamlt.decode_string M.matrix_codec yaml in
175
+
176
+
show_result_both "nested_arrays"
177
+
(Result.map M.show json_result)
178
+
(Result.map M.show yaml_result)
179
+
180
+
(* Test: Mixed types in array (should fail with homogeneous codec) *)
181
+
let test_type_mismatch file =
182
+
let module M = struct
183
+
type numbers = { values: int array }
184
+
185
+
let numbers_codec =
186
+
Jsont.Object.map ~kind:"Numbers" (fun values -> { values })
187
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n -> n.values)
188
+
|> Jsont.Object.finish
189
+
end in
190
+
191
+
let yaml = read_file file in
192
+
let result = Yamlt.decode_string M.numbers_codec yaml in
193
+
match result with
194
+
| Ok _ -> Printf.printf "Unexpected success\n"
195
+
| Error e -> Printf.printf "Expected error: %s\n" e
196
+
197
+
(* Test: Bool array *)
198
+
let test_bool_array file =
199
+
let module M = struct
200
+
type flags = { values: bool array }
201
+
202
+
let flags_codec =
203
+
Jsont.Object.map ~kind:"Flags" (fun values -> { values })
204
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.bool) ~enc:(fun f -> f.values)
205
+
|> Jsont.Object.finish
206
+
207
+
let show f =
208
+
Printf.sprintf "[%s]"
209
+
(String.concat "; " (Array.to_list (Array.map string_of_bool f.values)))
210
+
end in
211
+
212
+
let yaml = read_file file in
213
+
let json = read_file (file ^ ".json") in
214
+
let json_result = Jsont_bytesrw.decode_string M.flags_codec json in
215
+
let yaml_result = Yamlt.decode_string M.flags_codec yaml in
216
+
217
+
show_result_both "bool_array"
218
+
(Result.map M.show json_result)
219
+
(Result.map M.show yaml_result)
220
+
221
+
(* Test: Array with nulls *)
222
+
let test_nullable_array file =
223
+
let module M = struct
224
+
type nullable = { values: string option array }
225
+
226
+
let nullable_codec =
227
+
Jsont.Object.map ~kind:"Nullable" (fun values -> { values })
228
+
|> Jsont.Object.mem "values" (Jsont.array (Jsont.some Jsont.string))
229
+
~enc:(fun n -> n.values)
230
+
|> Jsont.Object.finish
231
+
232
+
let show_opt = function
233
+
| None -> "null"
234
+
| Some s -> Printf.sprintf "%S" s
235
+
236
+
let show n =
237
+
Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map show_opt n.values)))
238
+
end in
239
+
240
+
let yaml = read_file file in
241
+
let json = read_file (file ^ ".json") in
242
+
let json_result = Jsont_bytesrw.decode_string M.nullable_codec json in
243
+
let yaml_result = Yamlt.decode_string M.nullable_codec yaml in
244
+
245
+
show_result_both "nullable_array"
246
+
(Result.map M.show json_result)
247
+
(Result.map M.show yaml_result)
248
+
249
+
(* Test: Encoding arrays to different formats *)
250
+
let test_encode_arrays () =
251
+
let module M = struct
252
+
type data = { numbers: int array; strings: string array }
253
+
254
+
let data_codec =
255
+
Jsont.Object.map ~kind:"Data" (fun numbers strings -> { numbers; strings })
256
+
|> Jsont.Object.mem "numbers" (Jsont.array Jsont.int) ~enc:(fun d -> d.numbers)
257
+
|> Jsont.Object.mem "strings" (Jsont.array Jsont.string) ~enc:(fun d -> d.strings)
258
+
|> Jsont.Object.finish
259
+
end in
260
+
261
+
let data = { M.numbers = [|1; 2; 3; 4; 5|]; strings = [|"hello"; "world"|] } in
262
+
263
+
(* Encode to JSON *)
264
+
(match Jsont_bytesrw.encode_string M.data_codec data with
265
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
266
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
267
+
268
+
(* Encode to YAML Block *)
269
+
(match Yamlt.encode_string ~format:Yamlt.Block M.data_codec data with
270
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
271
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
272
+
273
+
(* Encode to YAML Flow *)
274
+
(match Yamlt.encode_string ~format:Yamlt.Flow M.data_codec data with
275
+
| Ok s -> Printf.printf "YAML Flow: %s" s
276
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
277
+
278
+
let () =
279
+
let usage = "Usage: test_arrays <command> [args...]" in
280
+
281
+
if Array.length Sys.argv < 2 then begin
282
+
prerr_endline usage;
283
+
exit 1
284
+
end;
285
+
286
+
match Sys.argv.(1) with
287
+
| "int" when Array.length Sys.argv = 3 ->
288
+
test_int_array Sys.argv.(2)
289
+
290
+
| "string" when Array.length Sys.argv = 3 ->
291
+
test_string_array Sys.argv.(2)
292
+
293
+
| "float" when Array.length Sys.argv = 3 ->
294
+
test_float_array Sys.argv.(2)
295
+
296
+
| "empty" when Array.length Sys.argv = 3 ->
297
+
test_empty_array Sys.argv.(2)
298
+
299
+
| "objects" when Array.length Sys.argv = 3 ->
300
+
test_object_array Sys.argv.(2)
301
+
302
+
| "nested" when Array.length Sys.argv = 3 ->
303
+
test_nested_arrays Sys.argv.(2)
304
+
305
+
| "type-mismatch" when Array.length Sys.argv = 3 ->
306
+
test_type_mismatch Sys.argv.(2)
307
+
308
+
| "bool" when Array.length Sys.argv = 3 ->
309
+
test_bool_array Sys.argv.(2)
310
+
311
+
| "nullable" when Array.length Sys.argv = 3 ->
312
+
test_nullable_array Sys.argv.(2)
313
+
314
+
| "encode" when Array.length Sys.argv = 2 ->
315
+
test_encode_arrays ()
316
+
317
+
| _ ->
318
+
prerr_endline usage;
319
+
prerr_endline "Commands:";
320
+
prerr_endline " int <file> - Test int array";
321
+
prerr_endline " string <file> - Test string array";
322
+
prerr_endline " float <file> - Test float array";
323
+
prerr_endline " empty <file> - Test empty array";
324
+
prerr_endline " objects <file> - Test array of objects";
325
+
prerr_endline " nested <file> - Test nested arrays";
326
+
prerr_endline " type-mismatch <file> - Test type mismatch error";
327
+
prerr_endline " bool <file> - Test bool array";
328
+
prerr_endline " nullable <file> - Test array with nulls";
329
+
prerr_endline " encode - Test encoding arrays";
330
+
exit 1
+193
tests/bin/test_complex.ml
+193
tests/bin/test_complex.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test complex nested types with Yamlt *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok v -> Printf.printf "%s: %s\n" label v
19
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
20
+
21
+
let show_result_both label json_result yaml_result =
22
+
Printf.printf "JSON: ";
23
+
show_result label json_result;
24
+
Printf.printf "YAML: ";
25
+
show_result label yaml_result
26
+
27
+
(* Test: Deeply nested objects *)
28
+
let test_deep_nesting file =
29
+
let module M = struct
30
+
type level3 = { value: int }
31
+
type level2 = { data: level3 }
32
+
type level1 = { nested: level2 }
33
+
type root = { top: level1 }
34
+
35
+
let level3_codec =
36
+
Jsont.Object.map ~kind:"Level3" (fun value -> { value })
37
+
|> Jsont.Object.mem "value" Jsont.int ~enc:(fun l -> l.value)
38
+
|> Jsont.Object.finish
39
+
40
+
let level2_codec =
41
+
Jsont.Object.map ~kind:"Level2" (fun data -> { data })
42
+
|> Jsont.Object.mem "data" level3_codec ~enc:(fun l -> l.data)
43
+
|> Jsont.Object.finish
44
+
45
+
let level1_codec =
46
+
Jsont.Object.map ~kind:"Level1" (fun nested -> { nested })
47
+
|> Jsont.Object.mem "nested" level2_codec ~enc:(fun l -> l.nested)
48
+
|> Jsont.Object.finish
49
+
50
+
let root_codec =
51
+
Jsont.Object.map ~kind:"Root" (fun top -> { top })
52
+
|> Jsont.Object.mem "top" level1_codec ~enc:(fun r -> r.top)
53
+
|> Jsont.Object.finish
54
+
55
+
let show r = Printf.sprintf "depth=4, value=%d" r.top.nested.data.value
56
+
end in
57
+
58
+
let yaml = read_file file in
59
+
let json = read_file (file ^ ".json") in
60
+
let json_result = Jsont_bytesrw.decode_string M.root_codec json in
61
+
let yaml_result = Yamlt.decode_string M.root_codec yaml in
62
+
63
+
show_result_both "deep_nesting"
64
+
(Result.map M.show json_result)
65
+
(Result.map M.show yaml_result)
66
+
67
+
(* Test: Array of objects with nested arrays *)
68
+
let test_mixed_structure file =
69
+
let module M = struct
70
+
type item = { id: int; tags: string array }
71
+
type collection = { name: string; items: item array }
72
+
73
+
let item_codec =
74
+
Jsont.Object.map ~kind:"Item" (fun id tags -> { id; tags })
75
+
|> Jsont.Object.mem "id" Jsont.int ~enc:(fun i -> i.id)
76
+
|> Jsont.Object.mem "tags" (Jsont.array Jsont.string) ~enc:(fun i -> i.tags)
77
+
|> Jsont.Object.finish
78
+
79
+
let collection_codec =
80
+
Jsont.Object.map ~kind:"Collection" (fun name items -> { name; items })
81
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.name)
82
+
|> Jsont.Object.mem "items" (Jsont.array item_codec) ~enc:(fun c -> c.items)
83
+
|> Jsont.Object.finish
84
+
85
+
let show c =
86
+
let total_tags = Stdlib.Array.fold_left (fun acc item ->
87
+
acc + Stdlib.Array.length item.tags) 0 c.items in
88
+
Printf.sprintf "name=%S, items=%d, total_tags=%d"
89
+
c.name (Stdlib.Array.length c.items) total_tags
90
+
end in
91
+
92
+
let yaml = read_file file in
93
+
let json = read_file (file ^ ".json") in
94
+
let json_result = Jsont_bytesrw.decode_string M.collection_codec json in
95
+
let yaml_result = Yamlt.decode_string M.collection_codec yaml in
96
+
97
+
show_result_both "mixed_structure"
98
+
(Result.map M.show json_result)
99
+
(Result.map M.show yaml_result)
100
+
101
+
(* Test: Complex optional and nullable combinations *)
102
+
let test_complex_optional file =
103
+
let module M = struct
104
+
type config = {
105
+
host: string;
106
+
port: int option;
107
+
ssl: bool option;
108
+
cert_path: string option;
109
+
fallback_hosts: string array option;
110
+
}
111
+
112
+
let config_codec =
113
+
Jsont.Object.map ~kind:"Config"
114
+
(fun host port ssl cert_path fallback_hosts ->
115
+
{ host; port; ssl; cert_path; fallback_hosts })
116
+
|> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)
117
+
|> Jsont.Object.opt_mem "port" Jsont.int ~enc:(fun c -> c.port)
118
+
|> Jsont.Object.opt_mem "ssl" Jsont.bool ~enc:(fun c -> c.ssl)
119
+
|> Jsont.Object.opt_mem "cert_path" Jsont.string ~enc:(fun c -> c.cert_path)
120
+
|> Jsont.Object.opt_mem "fallback_hosts" (Jsont.array Jsont.string)
121
+
~enc:(fun c -> c.fallback_hosts)
122
+
|> Jsont.Object.finish
123
+
124
+
let show c =
125
+
let port_str = match c.port with None -> "None" | Some p -> string_of_int p in
126
+
let ssl_str = match c.ssl with None -> "None" | Some b -> string_of_bool b in
127
+
let fallbacks = match c.fallback_hosts with
128
+
| None -> 0
129
+
| Some arr -> Stdlib.Array.length arr in
130
+
Printf.sprintf "host=%S, port=%s, ssl=%s, fallbacks=%d"
131
+
c.host port_str ssl_str fallbacks
132
+
end in
133
+
134
+
let yaml = read_file file in
135
+
let json = read_file (file ^ ".json") in
136
+
let json_result = Jsont_bytesrw.decode_string M.config_codec json in
137
+
let yaml_result = Yamlt.decode_string M.config_codec yaml in
138
+
139
+
show_result_both "complex_optional"
140
+
(Result.map M.show json_result)
141
+
(Result.map M.show yaml_result)
142
+
143
+
(* Test: Heterogeneous data via any type *)
144
+
let test_heterogeneous file =
145
+
let module M = struct
146
+
type data = { mixed: Jsont.json array }
147
+
148
+
let data_codec =
149
+
Jsont.Object.map ~kind:"Data" (fun mixed -> { mixed })
150
+
|> Jsont.Object.mem "mixed" (Jsont.array (Jsont.any ())) ~enc:(fun d -> d.mixed)
151
+
|> Jsont.Object.finish
152
+
153
+
let show d = Printf.sprintf "items=%d" (Stdlib.Array.length d.mixed)
154
+
end in
155
+
156
+
let yaml = read_file file in
157
+
let json = read_file (file ^ ".json") in
158
+
let json_result = Jsont_bytesrw.decode_string M.data_codec json in
159
+
let yaml_result = Yamlt.decode_string M.data_codec yaml in
160
+
161
+
show_result_both "heterogeneous"
162
+
(Result.map M.show json_result)
163
+
(Result.map M.show yaml_result)
164
+
165
+
let () =
166
+
let usage = "Usage: test_complex <command> [args...]" in
167
+
168
+
if Stdlib.Array.length Sys.argv < 2 then begin
169
+
prerr_endline usage;
170
+
exit 1
171
+
end;
172
+
173
+
match Sys.argv.(1) with
174
+
| "deep-nesting" when Stdlib.Array.length Sys.argv = 3 ->
175
+
test_deep_nesting Sys.argv.(2)
176
+
177
+
| "mixed-structure" when Stdlib.Array.length Sys.argv = 3 ->
178
+
test_mixed_structure Sys.argv.(2)
179
+
180
+
| "complex-optional" when Stdlib.Array.length Sys.argv = 3 ->
181
+
test_complex_optional Sys.argv.(2)
182
+
183
+
| "heterogeneous" when Stdlib.Array.length Sys.argv = 3 ->
184
+
test_heterogeneous Sys.argv.(2)
185
+
186
+
| _ ->
187
+
prerr_endline usage;
188
+
prerr_endline "Commands:";
189
+
prerr_endline " deep-nesting <file> - Test deeply nested objects";
190
+
prerr_endline " mixed-structure <file> - Test arrays of objects with nested arrays";
191
+
prerr_endline " complex-optional <file> - Test complex optional/nullable combinations";
192
+
prerr_endline " heterogeneous <file> - Test heterogeneous data via any type";
193
+
exit 1
+212
tests/bin/test_edge.ml
+212
tests/bin/test_edge.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test edge cases with Yamlt *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok v -> Printf.printf "%s: %s\n" label v
19
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
20
+
21
+
let show_result_both label json_result yaml_result =
22
+
Printf.printf "JSON: ";
23
+
show_result label json_result;
24
+
Printf.printf "YAML: ";
25
+
show_result label yaml_result
26
+
27
+
(* Test: Very large numbers *)
28
+
let test_large_numbers file =
29
+
let module M = struct
30
+
type numbers = { large_int: float; large_float: float; small_float: float }
31
+
32
+
let numbers_codec =
33
+
Jsont.Object.map ~kind:"Numbers" (fun large_int large_float small_float ->
34
+
{ large_int; large_float; small_float })
35
+
|> Jsont.Object.mem "large_int" Jsont.number ~enc:(fun n -> n.large_int)
36
+
|> Jsont.Object.mem "large_float" Jsont.number ~enc:(fun n -> n.large_float)
37
+
|> Jsont.Object.mem "small_float" Jsont.number ~enc:(fun n -> n.small_float)
38
+
|> Jsont.Object.finish
39
+
40
+
let show n =
41
+
Printf.sprintf "large_int=%.0f, large_float=%e, small_float=%e"
42
+
n.large_int n.large_float n.small_float
43
+
end in
44
+
45
+
let yaml = read_file file in
46
+
let json = read_file (file ^ ".json") in
47
+
let json_result = Jsont_bytesrw.decode_string M.numbers_codec json in
48
+
let yaml_result = Yamlt.decode_string M.numbers_codec yaml in
49
+
50
+
show_result_both "large_numbers"
51
+
(Result.map M.show json_result)
52
+
(Result.map M.show yaml_result)
53
+
54
+
(* Test: Special characters in strings *)
55
+
let test_special_chars file =
56
+
let module M = struct
57
+
type text = { content: string }
58
+
59
+
let text_codec =
60
+
Jsont.Object.map ~kind:"Text" (fun content -> { content })
61
+
|> Jsont.Object.mem "content" Jsont.string ~enc:(fun t -> t.content)
62
+
|> Jsont.Object.finish
63
+
64
+
let show t =
65
+
Printf.sprintf "length=%d, contains_newline=%b, contains_tab=%b"
66
+
(String.length t.content)
67
+
(String.contains t.content '\n')
68
+
(String.contains t.content '\t')
69
+
end in
70
+
71
+
let yaml = read_file file in
72
+
let json = read_file (file ^ ".json") in
73
+
let json_result = Jsont_bytesrw.decode_string M.text_codec json in
74
+
let yaml_result = Yamlt.decode_string M.text_codec yaml in
75
+
76
+
show_result_both "special_chars"
77
+
(Result.map M.show json_result)
78
+
(Result.map M.show yaml_result)
79
+
80
+
(* Test: Unicode strings *)
81
+
let test_unicode file =
82
+
let module M = struct
83
+
type text = { emoji: string; chinese: string; rtl: string }
84
+
85
+
let text_codec =
86
+
Jsont.Object.map ~kind:"Text" (fun emoji chinese rtl -> { emoji; chinese; rtl })
87
+
|> Jsont.Object.mem "emoji" Jsont.string ~enc:(fun t -> t.emoji)
88
+
|> Jsont.Object.mem "chinese" Jsont.string ~enc:(fun t -> t.chinese)
89
+
|> Jsont.Object.mem "rtl" Jsont.string ~enc:(fun t -> t.rtl)
90
+
|> Jsont.Object.finish
91
+
92
+
let show t =
93
+
Printf.sprintf "emoji=%S, chinese=%S, rtl=%S" t.emoji t.chinese t.rtl
94
+
end in
95
+
96
+
let yaml = read_file file in
97
+
let json = read_file (file ^ ".json") in
98
+
let json_result = Jsont_bytesrw.decode_string M.text_codec json in
99
+
let yaml_result = Yamlt.decode_string M.text_codec yaml in
100
+
101
+
show_result_both "unicode"
102
+
(Result.map M.show json_result)
103
+
(Result.map M.show yaml_result)
104
+
105
+
(* Test: Empty collections *)
106
+
let test_empty_collections file =
107
+
let module M = struct
108
+
type data = { empty_array: int array; empty_object_array: unit array }
109
+
110
+
let data_codec =
111
+
Jsont.Object.map ~kind:"Data" (fun empty_array empty_object_array ->
112
+
{ empty_array; empty_object_array })
113
+
|> Jsont.Object.mem "empty_array" (Jsont.array Jsont.int) ~enc:(fun d -> d.empty_array)
114
+
|> Jsont.Object.mem "empty_object_array" (Jsont.array (Jsont.null ())) ~enc:(fun d -> d.empty_object_array)
115
+
|> Jsont.Object.finish
116
+
117
+
let show d =
118
+
Printf.sprintf "empty_array_len=%d, empty_object_array_len=%d"
119
+
(Stdlib.Array.length d.empty_array)
120
+
(Stdlib.Array.length d.empty_object_array)
121
+
end in
122
+
123
+
let yaml = read_file file in
124
+
let json = read_file (file ^ ".json") in
125
+
let json_result = Jsont_bytesrw.decode_string M.data_codec json in
126
+
let yaml_result = Yamlt.decode_string M.data_codec yaml in
127
+
128
+
show_result_both "empty_collections"
129
+
(Result.map M.show json_result)
130
+
(Result.map M.show yaml_result)
131
+
132
+
(* Test: Key names with special characters *)
133
+
let test_special_keys file =
134
+
let module M = struct
135
+
let show j =
136
+
match Jsont.Json.decode (Jsont.any ()) j with
137
+
| Ok (Jsont.Object _) -> "valid_object"
138
+
| Ok _ -> "not_object"
139
+
| Error _ -> "decode_error"
140
+
end in
141
+
142
+
let yaml = read_file file in
143
+
let json = read_file (file ^ ".json") in
144
+
let json_result = Jsont_bytesrw.decode_string (Jsont.any ()) json in
145
+
let yaml_result = Yamlt.decode_string (Jsont.any ()) yaml in
146
+
147
+
show_result_both "special_keys"
148
+
(Result.map M.show json_result)
149
+
(Result.map M.show yaml_result)
150
+
151
+
(* Test: Single-element arrays *)
152
+
let test_single_element file =
153
+
let module M = struct
154
+
type data = { single: int array }
155
+
156
+
let data_codec =
157
+
Jsont.Object.map ~kind:"Data" (fun single -> { single })
158
+
|> Jsont.Object.mem "single" (Jsont.array Jsont.int) ~enc:(fun d -> d.single)
159
+
|> Jsont.Object.finish
160
+
161
+
let show d =
162
+
Printf.sprintf "length=%d, value=%d"
163
+
(Stdlib.Array.length d.single)
164
+
(if Stdlib.Array.length d.single > 0 then d.single.(0) else 0)
165
+
end in
166
+
167
+
let yaml = read_file file in
168
+
let json = read_file (file ^ ".json") in
169
+
let json_result = Jsont_bytesrw.decode_string M.data_codec json in
170
+
let yaml_result = Yamlt.decode_string M.data_codec yaml in
171
+
172
+
show_result_both "single_element"
173
+
(Result.map M.show json_result)
174
+
(Result.map M.show yaml_result)
175
+
176
+
let () =
177
+
let usage = "Usage: test_edge <command> [args...]" in
178
+
179
+
if Stdlib.Array.length Sys.argv < 2 then begin
180
+
prerr_endline usage;
181
+
exit 1
182
+
end;
183
+
184
+
match Sys.argv.(1) with
185
+
| "large-numbers" when Stdlib.Array.length Sys.argv = 3 ->
186
+
test_large_numbers Sys.argv.(2)
187
+
188
+
| "special-chars" when Stdlib.Array.length Sys.argv = 3 ->
189
+
test_special_chars Sys.argv.(2)
190
+
191
+
| "unicode" when Stdlib.Array.length Sys.argv = 3 ->
192
+
test_unicode Sys.argv.(2)
193
+
194
+
| "empty-collections" when Stdlib.Array.length Sys.argv = 3 ->
195
+
test_empty_collections Sys.argv.(2)
196
+
197
+
| "special-keys" when Stdlib.Array.length Sys.argv = 3 ->
198
+
test_special_keys Sys.argv.(2)
199
+
200
+
| "single-element" when Stdlib.Array.length Sys.argv = 3 ->
201
+
test_single_element Sys.argv.(2)
202
+
203
+
| _ ->
204
+
prerr_endline usage;
205
+
prerr_endline "Commands:";
206
+
prerr_endline " large-numbers <file> - Test very large numbers";
207
+
prerr_endline " special-chars <file> - Test special characters in strings";
208
+
prerr_endline " unicode <file> - Test Unicode strings";
209
+
prerr_endline " empty-collections <file> - Test empty collections";
210
+
prerr_endline " special-keys <file> - Test special characters in keys";
211
+
prerr_endline " single-element <file> - Test single-element arrays";
212
+
exit 1
+254
tests/bin/test_formats.ml
+254
tests/bin/test_formats.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test format-specific features with Yamlt *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok v -> Printf.printf "%s: %s\n" label v
19
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
20
+
21
+
let show_result_both label json_result yaml_result =
22
+
Printf.printf "JSON: ";
23
+
show_result label json_result;
24
+
Printf.printf "YAML: ";
25
+
show_result label yaml_result
26
+
27
+
(* Test: Multi-line strings - literal style *)
28
+
let test_literal_string file =
29
+
let module M = struct
30
+
type text = { content: string }
31
+
32
+
let text_codec =
33
+
Jsont.Object.map ~kind:"Text" (fun content -> { content })
34
+
|> Jsont.Object.mem "content" Jsont.string ~enc:(fun t -> t.content)
35
+
|> Jsont.Object.finish
36
+
37
+
let show t =
38
+
Printf.sprintf "lines=%d, length=%d"
39
+
(List.length (String.split_on_char '\n' t.content))
40
+
(String.length t.content)
41
+
end in
42
+
43
+
let yaml = read_file file in
44
+
let json = read_file (file ^ ".json") in
45
+
let json_result = Jsont_bytesrw.decode_string M.text_codec json in
46
+
let yaml_result = Yamlt.decode_string M.text_codec yaml in
47
+
48
+
show_result_both "literal_string"
49
+
(Result.map M.show json_result)
50
+
(Result.map M.show yaml_result)
51
+
52
+
(* Test: Multi-line strings - folded style *)
53
+
let test_folded_string file =
54
+
let module M = struct
55
+
type text = { content: string }
56
+
57
+
let text_codec =
58
+
Jsont.Object.map ~kind:"Text" (fun content -> { content })
59
+
|> Jsont.Object.mem "content" Jsont.string ~enc:(fun t -> t.content)
60
+
|> Jsont.Object.finish
61
+
62
+
let show t =
63
+
Printf.sprintf "length=%d, newlines=%d"
64
+
(String.length t.content)
65
+
(List.length (List.filter (fun c -> c = '\n')
66
+
(List.init (String.length t.content) (String.get t.content))))
67
+
end in
68
+
69
+
let yaml = read_file file in
70
+
let json = read_file (file ^ ".json") in
71
+
let json_result = Jsont_bytesrw.decode_string M.text_codec json in
72
+
let yaml_result = Yamlt.decode_string M.text_codec yaml in
73
+
74
+
show_result_both "folded_string"
75
+
(Result.map M.show json_result)
76
+
(Result.map M.show yaml_result)
77
+
78
+
(* Test: Number formats - hex, octal, binary *)
79
+
let test_number_formats file =
80
+
let module M = struct
81
+
type numbers = { hex: float; octal: float; binary: float }
82
+
83
+
let numbers_codec =
84
+
Jsont.Object.map ~kind:"Numbers" (fun hex octal binary -> { hex; octal; binary })
85
+
|> Jsont.Object.mem "hex" Jsont.number ~enc:(fun n -> n.hex)
86
+
|> Jsont.Object.mem "octal" Jsont.number ~enc:(fun n -> n.octal)
87
+
|> Jsont.Object.mem "binary" Jsont.number ~enc:(fun n -> n.binary)
88
+
|> Jsont.Object.finish
89
+
90
+
let show n =
91
+
Printf.sprintf "hex=%.0f, octal=%.0f, binary=%.0f" n.hex n.octal n.binary
92
+
end in
93
+
94
+
let yaml = read_file file in
95
+
let json = read_file (file ^ ".json") in
96
+
let json_result = Jsont_bytesrw.decode_string M.numbers_codec json in
97
+
let yaml_result = Yamlt.decode_string M.numbers_codec yaml in
98
+
99
+
show_result_both "number_formats"
100
+
(Result.map M.show json_result)
101
+
(Result.map M.show yaml_result)
102
+
103
+
(* Test: Block vs Flow style encoding *)
104
+
let test_encode_styles () =
105
+
let module M = struct
106
+
type data = {
107
+
name: string;
108
+
values: int array;
109
+
nested: nested_data;
110
+
}
111
+
and nested_data = {
112
+
enabled: bool;
113
+
count: int;
114
+
}
115
+
116
+
let nested_codec =
117
+
Jsont.Object.map ~kind:"Nested" (fun enabled count -> { enabled; count })
118
+
|> Jsont.Object.mem "enabled" Jsont.bool ~enc:(fun n -> n.enabled)
119
+
|> Jsont.Object.mem "count" Jsont.int ~enc:(fun n -> n.count)
120
+
|> Jsont.Object.finish
121
+
122
+
let data_codec =
123
+
Jsont.Object.map ~kind:"Data" (fun name values nested -> { name; values; nested })
124
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun d -> d.name)
125
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun d -> d.values)
126
+
|> Jsont.Object.mem "nested" nested_codec ~enc:(fun d -> d.nested)
127
+
|> Jsont.Object.finish
128
+
end in
129
+
130
+
let data = {
131
+
M.name = "test";
132
+
values = [|1; 2; 3|];
133
+
nested = { enabled = true; count = 5 };
134
+
} in
135
+
136
+
(* Encode to YAML Block style *)
137
+
(match Yamlt.encode_string ~format:Yamlt.Block M.data_codec data with
138
+
| Ok s -> Printf.printf "YAML Block:\n%s\n" s
139
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
140
+
141
+
(* Encode to YAML Flow style *)
142
+
(match Yamlt.encode_string ~format:Yamlt.Flow M.data_codec data with
143
+
| Ok s -> Printf.printf "YAML Flow:\n%s\n" s
144
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
145
+
146
+
(* Test: Comments in YAML (should be ignored) *)
147
+
let test_comments file =
148
+
let module M = struct
149
+
type config = { host: string; port: int; debug: bool }
150
+
151
+
let config_codec =
152
+
Jsont.Object.map ~kind:"Config" (fun host port debug -> { host; port; debug })
153
+
|> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)
154
+
|> Jsont.Object.mem "port" Jsont.int ~enc:(fun c -> c.port)
155
+
|> Jsont.Object.mem "debug" Jsont.bool ~enc:(fun c -> c.debug)
156
+
|> Jsont.Object.finish
157
+
158
+
let show c =
159
+
Printf.sprintf "host=%S, port=%d, debug=%b" c.host c.port c.debug
160
+
end in
161
+
162
+
let yaml = read_file file in
163
+
let yaml_result = Yamlt.decode_string M.config_codec yaml in
164
+
165
+
match yaml_result with
166
+
| Ok v -> Printf.printf "YAML (with comments): %s\n" (M.show v)
167
+
| Error e -> Printf.printf "YAML ERROR: %s\n" e
168
+
169
+
(* Test: Empty documents and null documents *)
170
+
let test_empty_document file =
171
+
let module M = struct
172
+
type wrapper = { value: string option }
173
+
174
+
let wrapper_codec =
175
+
Jsont.Object.map ~kind:"Wrapper" (fun value -> { value })
176
+
|> Jsont.Object.mem "value" (Jsont.some Jsont.string) ~enc:(fun w -> w.value)
177
+
|> Jsont.Object.finish
178
+
179
+
let show w =
180
+
match w.value with
181
+
| None -> "value=None"
182
+
| Some s -> Printf.sprintf "value=Some(%S)" s
183
+
end in
184
+
185
+
let yaml = read_file file in
186
+
let json = read_file (file ^ ".json") in
187
+
let json_result = Jsont_bytesrw.decode_string M.wrapper_codec json in
188
+
let yaml_result = Yamlt.decode_string M.wrapper_codec yaml in
189
+
190
+
show_result_both "empty_document"
191
+
(Result.map M.show json_result)
192
+
(Result.map M.show yaml_result)
193
+
194
+
(* Test: Explicit typing with tags (if supported) *)
195
+
let test_explicit_tags file =
196
+
let module M = struct
197
+
type value_holder = { data: string }
198
+
199
+
let value_codec =
200
+
Jsont.Object.map ~kind:"ValueHolder" (fun data -> { data })
201
+
|> Jsont.Object.mem "data" Jsont.string ~enc:(fun v -> v.data)
202
+
|> Jsont.Object.finish
203
+
204
+
let show v = Printf.sprintf "data=%S" v.data
205
+
end in
206
+
207
+
let yaml = read_file file in
208
+
let yaml_result = Yamlt.decode_string M.value_codec yaml in
209
+
210
+
match yaml_result with
211
+
| Ok v -> Printf.printf "YAML (with tags): %s\n" (M.show v)
212
+
| Error e -> Printf.printf "YAML ERROR: %s\n" e
213
+
214
+
let () =
215
+
let usage = "Usage: test_formats <command> [args...]" in
216
+
217
+
if Stdlib.Array.length Sys.argv < 2 then begin
218
+
prerr_endline usage;
219
+
exit 1
220
+
end;
221
+
222
+
match Sys.argv.(1) with
223
+
| "literal" when Stdlib.Array.length Sys.argv = 3 ->
224
+
test_literal_string Sys.argv.(2)
225
+
226
+
| "folded" when Stdlib.Array.length Sys.argv = 3 ->
227
+
test_folded_string Sys.argv.(2)
228
+
229
+
| "number-formats" when Stdlib.Array.length Sys.argv = 3 ->
230
+
test_number_formats Sys.argv.(2)
231
+
232
+
| "encode-styles" when Stdlib.Array.length Sys.argv = 2 ->
233
+
test_encode_styles ()
234
+
235
+
| "comments" when Stdlib.Array.length Sys.argv = 3 ->
236
+
test_comments Sys.argv.(2)
237
+
238
+
| "empty-doc" when Stdlib.Array.length Sys.argv = 3 ->
239
+
test_empty_document Sys.argv.(2)
240
+
241
+
| "explicit-tags" when Stdlib.Array.length Sys.argv = 3 ->
242
+
test_explicit_tags Sys.argv.(2)
243
+
244
+
| _ ->
245
+
prerr_endline usage;
246
+
prerr_endline "Commands:";
247
+
prerr_endline " literal <file> - Test literal multi-line strings";
248
+
prerr_endline " folded <file> - Test folded multi-line strings";
249
+
prerr_endline " number-formats <file> - Test hex/octal/binary number formats";
250
+
prerr_endline " encode-styles - Test block vs flow encoding";
251
+
prerr_endline " comments <file> - Test YAML with comments";
252
+
prerr_endline " empty-doc <file> - Test empty documents";
253
+
prerr_endline " explicit-tags <file> - Test explicit type tags";
254
+
exit 1
+33
tests/bin/test_null_complete.ml
+33
tests/bin/test_null_complete.ml
···
1
+
let () =
2
+
Printf.printf "=== Test 1: Jsont.option with YAML null ===\n";
3
+
let yaml1 = "value: null" in
4
+
let codec1 =
5
+
let open Jsont in
6
+
Object.map ~kind:"Test" (fun v -> v)
7
+
|> Object.mem "value" (option string) ~enc:(fun v -> v)
8
+
|> Object.finish
9
+
in
10
+
(match Yamlt.decode_string codec1 yaml1 with
11
+
| Ok v -> Printf.printf "Result: %s\n" (match v with None -> "None" | Some s -> "Some(" ^ s ^ ")")
12
+
| Error e -> Printf.printf "Error: %s\n" e);
13
+
14
+
Printf.printf "\n=== Test 2: Jsont.option with YAML string ===\n";
15
+
(match Yamlt.decode_string codec1 "value: hello" with
16
+
| Ok v -> Printf.printf "Result: %s\n" (match v with None -> "None" | Some s -> "Some(" ^ s ^ ")")
17
+
| Error e -> Printf.printf "Error: %s\n" e);
18
+
19
+
Printf.printf "\n=== Test 3: Jsont.string with YAML null (should error) ===\n";
20
+
let codec2 =
21
+
let open Jsont in
22
+
Object.map ~kind:"Test" (fun v -> v)
23
+
|> Object.mem "value" string ~enc:(fun v -> v)
24
+
|> Object.finish
25
+
in
26
+
(match Yamlt.decode_string codec2 "value: null" with
27
+
| Ok v -> Printf.printf "Result: %s\n" v
28
+
| Error e -> Printf.printf "Error (expected): %s\n" e);
29
+
30
+
Printf.printf "\n=== Test 4: Jsont.string with YAML string ===\n";
31
+
(match Yamlt.decode_string codec2 "value: hello" with
32
+
| Ok v -> Printf.printf "Result: %s\n" v
33
+
| Error e -> Printf.printf "Error: %s\n" e)
+30
tests/bin/test_null_fix.ml
+30
tests/bin/test_null_fix.ml
···
1
+
open Jsont
2
+
3
+
let () =
4
+
let module M = struct
5
+
type data = { value: string option }
6
+
7
+
let data_codec =
8
+
Jsont.Object.map ~kind:"Data" (fun value -> { value })
9
+
|> Jsont.Object.mem "value" (Jsont.option Jsont.string) ~enc:(fun d -> d.value)
10
+
|> Jsont.Object.finish
11
+
end in
12
+
13
+
let yaml_null = "value: null" in
14
+
15
+
Printf.printf "Testing YAML null handling with Jsont.option Jsont.string:\n\n";
16
+
17
+
match Yamlt.decode_string M.data_codec yaml_null with
18
+
| Ok data ->
19
+
(match data.M.value with
20
+
| None -> Printf.printf "YAML: value=None (CORRECT)\n"
21
+
| Some s -> Printf.printf "YAML: value=Some(%S) (BUG!)\n" s)
22
+
| Error e -> Printf.printf "YAML ERROR: %s\n" e;
23
+
24
+
let json_null = "{\"value\": null}" in
25
+
match Jsont_bytesrw.decode_string M.data_codec json_null with
26
+
| Ok data ->
27
+
(match data.M.value with
28
+
| None -> Printf.printf "JSON: value=None (CORRECT)\n"
29
+
| Some s -> Printf.printf "JSON: value=Some(%S) (BUG!)\n" s)
30
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e
+302
tests/bin/test_objects.ml
+302
tests/bin/test_objects.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test object codec functionality with Yamlt *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok v -> Printf.printf "%s: %s\n" label v
19
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
20
+
21
+
let show_result_both label json_result yaml_result =
22
+
Printf.printf "JSON: ";
23
+
show_result label json_result;
24
+
Printf.printf "YAML: ";
25
+
show_result label yaml_result
26
+
27
+
(* Test: Simple object with required fields *)
28
+
let test_simple_object file =
29
+
let module M = struct
30
+
type person = { name: string; age: int }
31
+
32
+
let person_codec =
33
+
Jsont.Object.map ~kind:"Person" (fun name age -> { name; age })
34
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
35
+
|> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)
36
+
|> Jsont.Object.finish
37
+
38
+
let show p = Printf.sprintf "{name=%S; age=%d}" p.name p.age
39
+
end in
40
+
41
+
let yaml = read_file file in
42
+
let json = read_file (file ^ ".json") in
43
+
let json_result = Jsont_bytesrw.decode_string M.person_codec json in
44
+
let yaml_result = Yamlt.decode_string M.person_codec yaml in
45
+
46
+
show_result_both "person"
47
+
(Result.map M.show json_result)
48
+
(Result.map M.show yaml_result)
49
+
50
+
(* Test: Object with optional fields *)
51
+
let test_optional_fields file =
52
+
let module M = struct
53
+
type config = { host: string; port: int option; debug: bool option }
54
+
55
+
let config_codec =
56
+
Jsont.Object.map ~kind:"Config"
57
+
(fun host port debug -> { host; port; debug })
58
+
|> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)
59
+
|> Jsont.Object.opt_mem "port" Jsont.int ~enc:(fun c -> c.port)
60
+
|> Jsont.Object.opt_mem "debug" Jsont.bool ~enc:(fun c -> c.debug)
61
+
|> Jsont.Object.finish
62
+
63
+
let show c =
64
+
Printf.sprintf "{host=%S; port=%s; debug=%s}"
65
+
c.host
66
+
(match c.port with None -> "None" | Some p -> Printf.sprintf "Some %d" p)
67
+
(match c.debug with None -> "None" | Some b -> Printf.sprintf "Some %b" b)
68
+
end in
69
+
70
+
let yaml = read_file file in
71
+
let json = read_file (file ^ ".json") in
72
+
let json_result = Jsont_bytesrw.decode_string M.config_codec json in
73
+
let yaml_result = Yamlt.decode_string M.config_codec yaml in
74
+
75
+
show_result_both "config"
76
+
(Result.map M.show json_result)
77
+
(Result.map M.show yaml_result)
78
+
79
+
(* Test: Object with default values *)
80
+
let test_default_values file =
81
+
let module M = struct
82
+
type settings = { timeout: int; retries: int; verbose: bool }
83
+
84
+
let settings_codec =
85
+
Jsont.Object.map ~kind:"Settings"
86
+
(fun timeout retries verbose -> { timeout; retries; verbose })
87
+
|> Jsont.Object.mem "timeout" Jsont.int ~enc:(fun s -> s.timeout) ~dec_absent:30
88
+
|> Jsont.Object.mem "retries" Jsont.int ~enc:(fun s -> s.retries) ~dec_absent:3
89
+
|> Jsont.Object.mem "verbose" Jsont.bool ~enc:(fun s -> s.verbose) ~dec_absent:false
90
+
|> Jsont.Object.finish
91
+
92
+
let show s =
93
+
Printf.sprintf "{timeout=%d; retries=%d; verbose=%b}"
94
+
s.timeout s.retries s.verbose
95
+
end in
96
+
97
+
let yaml = read_file file in
98
+
let json = read_file (file ^ ".json") in
99
+
let json_result = Jsont_bytesrw.decode_string M.settings_codec json in
100
+
let yaml_result = Yamlt.decode_string M.settings_codec yaml in
101
+
102
+
show_result_both "settings"
103
+
(Result.map M.show json_result)
104
+
(Result.map M.show yaml_result)
105
+
106
+
(* Test: Nested objects *)
107
+
let test_nested_objects file =
108
+
let module M = struct
109
+
type address = { street: string; city: string; zip: string }
110
+
type employee = { name: string; address: address }
111
+
112
+
let address_codec =
113
+
Jsont.Object.map ~kind:"Address"
114
+
(fun street city zip -> { street; city; zip })
115
+
|> Jsont.Object.mem "street" Jsont.string ~enc:(fun a -> a.street)
116
+
|> Jsont.Object.mem "city" Jsont.string ~enc:(fun a -> a.city)
117
+
|> Jsont.Object.mem "zip" Jsont.string ~enc:(fun a -> a.zip)
118
+
|> Jsont.Object.finish
119
+
120
+
let employee_codec =
121
+
Jsont.Object.map ~kind:"Employee"
122
+
(fun name address -> { name; address })
123
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun e -> e.name)
124
+
|> Jsont.Object.mem "address" address_codec ~enc:(fun e -> e.address)
125
+
|> Jsont.Object.finish
126
+
127
+
let show e =
128
+
Printf.sprintf "{name=%S; address={street=%S; city=%S; zip=%S}}"
129
+
e.name e.address.street e.address.city e.address.zip
130
+
end in
131
+
132
+
let yaml = read_file file in
133
+
let json = read_file (file ^ ".json") in
134
+
let json_result = Jsont_bytesrw.decode_string M.employee_codec json in
135
+
let yaml_result = Yamlt.decode_string M.employee_codec yaml in
136
+
137
+
show_result_both "employee"
138
+
(Result.map M.show json_result)
139
+
(Result.map M.show yaml_result)
140
+
141
+
(* Test: Unknown member handling - error *)
142
+
let test_unknown_members_error file =
143
+
let module M = struct
144
+
type strict = { name: string }
145
+
146
+
let strict_codec =
147
+
Jsont.Object.map ~kind:"Strict" (fun name -> { name })
148
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun s -> s.name)
149
+
|> Jsont.Object.finish
150
+
end in
151
+
152
+
let yaml = read_file file in
153
+
let result = Yamlt.decode_string M.strict_codec yaml in
154
+
match result with
155
+
| Ok _ -> Printf.printf "Unexpected success\n"
156
+
| Error e -> Printf.printf "Expected error: %s\n" e
157
+
158
+
(* Test: Unknown member handling - keep *)
159
+
let test_unknown_members_keep file =
160
+
let module M = struct
161
+
type flexible = { name: string; extra: Jsont.json }
162
+
163
+
let flexible_codec =
164
+
Jsont.Object.map ~kind:"Flexible" (fun name extra -> { name; extra })
165
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun f -> f.name)
166
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun f -> f.extra)
167
+
|> Jsont.Object.finish
168
+
169
+
let show f =
170
+
Printf.sprintf "{name=%S; has_extra=true}" f.name
171
+
end in
172
+
173
+
let yaml = read_file file in
174
+
let json = read_file (file ^ ".json") in
175
+
let json_result = Jsont_bytesrw.decode_string M.flexible_codec json in
176
+
let yaml_result = Yamlt.decode_string M.flexible_codec yaml in
177
+
178
+
show_result_both "flexible"
179
+
(Result.map M.show json_result)
180
+
(Result.map M.show yaml_result)
181
+
182
+
(* Test: Object cases (discriminated unions) - simplified version *)
183
+
let test_object_cases file =
184
+
let module M = struct
185
+
type circle = { type_: string; radius: float }
186
+
187
+
let circle_codec =
188
+
Jsont.Object.map ~kind:"Circle" (fun type_ radius -> { type_; radius })
189
+
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun c -> c.type_)
190
+
|> Jsont.Object.mem "radius" Jsont.number ~enc:(fun c -> c.radius)
191
+
|> Jsont.Object.finish
192
+
193
+
let show c =
194
+
Printf.sprintf "Circle{radius=%.2f}" c.radius
195
+
end in
196
+
197
+
let yaml = read_file file in
198
+
let json = read_file (file ^ ".json") in
199
+
let json_result = Jsont_bytesrw.decode_string M.circle_codec json in
200
+
let yaml_result = Yamlt.decode_string M.circle_codec yaml in
201
+
202
+
show_result_both "shape"
203
+
(Result.map M.show json_result)
204
+
(Result.map M.show yaml_result)
205
+
206
+
(* Test: Missing required field error *)
207
+
let test_missing_required file =
208
+
let module M = struct
209
+
type required = { name: string; age: int }
210
+
211
+
let required_codec =
212
+
Jsont.Object.map ~kind:"Required" (fun name age -> { name; age })
213
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)
214
+
|> Jsont.Object.mem "age" Jsont.int ~enc:(fun r -> r.age)
215
+
|> Jsont.Object.finish
216
+
end in
217
+
218
+
let yaml = read_file file in
219
+
let result = Yamlt.decode_string M.required_codec yaml in
220
+
match result with
221
+
| Ok _ -> Printf.printf "Unexpected success\n"
222
+
| Error e -> Printf.printf "Expected error: %s\n" e
223
+
224
+
(* Test: Encoding objects to different formats *)
225
+
let test_encode_object () =
226
+
let module M = struct
227
+
type person = { name: string; age: int; active: bool }
228
+
229
+
let person_codec =
230
+
Jsont.Object.map ~kind:"Person" (fun name age active -> { name; age; active })
231
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
232
+
|> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)
233
+
|> Jsont.Object.mem "active" Jsont.bool ~enc:(fun p -> p.active)
234
+
|> Jsont.Object.finish
235
+
end in
236
+
237
+
let person = M.{ name = "Alice"; age = 30; active = true } in
238
+
239
+
(* Encode to JSON *)
240
+
(match Jsont_bytesrw.encode_string M.person_codec person with
241
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
242
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
243
+
244
+
(* Encode to YAML Block *)
245
+
(match Yamlt.encode_string ~format:Yamlt.Block M.person_codec person with
246
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
247
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
248
+
249
+
(* Encode to YAML Flow *)
250
+
(match Yamlt.encode_string ~format:Yamlt.Flow M.person_codec person with
251
+
| Ok s -> Printf.printf "YAML Flow: %s" s
252
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
253
+
254
+
let () =
255
+
let usage = "Usage: test_objects <command> [args...]" in
256
+
257
+
if Stdlib.Array.length Sys.argv < 2 then begin
258
+
prerr_endline usage;
259
+
exit 1
260
+
end;
261
+
262
+
match Sys.argv.(1) with
263
+
| "simple" when Stdlib.Array.length Sys.argv = 3 ->
264
+
test_simple_object Sys.argv.(2)
265
+
266
+
| "optional" when Stdlib.Array.length Sys.argv = 3 ->
267
+
test_optional_fields Sys.argv.(2)
268
+
269
+
| "defaults" when Stdlib.Array.length Sys.argv = 3 ->
270
+
test_default_values Sys.argv.(2)
271
+
272
+
| "nested" when Stdlib.Array.length Sys.argv = 3 ->
273
+
test_nested_objects Sys.argv.(2)
274
+
275
+
| "unknown-error" when Stdlib.Array.length Sys.argv = 3 ->
276
+
test_unknown_members_error Sys.argv.(2)
277
+
278
+
| "unknown-keep" when Stdlib.Array.length Sys.argv = 3 ->
279
+
test_unknown_members_keep Sys.argv.(2)
280
+
281
+
| "cases" when Stdlib.Array.length Sys.argv = 3 ->
282
+
test_object_cases Sys.argv.(2)
283
+
284
+
| "missing-required" when Stdlib.Array.length Sys.argv = 3 ->
285
+
test_missing_required Sys.argv.(2)
286
+
287
+
| "encode" when Stdlib.Array.length Sys.argv = 2 ->
288
+
test_encode_object ()
289
+
290
+
| _ ->
291
+
prerr_endline usage;
292
+
prerr_endline "Commands:";
293
+
prerr_endline " simple <file> - Test simple object";
294
+
prerr_endline " optional <file> - Test optional fields";
295
+
prerr_endline " defaults <file> - Test default values";
296
+
prerr_endline " nested <file> - Test nested objects";
297
+
prerr_endline " unknown-error <file> - Test unknown member error";
298
+
prerr_endline " unknown-keep <file> - Test keeping unknown members";
299
+
prerr_endline " cases <file> - Test object cases (unions)";
300
+
prerr_endline " missing-required <file> - Test missing required field error";
301
+
prerr_endline " encode - Test encoding objects";
302
+
exit 1
+16
tests/bin/test_opt_array.ml
+16
tests/bin/test_opt_array.ml
···
1
+
let () =
2
+
let codec =
3
+
Jsont.Object.map ~kind:"Test" (fun arr -> arr)
4
+
|> Jsont.Object.opt_mem "values" (Jsont.array Jsont.string) ~enc:(fun arr -> arr)
5
+
|> Jsont.Object.finish
6
+
in
7
+
8
+
let yaml = "values: [a, b, c]" in
9
+
10
+
Printf.printf "Testing optional array field:\n";
11
+
match Yamlt.decode_string codec yaml with
12
+
| Ok arr ->
13
+
(match arr with
14
+
| None -> Printf.printf "Result: None\n"
15
+
| Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))
16
+
| Error e -> Printf.printf "Error: %s\n" e
+197
tests/bin/test_roundtrip.ml
+197
tests/bin/test_roundtrip.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test roundtrip encoding/decoding with Yamlt *)
7
+
8
+
(* Test: Roundtrip scalars *)
9
+
let test_scalar_roundtrip () =
10
+
let module M = struct
11
+
type data = { s: string; n: float; b: bool; nul: unit }
12
+
13
+
let data_codec =
14
+
Jsont.Object.map ~kind:"Data" (fun s n b nul -> { s; n; b; nul })
15
+
|> Jsont.Object.mem "s" Jsont.string ~enc:(fun d -> d.s)
16
+
|> Jsont.Object.mem "n" Jsont.number ~enc:(fun d -> d.n)
17
+
|> Jsont.Object.mem "b" Jsont.bool ~enc:(fun d -> d.b)
18
+
|> Jsont.Object.mem "nul" (Jsont.null ()) ~enc:(fun d -> d.nul)
19
+
|> Jsont.Object.finish
20
+
21
+
let equal d1 d2 =
22
+
d1.s = d2.s && d1.n = d2.n && d1.b = d2.b && d1.nul = d2.nul
23
+
end in
24
+
25
+
let original = { M.s = "hello"; n = 42.5; b = true; nul = () } in
26
+
27
+
(* JSON roundtrip *)
28
+
let json_encoded = Jsont_bytesrw.encode_string M.data_codec original in
29
+
let json_decoded = Result.bind json_encoded (Jsont_bytesrw.decode_string M.data_codec) in
30
+
(match json_decoded with
31
+
| Ok decoded when M.equal original decoded -> Printf.printf "JSON roundtrip: PASS\n"
32
+
| Ok _ -> Printf.printf "JSON roundtrip: FAIL (data mismatch)\n"
33
+
| Error e -> Printf.printf "JSON roundtrip: FAIL (%s)\n" e);
34
+
35
+
(* YAML Block roundtrip *)
36
+
let yaml_block_encoded = Yamlt.encode_string ~format:Yamlt.Block M.data_codec original in
37
+
let yaml_block_decoded = Result.bind yaml_block_encoded (Yamlt.decode_string M.data_codec) in
38
+
(match yaml_block_decoded with
39
+
| Ok decoded when M.equal original decoded -> Printf.printf "YAML Block roundtrip: PASS\n"
40
+
| Ok _ -> Printf.printf "YAML Block roundtrip: FAIL (data mismatch)\n"
41
+
| Error e -> Printf.printf "YAML Block roundtrip: FAIL (%s)\n" e);
42
+
43
+
(* YAML Flow roundtrip *)
44
+
let yaml_flow_encoded = Yamlt.encode_string ~format:Yamlt.Flow M.data_codec original in
45
+
let yaml_flow_decoded = Result.bind yaml_flow_encoded (Yamlt.decode_string M.data_codec) in
46
+
(match yaml_flow_decoded with
47
+
| Ok decoded when M.equal original decoded -> Printf.printf "YAML Flow roundtrip: PASS\n"
48
+
| Ok _ -> Printf.printf "YAML Flow roundtrip: FAIL (data mismatch)\n"
49
+
| Error e -> Printf.printf "YAML Flow roundtrip: FAIL (%s)\n" e)
50
+
51
+
(* Test: Roundtrip arrays *)
52
+
let test_array_roundtrip () =
53
+
let module M = struct
54
+
type data = { items: int array; nested: float array array }
55
+
56
+
let data_codec =
57
+
Jsont.Object.map ~kind:"Data" (fun items nested -> { items; nested })
58
+
|> Jsont.Object.mem "items" (Jsont.array Jsont.int) ~enc:(fun d -> d.items)
59
+
|> Jsont.Object.mem "nested" (Jsont.array (Jsont.array Jsont.number)) ~enc:(fun d -> d.nested)
60
+
|> Jsont.Object.finish
61
+
62
+
let equal d1 d2 =
63
+
d1.items = d2.items && d1.nested = d2.nested
64
+
end in
65
+
66
+
let original = { M.items = [|1; 2; 3; 4; 5|]; nested = [|[|1.0; 2.0|]; [|3.0; 4.0|]|] } in
67
+
68
+
(* JSON roundtrip *)
69
+
let json_result = Result.bind
70
+
(Jsont_bytesrw.encode_string M.data_codec original)
71
+
(Jsont_bytesrw.decode_string M.data_codec) in
72
+
(match json_result with
73
+
| Ok decoded when M.equal original decoded -> Printf.printf "JSON array roundtrip: PASS\n"
74
+
| Ok _ -> Printf.printf "JSON array roundtrip: FAIL (data mismatch)\n"
75
+
| Error e -> Printf.printf "JSON array roundtrip: FAIL (%s)\n" e);
76
+
77
+
(* YAML roundtrip *)
78
+
let yaml_result = Result.bind
79
+
(Yamlt.encode_string M.data_codec original)
80
+
(Yamlt.decode_string M.data_codec) in
81
+
(match yaml_result with
82
+
| Ok decoded when M.equal original decoded -> Printf.printf "YAML array roundtrip: PASS\n"
83
+
| Ok _ -> Printf.printf "YAML array roundtrip: FAIL (data mismatch)\n"
84
+
| Error e -> Printf.printf "YAML array roundtrip: FAIL (%s)\n" e)
85
+
86
+
(* Test: Roundtrip objects *)
87
+
let test_object_roundtrip () =
88
+
let module M = struct
89
+
type person = { p_name: string; age: int; active: bool }
90
+
type company = { c_name: string; employees: person array }
91
+
92
+
let person_codec =
93
+
Jsont.Object.map ~kind:"Person" (fun p_name age active -> { p_name; age; active })
94
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.p_name)
95
+
|> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)
96
+
|> Jsont.Object.mem "active" Jsont.bool ~enc:(fun p -> p.active)
97
+
|> Jsont.Object.finish
98
+
99
+
let company_codec =
100
+
Jsont.Object.map ~kind:"Company" (fun c_name employees -> { c_name; employees })
101
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.c_name)
102
+
|> Jsont.Object.mem "employees" (Jsont.array person_codec) ~enc:(fun c -> c.employees)
103
+
|> Jsont.Object.finish
104
+
105
+
let person_equal p1 p2 =
106
+
p1.p_name = p2.p_name && p1.age = p2.age && p1.active = p2.active
107
+
108
+
let equal c1 c2 =
109
+
c1.c_name = c2.c_name &&
110
+
Stdlib.Array.length c1.employees = Stdlib.Array.length c2.employees &&
111
+
Stdlib.Array.for_all2 person_equal c1.employees c2.employees
112
+
end in
113
+
114
+
let original = {
115
+
M.c_name = "Acme Corp";
116
+
employees = [|
117
+
{ p_name = "Alice"; age = 30; active = true };
118
+
{ p_name = "Bob"; age = 25; active = false };
119
+
|]
120
+
} in
121
+
122
+
(* JSON roundtrip *)
123
+
let json_result = Result.bind
124
+
(Jsont_bytesrw.encode_string M.company_codec original)
125
+
(Jsont_bytesrw.decode_string M.company_codec) in
126
+
(match json_result with
127
+
| Ok decoded when M.equal original decoded -> Printf.printf "JSON object roundtrip: PASS\n"
128
+
| Ok _ -> Printf.printf "JSON object roundtrip: FAIL (data mismatch)\n"
129
+
| Error e -> Printf.printf "JSON object roundtrip: FAIL (%s)\n" e);
130
+
131
+
(* YAML roundtrip *)
132
+
let yaml_result = Result.bind
133
+
(Yamlt.encode_string M.company_codec original)
134
+
(Yamlt.decode_string M.company_codec) in
135
+
(match yaml_result with
136
+
| Ok decoded when M.equal original decoded -> Printf.printf "YAML object roundtrip: PASS\n"
137
+
| Ok _ -> Printf.printf "YAML object roundtrip: FAIL (data mismatch)\n"
138
+
| Error e -> Printf.printf "YAML object roundtrip: FAIL (%s)\n" e)
139
+
140
+
(* Test: Roundtrip with optionals *)
141
+
let test_optional_roundtrip () =
142
+
let module M = struct
143
+
type data = { required: string; optional: int option; nullable: string option }
144
+
145
+
let data_codec =
146
+
Jsont.Object.map ~kind:"Data" (fun required optional nullable -> { required; optional; nullable })
147
+
|> Jsont.Object.mem "required" Jsont.string ~enc:(fun d -> d.required)
148
+
|> Jsont.Object.opt_mem "optional" Jsont.int ~enc:(fun d -> d.optional)
149
+
|> Jsont.Object.mem "nullable" (Jsont.some Jsont.string) ~enc:(fun d -> d.nullable)
150
+
|> Jsont.Object.finish
151
+
152
+
let equal d1 d2 =
153
+
d1.required = d2.required && d1.optional = d2.optional && d1.nullable = d2.nullable
154
+
end in
155
+
156
+
let original = { M.required = "test"; optional = Some 42; nullable = None } in
157
+
158
+
(* JSON roundtrip *)
159
+
let json_result = Result.bind
160
+
(Jsont_bytesrw.encode_string M.data_codec original)
161
+
(Jsont_bytesrw.decode_string M.data_codec) in
162
+
(match json_result with
163
+
| Ok decoded when M.equal original decoded -> Printf.printf "JSON optional roundtrip: PASS\n"
164
+
| Ok _ -> Printf.printf "JSON optional roundtrip: FAIL (data mismatch)\n"
165
+
| Error e -> Printf.printf "JSON optional roundtrip: FAIL (%s)\n" e);
166
+
167
+
(* YAML roundtrip *)
168
+
let yaml_result = Result.bind
169
+
(Yamlt.encode_string M.data_codec original)
170
+
(Yamlt.decode_string M.data_codec) in
171
+
(match yaml_result with
172
+
| Ok decoded when M.equal original decoded -> Printf.printf "YAML optional roundtrip: PASS\n"
173
+
| Ok _ -> Printf.printf "YAML optional roundtrip: FAIL (data mismatch)\n"
174
+
| Error e -> Printf.printf "YAML optional roundtrip: FAIL (%s)\n" e)
175
+
176
+
let () =
177
+
let usage = "Usage: test_roundtrip <command>" in
178
+
179
+
if Stdlib.Array.length Sys.argv < 2 then begin
180
+
prerr_endline usage;
181
+
exit 1
182
+
end;
183
+
184
+
match Sys.argv.(1) with
185
+
| "scalar" -> test_scalar_roundtrip ()
186
+
| "array" -> test_array_roundtrip ()
187
+
| "object" -> test_object_roundtrip ()
188
+
| "optional" -> test_optional_roundtrip ()
189
+
190
+
| _ ->
191
+
prerr_endline usage;
192
+
prerr_endline "Commands:";
193
+
prerr_endline " scalar - Test scalar roundtrip";
194
+
prerr_endline " array - Test array roundtrip";
195
+
prerr_endline " object - Test object roundtrip";
196
+
prerr_endline " optional - Test optional fields roundtrip";
197
+
exit 1
+304
tests/bin/test_scalars.ml
+304
tests/bin/test_scalars.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test scalar type resolution with Yamlt codec *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok v -> Printf.printf "%s: %s\n" label v
19
+
| Error e -> Printf.printf "%s: ERROR: %s\n" label e
20
+
21
+
let show_result_json label json_result yaml_result =
22
+
Printf.printf "JSON %s\n" label;
23
+
show_result " decode" json_result;
24
+
Printf.printf "YAML %s\n" label;
25
+
show_result " decode" yaml_result
26
+
27
+
(* Test: Decode null values with different type expectations *)
28
+
let test_null_resolution file =
29
+
let yaml = read_file file in
30
+
31
+
(* Define a simple object codec with nullable field *)
32
+
let null_codec =
33
+
Jsont.Object.map ~kind:"NullTest" (fun n -> n)
34
+
|> Jsont.Object.mem "value" (Jsont.null ()) ~enc:(fun n -> n)
35
+
|> Jsont.Object.finish
36
+
in
37
+
38
+
(* Try decoding as null *)
39
+
let result = Yamlt.decode_string null_codec yaml in
40
+
show_result "null_codec" (Result.map (fun () -> "null") result)
41
+
42
+
(* Test: Boolean type-directed resolution *)
43
+
let test_bool_resolution file =
44
+
let yaml = read_file file in
45
+
let json = read_file (file ^ ".json") in
46
+
47
+
(* Codec expecting bool *)
48
+
let bool_codec =
49
+
Jsont.Object.map ~kind:"BoolTest" (fun b -> b)
50
+
|> Jsont.Object.mem "value" Jsont.bool ~enc:(fun b -> b)
51
+
|> Jsont.Object.finish
52
+
in
53
+
54
+
(* Codec expecting string *)
55
+
let string_codec =
56
+
Jsont.Object.map ~kind:"StringTest" (fun s -> s)
57
+
|> Jsont.Object.mem "value" Jsont.string ~enc:(fun s -> s)
58
+
|> Jsont.Object.finish
59
+
in
60
+
61
+
Printf.printf "=== Bool Codec ===\n";
62
+
let json_result = Jsont_bytesrw.decode_string bool_codec json in
63
+
let yaml_result = Yamlt.decode_string bool_codec yaml in
64
+
show_result_json "bool_codec"
65
+
(Result.map (Printf.sprintf "%b") json_result)
66
+
(Result.map (Printf.sprintf "%b") yaml_result);
67
+
68
+
Printf.printf "\n=== String Codec ===\n";
69
+
let json_result = Jsont_bytesrw.decode_string string_codec json in
70
+
let yaml_result = Yamlt.decode_string string_codec yaml in
71
+
show_result_json "string_codec"
72
+
(Result.map (Printf.sprintf "%S") json_result)
73
+
(Result.map (Printf.sprintf "%S") yaml_result)
74
+
75
+
(* Test: Number resolution *)
76
+
let test_number_resolution file =
77
+
let yaml = read_file file in
78
+
let json = read_file (file ^ ".json") in
79
+
80
+
let number_codec =
81
+
Jsont.Object.map ~kind:"NumberTest" (fun n -> n)
82
+
|> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)
83
+
|> Jsont.Object.finish
84
+
in
85
+
86
+
let json_result = Jsont_bytesrw.decode_string number_codec json in
87
+
let yaml_result = Yamlt.decode_string number_codec yaml in
88
+
89
+
show_result_json "number_codec"
90
+
(Result.map (Printf.sprintf "%.17g") json_result)
91
+
(Result.map (Printf.sprintf "%.17g") yaml_result)
92
+
93
+
(* Test: String resolution preserves everything *)
94
+
let test_string_resolution file =
95
+
let yaml = read_file file in
96
+
let json = read_file (file ^ ".json") in
97
+
98
+
let string_codec =
99
+
Jsont.Object.map ~kind:"StringTest" (fun s -> s)
100
+
|> Jsont.Object.mem "value" Jsont.string ~enc:(fun s -> s)
101
+
|> Jsont.Object.finish
102
+
in
103
+
104
+
let json_result = Jsont_bytesrw.decode_string string_codec json in
105
+
let yaml_result = Yamlt.decode_string string_codec yaml in
106
+
107
+
show_result_json "string_codec"
108
+
(Result.map (Printf.sprintf "%S") json_result)
109
+
(Result.map (Printf.sprintf "%S") yaml_result)
110
+
111
+
(* Test: Special float values *)
112
+
let test_special_floats file =
113
+
let yaml = read_file file in
114
+
115
+
let number_codec =
116
+
Jsont.Object.map ~kind:"SpecialFloat" (fun n -> n)
117
+
|> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)
118
+
|> Jsont.Object.finish
119
+
in
120
+
121
+
let result = Yamlt.decode_string number_codec yaml in
122
+
match result with
123
+
| Ok f ->
124
+
if Float.is_nan f then
125
+
Printf.printf "value: NaN\n"
126
+
else if f = Float.infinity then
127
+
Printf.printf "value: +Infinity\n"
128
+
else if f = Float.neg_infinity then
129
+
Printf.printf "value: -Infinity\n"
130
+
else
131
+
Printf.printf "value: %.17g\n" f
132
+
| Error e ->
133
+
Printf.printf "ERROR: %s\n" e
134
+
135
+
(* Test: Type mismatch errors *)
136
+
let test_type_mismatch file expected_type =
137
+
let yaml = read_file file in
138
+
139
+
match expected_type with
140
+
| "bool" ->
141
+
let codec =
142
+
Jsont.Object.map ~kind:"BoolTest" (fun b -> b)
143
+
|> Jsont.Object.mem "value" Jsont.bool ~enc:(fun b -> b)
144
+
|> Jsont.Object.finish
145
+
in
146
+
let result = Yamlt.decode_string codec yaml in
147
+
(match result with
148
+
| Ok _ -> Printf.printf "Unexpected success\n"
149
+
| Error e -> Printf.printf "Expected error: %s\n" e)
150
+
| "number" ->
151
+
let codec =
152
+
Jsont.Object.map ~kind:"NumberTest" (fun n -> n)
153
+
|> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)
154
+
|> Jsont.Object.finish
155
+
in
156
+
let result = Yamlt.decode_string codec yaml in
157
+
(match result with
158
+
| Ok _ -> Printf.printf "Unexpected success\n"
159
+
| Error e -> Printf.printf "Expected error: %s\n" e)
160
+
| "null" ->
161
+
let codec =
162
+
Jsont.Object.map ~kind:"NullTest" (fun n -> n)
163
+
|> Jsont.Object.mem "value" (Jsont.null ()) ~enc:(fun n -> n)
164
+
|> Jsont.Object.finish
165
+
in
166
+
let result = Yamlt.decode_string codec yaml in
167
+
(match result with
168
+
| Ok _ -> Printf.printf "Unexpected success\n"
169
+
| Error e -> Printf.printf "Expected error: %s\n" e)
170
+
| _ -> failwith "unknown type"
171
+
172
+
(* Test: Decode with Jsont.json to see auto-resolution *)
173
+
let test_any_resolution file =
174
+
let yaml = read_file file in
175
+
let json = read_file (file ^ ".json") in
176
+
177
+
let any_codec =
178
+
Jsont.Object.map ~kind:"AnyTest" (fun v -> v)
179
+
|> Jsont.Object.mem "value" Jsont.json ~enc:(fun v -> v)
180
+
|> Jsont.Object.finish
181
+
in
182
+
183
+
let json_result = Jsont_bytesrw.decode_string any_codec json in
184
+
let yaml_result = Yamlt.decode_string any_codec yaml in
185
+
186
+
(* Just show that it decoded successfully *)
187
+
show_result_json "any_codec"
188
+
(Result.map (fun _ -> "decoded") json_result)
189
+
(Result.map (fun _ -> "decoded") yaml_result)
190
+
191
+
(* Test: Encoding to different formats *)
192
+
let test_encode_formats value_type value =
193
+
match value_type with
194
+
| "bool" ->
195
+
let codec =
196
+
Jsont.Object.map ~kind:"BoolTest" (fun b -> b)
197
+
|> Jsont.Object.mem "value" Jsont.bool ~enc:(fun b -> b)
198
+
|> Jsont.Object.finish
199
+
in
200
+
let v = bool_of_string value in
201
+
(match Jsont_bytesrw.encode_string codec v with
202
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
203
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
204
+
(match Yamlt.encode_string ~format:Yamlt.Block codec v with
205
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
206
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
207
+
(match Yamlt.encode_string ~format:Yamlt.Flow codec v with
208
+
| Ok s -> Printf.printf "YAML Flow: %s" s
209
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
210
+
| "number" ->
211
+
let codec =
212
+
Jsont.Object.map ~kind:"NumberTest" (fun n -> n)
213
+
|> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)
214
+
|> Jsont.Object.finish
215
+
in
216
+
let v = float_of_string value in
217
+
(match Jsont_bytesrw.encode_string codec v with
218
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
219
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
220
+
(match Yamlt.encode_string ~format:Yamlt.Block codec v with
221
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
222
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
223
+
(match Yamlt.encode_string ~format:Yamlt.Flow codec v with
224
+
| Ok s -> Printf.printf "YAML Flow: %s" s
225
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
226
+
| "string" ->
227
+
let codec =
228
+
Jsont.Object.map ~kind:"StringTest" (fun s -> s)
229
+
|> Jsont.Object.mem "value" Jsont.string ~enc:(fun s -> s)
230
+
|> Jsont.Object.finish
231
+
in
232
+
let v = value in
233
+
(match Jsont_bytesrw.encode_string codec v with
234
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
235
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
236
+
(match Yamlt.encode_string ~format:Yamlt.Block codec v with
237
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
238
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
239
+
(match Yamlt.encode_string ~format:Yamlt.Flow codec v with
240
+
| Ok s -> Printf.printf "YAML Flow: %s" s
241
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
242
+
| "null" ->
243
+
let codec =
244
+
Jsont.Object.map ~kind:"NullTest" (fun n -> n)
245
+
|> Jsont.Object.mem "value" (Jsont.null ()) ~enc:(fun n -> n)
246
+
|> Jsont.Object.finish
247
+
in
248
+
let v = () in
249
+
(match Jsont_bytesrw.encode_string codec v with
250
+
| Ok s -> Printf.printf "JSON: %s\n" (String.trim s)
251
+
| Error e -> Printf.printf "JSON ERROR: %s\n" e);
252
+
(match Yamlt.encode_string ~format:Yamlt.Block codec v with
253
+
| Ok s -> Printf.printf "YAML Block:\n%s" s
254
+
| Error e -> Printf.printf "YAML Block ERROR: %s\n" e);
255
+
(match Yamlt.encode_string ~format:Yamlt.Flow codec v with
256
+
| Ok s -> Printf.printf "YAML Flow: %s" s
257
+
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)
258
+
| _ -> failwith "unknown type"
259
+
260
+
let () =
261
+
let usage = "Usage: test_scalars <command> [args...]" in
262
+
263
+
if Stdlib.Array.length Sys.argv < 2 then begin
264
+
prerr_endline usage;
265
+
exit 1
266
+
end;
267
+
268
+
match Sys.argv.(1) with
269
+
| "null" when Array.length Sys.argv = 3 ->
270
+
test_null_resolution Sys.argv.(2)
271
+
272
+
| "bool" when Array.length Sys.argv = 3 ->
273
+
test_bool_resolution Sys.argv.(2)
274
+
275
+
| "number" when Array.length Sys.argv = 3 ->
276
+
test_number_resolution Sys.argv.(2)
277
+
278
+
| "string" when Array.length Sys.argv = 3 ->
279
+
test_string_resolution Sys.argv.(2)
280
+
281
+
| "special-float" when Array.length Sys.argv = 3 ->
282
+
test_special_floats Sys.argv.(2)
283
+
284
+
| "type-mismatch" when Array.length Sys.argv = 4 ->
285
+
test_type_mismatch Sys.argv.(2) Sys.argv.(3)
286
+
287
+
| "any" when Array.length Sys.argv = 3 ->
288
+
test_any_resolution Sys.argv.(2)
289
+
290
+
| "encode" when Array.length Sys.argv = 4 ->
291
+
test_encode_formats Sys.argv.(2) Sys.argv.(3)
292
+
293
+
| _ ->
294
+
prerr_endline usage;
295
+
prerr_endline "Commands:";
296
+
prerr_endline " null <file> - Test null resolution";
297
+
prerr_endline " bool <file> - Test bool vs string resolution";
298
+
prerr_endline " number <file> - Test number resolution";
299
+
prerr_endline " string <file> - Test string resolution";
300
+
prerr_endline " special-float <file> - Test .inf, .nan, etc.";
301
+
prerr_endline " type-mismatch <file> <type> - Test error on type mismatch";
302
+
prerr_endline " any <file> - Test Jsont.any auto-resolution";
303
+
prerr_endline " encode <type> <value> - Test encoding to JSON/YAML";
304
+
exit 1
+32
tests/bin/test_some_vs_option.ml
+32
tests/bin/test_some_vs_option.ml
···
1
+
let () =
2
+
(* Using Jsont.some like opt_mem does *)
3
+
let codec1 =
4
+
Jsont.Object.map ~kind:"Test" (fun arr -> arr)
5
+
|> Jsont.Object.mem "values" (Jsont.some (Jsont.array Jsont.string)) ~enc:(fun arr -> arr)
6
+
|> Jsont.Object.finish
7
+
in
8
+
9
+
let yaml = "values: [a, b, c]" in
10
+
11
+
Printf.printf "Test 1: Jsont.some (Jsont.array) - like opt_mem:\n";
12
+
(match Yamlt.decode_string codec1 yaml with
13
+
| Ok arr ->
14
+
(match arr with
15
+
| None -> Printf.printf "Result: None\n"
16
+
| Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))
17
+
| Error e -> Printf.printf "Error: %s\n" e);
18
+
19
+
(* Using Jsont.option *)
20
+
let codec2 =
21
+
Jsont.Object.map ~kind:"Test" (fun arr -> arr)
22
+
|> Jsont.Object.mem "values" (Jsont.option (Jsont.array Jsont.string)) ~enc:(fun arr -> arr)
23
+
|> Jsont.Object.finish
24
+
in
25
+
26
+
Printf.printf "\nTest 2: Jsont.option (Jsont.array):\n";
27
+
(match Yamlt.decode_string codec2 yaml with
28
+
| Ok arr ->
29
+
(match arr with
30
+
| None -> Printf.printf "Result: None\n"
31
+
| Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))
32
+
| Error e -> Printf.printf "Error: %s\n" e)
+143
tests/cram/arrays_codec.t
+143
tests/cram/arrays_codec.t
···
1
+
Array Codec Tests with Yamlt
2
+
===============================
3
+
4
+
This test suite validates array encoding/decoding with Jsont codecs in YAML,
5
+
including homogeneous type checking and nested structures.
6
+
7
+
Setup
8
+
-----
9
+
10
+
================================================================================
11
+
HOMOGENEOUS ARRAYS
12
+
================================================================================
13
+
14
+
Integer arrays
15
+
16
+
$ test_arrays int ../data/arrays/int_array.yml
17
+
JSON: int_array: [1; 2; 3; 4; 5]
18
+
YAML: int_array: [1; 2; 3; 4; 5]
19
+
20
+
String arrays
21
+
22
+
$ test_arrays string ../data/arrays/string_array.yml
23
+
JSON: string_array: ["apple"; "banana"; "cherry"]
24
+
YAML: string_array: ["apple"; "banana"; "cherry"]
25
+
26
+
Float/Number arrays
27
+
28
+
$ test_arrays float ../data/arrays/float_array.yml
29
+
JSON: float_array: [1.50; 2.70; 3.14; 0.50]
30
+
YAML: float_array: [1.50; 2.70; 3.14; 0.50]
31
+
32
+
Boolean arrays
33
+
34
+
$ test_arrays bool ../data/arrays/bool_array.yml
35
+
JSON: bool_array: [true; false; true; true; false]
36
+
YAML: bool_array: [true; false; true; true; false]
37
+
38
+
================================================================================
39
+
EMPTY ARRAYS
40
+
================================================================================
41
+
42
+
Empty arrays work correctly
43
+
44
+
$ test_arrays empty ../data/arrays/empty_array.yml
45
+
JSON: empty_array: length=0
46
+
YAML: empty_array: length=0
47
+
48
+
================================================================================
49
+
ARRAYS OF OBJECTS
50
+
================================================================================
51
+
52
+
Arrays containing objects
53
+
54
+
$ test_arrays objects ../data/arrays/object_array.yml
55
+
JSON: object_array: [{Alice,30}; {Bob,25}; {Charlie,35}]
56
+
YAML: object_array: [{Alice,30}; {Bob,25}; {Charlie,35}]
57
+
58
+
================================================================================
59
+
NESTED ARRAYS
60
+
================================================================================
61
+
62
+
Arrays containing arrays (matrices)
63
+
64
+
$ test_arrays nested ../data/arrays/nested_array.yml
65
+
JSON: nested_arrays: [[1; 2; 3]; [4; 5; 6]; [7; 8; 9]]
66
+
YAML: nested_arrays: [[1; 2; 3]; [4; 5; 6]; [7; 8; 9]]
67
+
68
+
================================================================================
69
+
NULLABLE ARRAYS
70
+
================================================================================
71
+
72
+
Arrays with null elements
73
+
74
+
$ test_arrays nullable ../data/arrays/nullable_array.yml
75
+
JSON: nullable_array: ERROR: Expected string but found null
76
+
File "-", line 1, characters 21-22:
77
+
File "-", line 1, characters 21-22: at index 1 of
78
+
File "-", line 1, characters 11-22: array<string>
79
+
File "-": in member values of
80
+
File "-", line 1, characters 0-22: Nullable object
81
+
YAML: nullable_array: ["hello"; "null"; "world"; "null"; "test"]
82
+
83
+
================================================================================
84
+
ERROR HANDLING
85
+
================================================================================
86
+
87
+
Type mismatch in array element
88
+
89
+
$ test_arrays type-mismatch ../data/arrays/type_mismatch.yml
90
+
Expected error: String "not-a-number" does not parse to OCaml int value
91
+
File "-":
92
+
at index 2 of
93
+
File "-": array<OCaml int>
94
+
File "-": in member values of
95
+
File "-": Numbers object
96
+
97
+
================================================================================
98
+
ENCODING ARRAYS
99
+
================================================================================
100
+
101
+
Encode arrays to JSON and YAML formats
102
+
103
+
$ test_arrays encode
104
+
JSON: {"numbers":[1,2,3,4,5],"strings":["hello","world"]}
105
+
YAML Block:
106
+
numbers:
107
+
- 1.0
108
+
- 2.0
109
+
- 3.0
110
+
- 4.0
111
+
- 5.0
112
+
strings:
113
+
- hello
114
+
- world
115
+
YAML Flow: {numbers: [1.0, 2.0, 3.0, 4.0, 5.0]strings, [hello, world]}
116
+
117
+
================================================================================
118
+
NEGATIVE TESTS - Wrong File Types
119
+
================================================================================
120
+
121
+
Attempting to decode an object file with an array codec should fail
122
+
123
+
$ test_arrays int ../data/objects/simple.yml
124
+
JSON: int_array: ERROR: Missing member values in Numbers object
125
+
File "-", line 1, characters 0-28:
126
+
YAML: int_array: ERROR: Missing member values in Numbers object
127
+
File "-":
128
+
129
+
Attempting to decode a scalar file with an array codec should fail
130
+
131
+
$ test_arrays string ../data/scalars/string_plain.yml
132
+
JSON: string_array: ERROR: Missing member items in Tags object
133
+
File "-", line 1, characters 0-24:
134
+
YAML: string_array: ERROR: Missing member items in Tags object
135
+
File "-":
136
+
137
+
Attempting to decode int array with string array codec should fail
138
+
139
+
$ test_arrays string ../data/arrays/int_array.yml
140
+
JSON: string_array: ERROR: Missing member items in Tags object
141
+
File "-", line 1, characters 0-27:
142
+
YAML: string_array: ERROR: Missing member items in Tags object
143
+
File "-":
+74
tests/cram/complex_codec.t
+74
tests/cram/complex_codec.t
···
1
+
Complex Nested Types Tests with Yamlt
2
+
======================================
3
+
4
+
This test suite validates complex nested structures combining objects, arrays,
5
+
and various levels of nesting.
6
+
7
+
================================================================================
8
+
DEEPLY NESTED OBJECTS
9
+
================================================================================
10
+
11
+
Handle deeply nested object structures
12
+
13
+
$ test_complex deep-nesting ../data/complex/deep_nesting.yml
14
+
JSON: deep_nesting: depth=4, value=42
15
+
YAML: deep_nesting: depth=4, value=42
16
+
17
+
================================================================================
18
+
MIXED STRUCTURES
19
+
================================================================================
20
+
21
+
Arrays of objects containing arrays
22
+
23
+
$ test_complex mixed-structure ../data/complex/mixed_structure.yml
24
+
JSON: mixed_structure: name="products", items=3, total_tags=6
25
+
YAML: mixed_structure: name="products", items=3, total_tags=6
26
+
27
+
================================================================================
28
+
COMPLEX OPTIONAL COMBINATIONS
29
+
================================================================================
30
+
31
+
Multiple optional fields with different combinations
32
+
33
+
$ test_complex complex-optional ../data/complex/complex_optional.yml
34
+
JSON: complex_optional: host="example.com", port=443, ssl=true, fallbacks=2
35
+
YAML: complex_optional: ERROR: Expected array<string> but found sequence
36
+
File "-":
37
+
File "-": in member fallback_hosts of
38
+
File "-": Config object
39
+
40
+
================================================================================
41
+
HETEROGENEOUS DATA
42
+
================================================================================
43
+
44
+
Mixed types in arrays using any type
45
+
46
+
$ test_complex heterogeneous ../data/complex/heterogeneous.yml
47
+
JSON: heterogeneous: ERROR: Expected one of but found number
48
+
File "-", line 1, characters 11-12:
49
+
File "-", line 1, characters 11-12: at index 0 of
50
+
File "-", line 1, characters 10-12: array<one of >
51
+
File "-": in member mixed of
52
+
File "-", line 1, characters 0-12: Data object
53
+
YAML: heterogeneous: ERROR: Expected one of but found number
54
+
File "-":
55
+
at index 0 of
56
+
File "-": array<one of >
57
+
File "-": in member mixed of
58
+
File "-": Data object
59
+
60
+
================================================================================
61
+
NEGATIVE TESTS - Structure Mismatch
62
+
================================================================================
63
+
64
+
Using deeply nested data with flat codec should fail
65
+
66
+
$ test_complex mixed-structure ../data/complex/deep_nesting.yml
67
+
JSON: mixed_structure: ERROR: Missing members in Collection object:
68
+
items
69
+
name
70
+
File "-", line 1, characters 0-44:
71
+
YAML: mixed_structure: ERROR: Missing members in Collection object:
72
+
items
73
+
name
74
+
File "-":
+15
tests/cram/dune
+15
tests/cram/dune
···
1
+
(cram
2
+
(deps
3
+
(package yamlt)
4
+
(glob_files ../data/scalars/*.yml)
5
+
(glob_files ../data/scalars/*.json)
6
+
(glob_files ../data/objects/*.yml)
7
+
(glob_files ../data/objects/*.json)
8
+
(glob_files ../data/arrays/*.yml)
9
+
(glob_files ../data/arrays/*.json)
10
+
(glob_files ../data/formats/*.yml)
11
+
(glob_files ../data/formats/*.json)
12
+
(glob_files ../data/complex/*.yml)
13
+
(glob_files ../data/complex/*.json)
14
+
(glob_files ../data/edge/*.yml)
15
+
(glob_files ../data/edge/*.json)))
+85
tests/cram/edge_codec.t
+85
tests/cram/edge_codec.t
···
1
+
Edge Cases Tests with Yamlt
2
+
============================
3
+
4
+
This test suite validates edge cases including large numbers, special characters,
5
+
unicode, and boundary conditions.
6
+
7
+
================================================================================
8
+
LARGE NUMBERS
9
+
================================================================================
10
+
11
+
Very large and very small floating point numbers
12
+
13
+
$ test_edge large-numbers ../data/edge/large_numbers.yml
14
+
JSON: large_numbers: large_int=9007199254740991, large_float=1.797693e+308, small_float=2.225074e-308
15
+
YAML: large_numbers: large_int=9007199254740991, large_float=1.797693e+308, small_float=2.225074e-308
16
+
17
+
================================================================================
18
+
SPECIAL CHARACTERS
19
+
================================================================================
20
+
21
+
Strings containing newlines, tabs, and other special characters
22
+
23
+
$ test_edge special-chars ../data/edge/special_chars.yml
24
+
JSON: special_chars: length=34, contains_newline=true, contains_tab=true
25
+
YAML: special_chars: length=34, contains_newline=true, contains_tab=true
26
+
27
+
================================================================================
28
+
UNICODE STRINGS
29
+
================================================================================
30
+
31
+
Emoji, Chinese, and RTL text
32
+
33
+
$ test_edge unicode ../data/edge/unicode.yml
34
+
JSON: unicode: emoji="\240\159\142\137\240\159\154\128\226\156\168", chinese="\228\189\160\229\165\189\228\184\150\231\149\140", rtl="\217\133\216\177\216\173\216\168\216\167"
35
+
YAML: unicode: emoji="\240\159\142\137\240\159\154\128\226\156\168", chinese="\228\189\160\229\165\189\228\184\150\231\149\140", rtl="\217\133\216\177\216\173\216\168\216\167"
36
+
37
+
================================================================================
38
+
EMPTY COLLECTIONS
39
+
================================================================================
40
+
41
+
Empty arrays and objects
42
+
43
+
$ test_edge empty-collections ../data/edge/empty_collections.yml
44
+
JSON: empty_collections: empty_array_len=0, empty_object_array_len=0
45
+
YAML: empty_collections: empty_array_len=0, empty_object_array_len=0
46
+
47
+
================================================================================
48
+
SPECIAL KEY NAMES
49
+
================================================================================
50
+
51
+
Keys with dots, dashes, colons
52
+
53
+
$ test_edge special-keys ../data/edge/special_keys.yml
54
+
JSON: special_keys: ERROR: Expected one of but found object
55
+
File "-", line 1, characters 0-1:
56
+
YAML: special_keys: ERROR: Expected one of but found object
57
+
File "-":
58
+
59
+
================================================================================
60
+
SINGLE-ELEMENT ARRAYS
61
+
================================================================================
62
+
63
+
Arrays with exactly one element
64
+
65
+
$ test_edge single-element ../data/edge/single_element.yml
66
+
JSON: single_element: length=1, value=42
67
+
YAML: single_element: length=1, value=42
68
+
69
+
================================================================================
70
+
NEGATIVE TESTS - Boundary Violations
71
+
================================================================================
72
+
73
+
Using unicode data with number codec should fail
74
+
75
+
$ test_edge large-numbers ../data/edge/unicode.yml
76
+
JSON: large_numbers: ERROR: Missing members in Numbers object:
77
+
large_float
78
+
large_int
79
+
small_float
80
+
File "-", line 1, characters 0-72:
81
+
YAML: large_numbers: ERROR: Missing members in Numbers object:
82
+
large_float
83
+
large_int
84
+
small_float
85
+
File "-":
+107
tests/cram/formats_codec.t
+107
tests/cram/formats_codec.t
···
1
+
Format-Specific Features Tests with Yamlt
2
+
==========================================
3
+
4
+
This test suite validates YAML-specific format features and compares with JSON behavior.
5
+
6
+
================================================================================
7
+
MULTI-LINE STRINGS - LITERAL STYLE
8
+
================================================================================
9
+
10
+
Literal style (|) preserves newlines
11
+
12
+
$ test_formats literal ../data/formats/literal_string.yml
13
+
JSON: literal_string: lines=5, length=81
14
+
YAML: literal_string: lines=5, length=81
15
+
16
+
================================================================================
17
+
MULTI-LINE STRINGS - FOLDED STYLE
18
+
================================================================================
19
+
20
+
Folded style (>) folds lines into single line
21
+
22
+
$ test_formats folded ../data/formats/folded_string.yml
23
+
JSON: folded_string: length=114, newlines=1
24
+
YAML: folded_string: length=114, newlines=1
25
+
26
+
================================================================================
27
+
NUMBER FORMATS
28
+
================================================================================
29
+
30
+
YAML supports hex, octal, and binary number formats
31
+
32
+
$ test_formats number-formats ../data/formats/number_formats.yml
33
+
JSON: number_formats: hex=255, octal=63, binary=10
34
+
YAML: number_formats: ERROR: Expected number but found scalar 0o77
35
+
File "-":
36
+
File "-": in member octal of
37
+
File "-": Numbers object
38
+
39
+
================================================================================
40
+
COMMENTS
41
+
================================================================================
42
+
43
+
YAML comments are ignored during parsing
44
+
45
+
$ test_formats comments ../data/formats/comments.yml
46
+
YAML (with comments): host="localhost", port=8080, debug=true
47
+
48
+
================================================================================
49
+
EMPTY DOCUMENTS
50
+
================================================================================
51
+
52
+
Empty or null documents handled correctly
53
+
54
+
$ test_formats empty-doc ../data/formats/empty_doc.yml
55
+
JSON: empty_document: ERROR: Expected string but found null
56
+
File "-", line 1, characters 10-11:
57
+
File "-": in member value of
58
+
File "-", line 1, characters 0-11: Wrapper object
59
+
YAML: empty_document: value=Some("null")
60
+
61
+
================================================================================
62
+
EXPLICIT TYPE TAGS
63
+
================================================================================
64
+
65
+
Explicit YAML type tags (!!str, !!int, etc.)
66
+
67
+
$ test_formats explicit-tags ../data/formats/explicit_tags.yml
68
+
YAML (with tags): data="123"
69
+
70
+
================================================================================
71
+
ENCODING STYLES
72
+
================================================================================
73
+
74
+
Compare Block vs Flow encoding styles
75
+
76
+
$ test_formats encode-styles
77
+
YAML Block:
78
+
name: test
79
+
values:
80
+
- 1.0
81
+
- 2.0
82
+
- 3.0
83
+
nested:
84
+
enabled: true
85
+
count: 5.0
86
+
87
+
YAML Flow:
88
+
{name: test, values: [1.0, 2.0, 3.0]nested, {enabled: true, count: 5.0}}
89
+
90
+
91
+
================================================================================
92
+
NEGATIVE TESTS - Format Compatibility
93
+
================================================================================
94
+
95
+
Using literal string test with number codec should fail
96
+
97
+
$ test_formats number-formats ../data/formats/literal_string.yml
98
+
JSON: number_formats: ERROR: Missing members in Numbers object:
99
+
binary
100
+
hex
101
+
octal
102
+
File "-", line 1, characters 0-100:
103
+
YAML: number_formats: ERROR: Missing members in Numbers object:
104
+
binary
105
+
hex
106
+
octal
107
+
File "-":
+160
tests/cram/objects_codec.t
+160
tests/cram/objects_codec.t
···
1
+
Object Codec Tests with Yamlt
2
+
================================
3
+
4
+
This test suite validates object encoding/decoding with Jsont codecs in YAML,
5
+
and compares behavior with JSON.
6
+
7
+
Setup
8
+
-----
9
+
10
+
11
+
================================================================================
12
+
SIMPLE OBJECTS
13
+
================================================================================
14
+
15
+
Decode simple object with required fields
16
+
17
+
$ test_objects simple ../data/objects/simple.yml
18
+
JSON: person: {name="Alice"; age=30}
19
+
YAML: person: {name="Alice"; age=30}
20
+
21
+
================================================================================
22
+
OPTIONAL FIELDS
23
+
================================================================================
24
+
25
+
Object with all optional fields present
26
+
27
+
$ test_objects optional ../data/objects/optional_all.yml
28
+
JSON: config: {host="localhost"; port=Some 8080; debug=Some true}
29
+
YAML: config: {host="localhost"; port=Some 8080; debug=Some true}
30
+
31
+
Object with some optional fields missing
32
+
33
+
$ test_objects optional ../data/objects/optional_partial.yml
34
+
JSON: config: {host="example.com"; port=Some 3000; debug=None}
35
+
YAML: config: {host="example.com"; port=Some 3000; debug=None}
36
+
37
+
Object with only required field
38
+
39
+
$ test_objects optional ../data/objects/optional_minimal.yml
40
+
JSON: config: {host="minimal.com"; port=None; debug=None}
41
+
YAML: config: {host="minimal.com"; port=None; debug=None}
42
+
43
+
================================================================================
44
+
DEFAULT VALUES
45
+
================================================================================
46
+
47
+
Empty object uses all defaults
48
+
49
+
$ test_objects defaults ../data/objects/defaults_empty.yml
50
+
JSON: settings: {timeout=30; retries=3; verbose=false}
51
+
YAML: settings: {timeout=30; retries=3; verbose=false}
52
+
53
+
Object with partial fields uses defaults for missing ones
54
+
55
+
$ test_objects defaults ../data/objects/defaults_partial.yml
56
+
JSON: settings: {timeout=60; retries=3; verbose=false}
57
+
YAML: settings: {timeout=60; retries=3; verbose=false}
58
+
59
+
================================================================================
60
+
NESTED OBJECTS
61
+
================================================================================
62
+
63
+
Objects containing other objects
64
+
65
+
$ test_objects nested ../data/objects/nested.yml
66
+
JSON: employee: {name="Bob"; address={street="123 Main St"; city="Springfield"; zip="12345"}}
67
+
YAML: employee: {name="Bob"; address={street="123 Main St"; city="Springfield"; zip="12345"}}
68
+
69
+
================================================================================
70
+
UNKNOWN MEMBER HANDLING
71
+
================================================================================
72
+
73
+
Unknown members cause error by default
74
+
75
+
$ test_objects unknown-error ../data/objects/unknown_members.yml
76
+
Unexpected success
77
+
78
+
Unknown members can be kept
79
+
80
+
$ test_objects unknown-keep ../data/objects/unknown_keep.yml
81
+
JSON: flexible: {name="Charlie"; has_extra=true}
82
+
YAML: flexible: {name="Charlie"; has_extra=true}
83
+
84
+
================================================================================
85
+
OBJECT CASES (DISCRIMINATED UNIONS)
86
+
================================================================================
87
+
88
+
Decode circle variant
89
+
90
+
$ test_objects cases ../data/objects/case_circle.yml
91
+
JSON: shape: Circle{radius=5.50}
92
+
YAML: shape: Circle{radius=5.50}
93
+
94
+
Decode rectangle variant
95
+
96
+
$ test_objects cases ../data/objects/case_rectangle.yml
97
+
JSON: shape: ERROR: Missing member radius in Circle object
98
+
File "-", line 1, characters 0-52:
99
+
YAML: shape: ERROR: Missing member radius in Circle object
100
+
File "-":
101
+
102
+
================================================================================
103
+
ERROR HANDLING
104
+
================================================================================
105
+
106
+
Missing required field produces error
107
+
108
+
$ test_objects missing-required ../data/objects/missing_required.yml
109
+
Expected error: Missing member age in Required object
110
+
File "-":
111
+
112
+
================================================================================
113
+
ENCODING OBJECTS
114
+
================================================================================
115
+
116
+
Encode objects to JSON and YAML formats
117
+
118
+
$ test_objects encode
119
+
JSON: {"name":"Alice","age":30,"active":true}
120
+
YAML Block:
121
+
name: Alice
122
+
age: 30.0
123
+
active: true
124
+
YAML Flow: {name: Alice, age: 30.0, active: true}
125
+
126
+
================================================================================
127
+
NEGATIVE TESTS - Wrong File Types
128
+
================================================================================
129
+
130
+
Attempting to decode an array file with an object codec should fail
131
+
132
+
$ test_objects simple ../data/arrays/int_array.yml
133
+
JSON: person: ERROR: Missing members in Person object:
134
+
age
135
+
name
136
+
File "-", line 1, characters 0-27:
137
+
YAML: person: ERROR: Missing members in Person object:
138
+
age
139
+
name
140
+
File "-":
141
+
142
+
Attempting to decode a scalar file with an object codec should fail
143
+
144
+
$ test_objects simple ../data/scalars/string_plain.yml
145
+
JSON: person: ERROR: Missing members in Person object:
146
+
age
147
+
name
148
+
File "-", line 1, characters 0-24:
149
+
YAML: person: ERROR: Missing members in Person object:
150
+
age
151
+
name
152
+
File "-":
153
+
154
+
Attempting to decode wrong object type (nested when expecting simple) should fail
155
+
156
+
$ test_objects simple ../data/objects/nested.yml
157
+
JSON: person: ERROR: Missing member age in Person object
158
+
File "-", line 1, characters 0-92:
159
+
YAML: person: ERROR: Missing member age in Person object
160
+
File "-":
+46
tests/cram/roundtrip_codec.t
+46
tests/cram/roundtrip_codec.t
···
1
+
Roundtrip Encoding/Decoding Tests with Yamlt
2
+
=============================================
3
+
4
+
This test suite validates that data can be encoded and then decoded back
5
+
to the original value, ensuring no data loss in the roundtrip process.
6
+
7
+
================================================================================
8
+
SCALAR ROUNDTRIP
9
+
================================================================================
10
+
11
+
Encode and decode scalar types
12
+
13
+
$ test_roundtrip scalar
14
+
JSON roundtrip: PASS
15
+
YAML Block roundtrip: PASS
16
+
YAML Flow roundtrip: PASS
17
+
18
+
================================================================================
19
+
ARRAY ROUNDTRIP
20
+
================================================================================
21
+
22
+
Encode and decode arrays including nested arrays
23
+
24
+
$ test_roundtrip array
25
+
JSON array roundtrip: PASS
26
+
YAML array roundtrip: PASS
27
+
28
+
================================================================================
29
+
OBJECT ROUNDTRIP
30
+
================================================================================
31
+
32
+
Encode and decode complex objects with nested structures
33
+
34
+
$ test_roundtrip object
35
+
JSON object roundtrip: PASS
36
+
YAML object roundtrip: PASS
37
+
38
+
================================================================================
39
+
OPTIONAL FIELDS ROUNDTRIP
40
+
================================================================================
41
+
42
+
Encode and decode optional and nullable fields
43
+
44
+
$ test_roundtrip optional
45
+
Fatal error: exception Invalid_argument("option is None")
46
+
[2]
+342
tests/cram/scalars_codec.t
+342
tests/cram/scalars_codec.t
···
1
+
Scalar Type Resolution Tests with Yamlt Codec
2
+
==================================================
3
+
4
+
This test suite validates how YAML scalars are resolved based on the expected
5
+
Jsont type codec, and compares behavior with JSON decoding.
6
+
7
+
================================================================================
8
+
NULL RESOLUTION
9
+
================================================================================
10
+
11
+
Explicit null value
12
+
13
+
$ test_scalars null ../data/scalars/null_explicit.yml
14
+
null_codec: null
15
+
16
+
Tilde as null
17
+
18
+
$ test_scalars null ../data/scalars/null_tilde.yml
19
+
null_codec: null
20
+
21
+
Empty value as null
22
+
23
+
$ test_scalars null ../data/scalars/null_empty.yml
24
+
null_codec: null
25
+
26
+
================================================================================
27
+
BOOLEAN TYPE-DIRECTED RESOLUTION
28
+
================================================================================
29
+
30
+
Plain "true" resolves to bool(true) with bool codec, but string "true" with string codec
31
+
32
+
$ test_scalars bool ../data/scalars/bool_true_plain.yml
33
+
=== Bool Codec ===
34
+
JSON bool_codec
35
+
decode: true
36
+
YAML bool_codec
37
+
decode: true
38
+
39
+
=== String Codec ===
40
+
JSON string_codec
41
+
decode: ERROR: Expected string but found bool
42
+
File "-", line 1, characters 10-11:
43
+
File "-": in member value of
44
+
File "-", line 1, characters 0-11: StringTest object
45
+
YAML string_codec
46
+
decode: "true"
47
+
48
+
Quoted "true" always resolves to string, even with bool codec
49
+
50
+
$ test_scalars bool ../data/scalars/bool_true_quoted.yml
51
+
=== Bool Codec ===
52
+
JSON bool_codec
53
+
decode: ERROR: Expected bool but found string
54
+
File "-", line 1, characters 10-11:
55
+
File "-": in member value of
56
+
File "-", line 1, characters 0-11: BoolTest object
57
+
YAML bool_codec
58
+
decode: true
59
+
60
+
=== String Codec ===
61
+
JSON string_codec
62
+
decode: "true"
63
+
YAML string_codec
64
+
decode: "true"
65
+
66
+
YAML-specific bool: "yes" resolves to bool(true)
67
+
68
+
$ test_scalars bool ../data/scalars/bool_yes.yml
69
+
=== Bool Codec ===
70
+
JSON bool_codec
71
+
decode: true
72
+
YAML bool_codec
73
+
decode: true
74
+
75
+
=== String Codec ===
76
+
JSON string_codec
77
+
decode: ERROR: Expected string but found bool
78
+
File "-", line 1, characters 10-11:
79
+
File "-": in member value of
80
+
File "-", line 1, characters 0-11: StringTest object
81
+
YAML string_codec
82
+
decode: "yes"
83
+
84
+
Plain "false" and "no" work similarly
85
+
86
+
$ test_scalars bool ../data/scalars/bool_false.yml
87
+
=== Bool Codec ===
88
+
JSON bool_codec
89
+
decode: false
90
+
YAML bool_codec
91
+
decode: false
92
+
93
+
=== String Codec ===
94
+
JSON string_codec
95
+
decode: ERROR: Expected string but found bool
96
+
File "-", line 1, characters 10-11:
97
+
File "-": in member value of
98
+
File "-", line 1, characters 0-11: StringTest object
99
+
YAML string_codec
100
+
decode: "false"
101
+
102
+
$ test_scalars bool ../data/scalars/bool_no.yml
103
+
=== Bool Codec ===
104
+
JSON bool_codec
105
+
decode: false
106
+
YAML bool_codec
107
+
decode: false
108
+
109
+
=== String Codec ===
110
+
JSON string_codec
111
+
decode: ERROR: Expected string but found bool
112
+
File "-", line 1, characters 10-11:
113
+
File "-": in member value of
114
+
File "-", line 1, characters 0-11: StringTest object
115
+
YAML string_codec
116
+
decode: "no"
117
+
118
+
================================================================================
119
+
NUMBER RESOLUTION
120
+
================================================================================
121
+
122
+
Integer values
123
+
124
+
$ test_scalars number ../data/scalars/number_int.yml
125
+
JSON number_codec
126
+
decode: 42
127
+
YAML number_codec
128
+
decode: 42
129
+
130
+
Float values
131
+
132
+
$ test_scalars number ../data/scalars/number_float.yml
133
+
JSON number_codec
134
+
decode: 3.1415899999999999
135
+
YAML number_codec
136
+
decode: 3.1415899999999999
137
+
138
+
Hexadecimal notation (YAML-specific)
139
+
140
+
$ test_scalars number ../data/scalars/number_hex.yml
141
+
JSON number_codec
142
+
decode: 42
143
+
YAML number_codec
144
+
decode: 42
145
+
146
+
Octal notation (YAML-specific)
147
+
148
+
$ test_scalars number ../data/scalars/number_octal.yml
149
+
JSON number_codec
150
+
decode: 42
151
+
YAML number_codec
152
+
decode: ERROR: Expected number but found scalar 0o52
153
+
File "-":
154
+
File "-": in member value of
155
+
File "-": NumberTest object
156
+
157
+
Negative numbers
158
+
159
+
$ test_scalars number ../data/scalars/number_negative.yml
160
+
JSON number_codec
161
+
decode: -273.14999999999998
162
+
YAML number_codec
163
+
decode: -273.14999999999998
164
+
165
+
================================================================================
166
+
SPECIAL FLOAT VALUES (YAML-specific)
167
+
================================================================================
168
+
169
+
Positive infinity
170
+
171
+
$ test_scalars special-float ../data/scalars/special_inf.yml
172
+
value: +Infinity
173
+
174
+
Negative infinity
175
+
176
+
$ test_scalars special-float ../data/scalars/special_neg_inf.yml
177
+
value: -Infinity
178
+
179
+
Not-a-Number (NaN)
180
+
181
+
$ test_scalars special-float ../data/scalars/special_nan.yml
182
+
value: NaN
183
+
184
+
================================================================================
185
+
STRING RESOLUTION
186
+
================================================================================
187
+
188
+
Plain strings
189
+
190
+
$ test_scalars string ../data/scalars/string_plain.yml
191
+
JSON string_codec
192
+
decode: "hello world"
193
+
YAML string_codec
194
+
decode: "hello world"
195
+
196
+
Quoted numeric strings stay as strings
197
+
198
+
$ test_scalars string ../data/scalars/string_quoted.yml
199
+
JSON string_codec
200
+
decode: "42"
201
+
YAML string_codec
202
+
decode: "42"
203
+
204
+
Empty strings
205
+
206
+
$ test_scalars string ../data/scalars/string_empty.yml
207
+
JSON string_codec
208
+
decode: ""
209
+
YAML string_codec
210
+
decode: ""
211
+
212
+
================================================================================
213
+
TYPE MISMATCH ERRORS
214
+
================================================================================
215
+
216
+
String when bool expected
217
+
218
+
$ test_scalars type-mismatch ../data/scalars/mismatch_string_as_bool.yml bool
219
+
Expected error: Expected bool but found scalar hello
220
+
File "-":
221
+
File "-": in member value of
222
+
File "-": BoolTest object
223
+
224
+
String when number expected
225
+
226
+
$ test_scalars type-mismatch ../data/scalars/mismatch_string_as_number.yml number
227
+
Expected error: Expected number but found scalar not-a-number
228
+
File "-":
229
+
File "-": in member value of
230
+
File "-": NumberTest object
231
+
232
+
Number when null expected
233
+
234
+
$ test_scalars type-mismatch ../data/scalars/mismatch_number_as_null.yml null
235
+
Expected error: Expected null but found scalar 42
236
+
File "-":
237
+
File "-": in member value of
238
+
File "-": NullTest object
239
+
240
+
================================================================================
241
+
JSONT.ANY AUTO-RESOLUTION
242
+
================================================================================
243
+
244
+
With Jsont.any, scalars are auto-resolved based on their content
245
+
246
+
Null auto-resolves to null
247
+
248
+
$ test_scalars any ../data/scalars/any_null.yml
249
+
JSON any_codec
250
+
decode: decoded
251
+
YAML any_codec
252
+
decode: decoded
253
+
254
+
Plain bool auto-resolves to bool
255
+
256
+
$ test_scalars any ../data/scalars/any_bool.yml
257
+
JSON any_codec
258
+
decode: decoded
259
+
YAML any_codec
260
+
decode: decoded
261
+
262
+
Number auto-resolves to number
263
+
264
+
$ test_scalars any ../data/scalars/any_number.yml
265
+
JSON any_codec
266
+
decode: decoded
267
+
YAML any_codec
268
+
decode: decoded
269
+
270
+
Plain string auto-resolves to string
271
+
272
+
$ test_scalars any ../data/scalars/any_string.yml
273
+
JSON any_codec
274
+
decode: decoded
275
+
YAML any_codec
276
+
decode: decoded
277
+
278
+
================================================================================
279
+
ENCODING SCALARS
280
+
================================================================================
281
+
282
+
Encoding bool values
283
+
284
+
$ test_scalars encode bool true
285
+
JSON: {"value":true}
286
+
YAML Block:
287
+
value: true
288
+
YAML Flow: {value: true}
289
+
290
+
$ test_scalars encode bool false
291
+
JSON: {"value":false}
292
+
YAML Block:
293
+
value: false
294
+
YAML Flow: {value: false}
295
+
296
+
Encoding numbers
297
+
298
+
$ test_scalars encode number 42.5
299
+
JSON: {"value":42.5}
300
+
YAML Block:
301
+
value: 42.5
302
+
YAML Flow: {value: 42.5}
303
+
304
+
Encoding strings
305
+
306
+
$ test_scalars encode string "hello world"
307
+
JSON: {"value":"hello world"}
308
+
YAML Block:
309
+
value: hello world
310
+
YAML Flow: {value: hello world}
311
+
312
+
Encoding null
313
+
314
+
$ test_scalars encode null ""
315
+
JSON: {"value":null}
316
+
YAML Block:
317
+
value: null
318
+
YAML Flow: {value: null}
319
+
320
+
================================================================================
321
+
NEGATIVE TESTS - Wrong File Types
322
+
================================================================================
323
+
324
+
Attempting to decode an object file with a scalar codec should fail
325
+
326
+
$ test_scalars string ../data/objects/simple.yml
327
+
JSON string_codec
328
+
decode: ERROR: Missing member value in StringTest object
329
+
File "-", line 1, characters 0-28:
330
+
YAML string_codec
331
+
decode: ERROR: Missing member value in StringTest object
332
+
File "-":
333
+
334
+
Attempting to decode an array file with a scalar codec should fail
335
+
336
+
$ test_scalars number ../data/arrays/int_array.yml
337
+
JSON number_codec
338
+
decode: ERROR: Missing member value in NumberTest object
339
+
File "-", line 1, characters 0-27:
340
+
YAML number_codec
341
+
decode: ERROR: Missing member value in NumberTest object
342
+
File "-":
+6
tests/data/arrays/bool_array.yml
+6
tests/data/arrays/bool_array.yml
+1
tests/data/arrays/bool_array.yml.json
+1
tests/data/arrays/bool_array.yml.json
···
1
+
{"values": [true, false, true, true, false]}
+1
tests/data/arrays/empty_array.yml
+1
tests/data/arrays/empty_array.yml
···
1
+
items: []
+1
tests/data/arrays/empty_array.yml.json
+1
tests/data/arrays/empty_array.yml.json
···
1
+
{"items": []}
+1
tests/data/arrays/float_array.yml.json
+1
tests/data/arrays/float_array.yml.json
···
1
+
{"values": [1.5, 2.7, 3.14, 0.5]}
+1
tests/data/arrays/int_array.yml.json
+1
tests/data/arrays/int_array.yml.json
···
1
+
{"values": [1, 2, 3, 4, 5]}
+1
tests/data/arrays/nested_array.yml.json
+1
tests/data/arrays/nested_array.yml.json
···
1
+
{"data": [[1, 2, 3], [4, 5, 6], [7, 8, 9]]}
+6
tests/data/arrays/nullable_array.yml
+6
tests/data/arrays/nullable_array.yml
+1
tests/data/arrays/nullable_array.yml.json
+1
tests/data/arrays/nullable_array.yml.json
···
1
+
{"values": ["hello", null, "world", null, "test"]}
+7
tests/data/arrays/object_array.yml
+7
tests/data/arrays/object_array.yml
+1
tests/data/arrays/object_array.yml.json
+1
tests/data/arrays/object_array.yml.json
···
1
+
{"persons": [{"name": "Alice", "age": 30}, {"name": "Bob", "age": 25}, {"name": "Charlie", "age": 35}]}
+1
tests/data/arrays/string_array.yml.json
+1
tests/data/arrays/string_array.yml.json
···
1
+
{"items": ["apple", "banana", "cherry"]}
+4
tests/data/complex/complex_optional.yml
+4
tests/data/complex/complex_optional.yml
+1
tests/data/complex/complex_optional.yml.json
+1
tests/data/complex/complex_optional.yml.json
···
1
+
{"host": "example.com", "port": 443, "ssl": true, "fallback_hosts": ["backup1.example.com", "backup2.example.com"]}
+1
tests/data/complex/deep_nesting.yml.json
+1
tests/data/complex/deep_nesting.yml.json
···
1
+
{"top": {"nested": {"data": {"value": 42}}}}
+1
tests/data/complex/heterogeneous.yml
+1
tests/data/complex/heterogeneous.yml
···
1
+
mixed: [42, "hello", true, null, 3.14]
+1
tests/data/complex/heterogeneous.yml.json
+1
tests/data/complex/heterogeneous.yml.json
···
1
+
{"mixed": [42, "hello", true, null, 3.14]}
+8
tests/data/complex/mixed_structure.yml
+8
tests/data/complex/mixed_structure.yml
+1
tests/data/complex/mixed_structure.yml.json
+1
tests/data/complex/mixed_structure.yml.json
···
1
+
{"name": "products", "items": [{"id": 1, "tags": ["new", "sale", "featured"]}, {"id": 2, "tags": ["clearance"]}, {"id": 3, "tags": ["premium", "exclusive"]}]}
+1
tests/data/edge/empty_collections.yml.json
+1
tests/data/edge/empty_collections.yml.json
···
1
+
{"empty_array": [], "empty_object_array": []}
+3
tests/data/edge/large_numbers.yml
+3
tests/data/edge/large_numbers.yml
+1
tests/data/edge/large_numbers.yml.json
+1
tests/data/edge/large_numbers.yml.json
···
1
+
{"large_int": 9007199254740991, "large_float": 1.7976931348623157e+308, "small_float": 2.2250738585072014e-308}
+1
tests/data/edge/single_element.yml
+1
tests/data/edge/single_element.yml
···
1
+
single: [42]
+1
tests/data/edge/single_element.yml.json
+1
tests/data/edge/single_element.yml.json
···
1
+
{"single": [42]}
+1
tests/data/edge/special_chars.yml
+1
tests/data/edge/special_chars.yml
···
1
+
content: "Line 1\nLine 2\tTabbed\r\nWindows line"
+1
tests/data/edge/special_chars.yml.json
+1
tests/data/edge/special_chars.yml.json
···
1
+
{"content": "Line 1\nLine 2\tTabbed\r\nWindows line"}
+3
tests/data/edge/special_keys.yml
+3
tests/data/edge/special_keys.yml
+1
tests/data/edge/special_keys.yml.json
+1
tests/data/edge/special_keys.yml.json
···
1
+
{"key.with.dots": "value1", "key-with-dashes": "value2", "key:with:colons": "value3"}
+1
tests/data/edge/unicode.yml.json
+1
tests/data/edge/unicode.yml.json
···
1
+
{"emoji": "🎉🚀✨", "chinese": "你好世界", "rtl": "مرحبا"}
+5
tests/data/formats/comments.yml
+5
tests/data/formats/comments.yml
+1
tests/data/formats/empty_doc.yml
+1
tests/data/formats/empty_doc.yml
···
1
+
value: null
+1
tests/data/formats/empty_doc.yml.json
+1
tests/data/formats/empty_doc.yml.json
···
1
+
{"value": null}
+5
tests/data/formats/folded_string.yml
+5
tests/data/formats/folded_string.yml
+1
tests/data/formats/folded_string.yml.json
+1
tests/data/formats/folded_string.yml.json
···
1
+
{"content": "This is a folded string that spans multiple lines but will be folded into a single line with spaces between words\n"}
+5
tests/data/formats/literal_string.yml
+5
tests/data/formats/literal_string.yml
+1
tests/data/formats/literal_string.yml.json
+1
tests/data/formats/literal_string.yml.json
···
1
+
{"content": "This is a literal string\nwith multiple lines\npreserving newlines\nand indentation\n"}
+1
tests/data/formats/number_formats.yml.json
+1
tests/data/formats/number_formats.yml.json
···
1
+
{"hex": 255, "octal": 63, "binary": 10}
+1
tests/data/objects/case_circle.yml.json
+1
tests/data/objects/case_circle.yml.json
···
1
+
{"type": "circle", "radius": 5.5}
+1
tests/data/objects/case_rectangle.yml.json
+1
tests/data/objects/case_rectangle.yml.json
···
1
+
{"type": "rectangle", "width": 10.0, "height": 20.0}
+1
tests/data/objects/defaults_empty.yml
+1
tests/data/objects/defaults_empty.yml
···
1
+
{}
+1
tests/data/objects/defaults_empty.yml.json
+1
tests/data/objects/defaults_empty.yml.json
···
1
+
{}
+1
tests/data/objects/defaults_partial.yml
+1
tests/data/objects/defaults_partial.yml
···
1
+
timeout: 60
+1
tests/data/objects/defaults_partial.yml.json
+1
tests/data/objects/defaults_partial.yml.json
···
1
+
{"timeout": 60}
+1
tests/data/objects/missing_required.yml
+1
tests/data/objects/missing_required.yml
···
1
+
name: Incomplete
+5
tests/data/objects/nested.yml
+5
tests/data/objects/nested.yml
+1
tests/data/objects/nested.yml.json
+1
tests/data/objects/nested.yml.json
···
1
+
{"name": "Bob", "address": {"street": "123 Main St", "city": "Springfield", "zip": "12345"}}
+1
tests/data/objects/optional_all.yml.json
+1
tests/data/objects/optional_all.yml.json
···
1
+
{"host": "localhost", "port": 8080, "debug": true}
+1
tests/data/objects/optional_minimal.yml
+1
tests/data/objects/optional_minimal.yml
···
1
+
host: minimal.com
+1
tests/data/objects/optional_minimal.yml.json
+1
tests/data/objects/optional_minimal.yml.json
···
1
+
{"host": "minimal.com"}
+1
tests/data/objects/optional_partial.yml.json
+1
tests/data/objects/optional_partial.yml.json
···
1
+
{"host": "example.com", "port": 3000}
+1
tests/data/objects/simple.yml.json
+1
tests/data/objects/simple.yml.json
···
1
+
{"name": "Alice", "age": 30}
+1
tests/data/objects/unknown_keep.yml.json
+1
tests/data/objects/unknown_keep.yml.json
···
1
+
{"name": "Charlie", "extra1": "value1", "extra2": "value2"}
+1
tests/data/scalars/any_bool.yml
+1
tests/data/scalars/any_bool.yml
···
1
+
value: true
+1
tests/data/scalars/any_bool.yml.json
+1
tests/data/scalars/any_bool.yml.json
···
1
+
{"value": true}
+1
tests/data/scalars/any_null.yml
+1
tests/data/scalars/any_null.yml
···
1
+
value: null
+1
tests/data/scalars/any_null.yml.json
+1
tests/data/scalars/any_null.yml.json
···
1
+
{"value": null}
+1
tests/data/scalars/any_number.yml
+1
tests/data/scalars/any_number.yml
···
1
+
value: 123.45
+1
tests/data/scalars/any_number.yml.json
+1
tests/data/scalars/any_number.yml.json
···
1
+
{"value": 123.45}
+1
tests/data/scalars/any_string.yml
+1
tests/data/scalars/any_string.yml
···
1
+
value: hello
+1
tests/data/scalars/any_string.yml.json
+1
tests/data/scalars/any_string.yml.json
···
1
+
{"value": "hello"}
+1
tests/data/scalars/bool_false.yml
+1
tests/data/scalars/bool_false.yml
···
1
+
value: false
+1
tests/data/scalars/bool_false.yml.json
+1
tests/data/scalars/bool_false.yml.json
···
1
+
{"value": false}
+1
tests/data/scalars/bool_no.yml
+1
tests/data/scalars/bool_no.yml
···
1
+
value: no
+1
tests/data/scalars/bool_no.yml.json
+1
tests/data/scalars/bool_no.yml.json
···
1
+
{"value": false}
+1
tests/data/scalars/bool_true_plain.yml
+1
tests/data/scalars/bool_true_plain.yml
···
1
+
value: true
+1
tests/data/scalars/bool_true_plain.yml.json
+1
tests/data/scalars/bool_true_plain.yml.json
···
1
+
{"value": true}
+1
tests/data/scalars/bool_true_quoted.yml
+1
tests/data/scalars/bool_true_quoted.yml
···
1
+
value: "true"
+1
tests/data/scalars/bool_true_quoted.yml.json
+1
tests/data/scalars/bool_true_quoted.yml.json
···
1
+
{"value": "true"}
+1
tests/data/scalars/bool_yes.yml
+1
tests/data/scalars/bool_yes.yml
···
1
+
value: yes
+1
tests/data/scalars/bool_yes.yml.json
+1
tests/data/scalars/bool_yes.yml.json
···
1
+
{"value": true}
+1
tests/data/scalars/mismatch_number_as_null.yml
+1
tests/data/scalars/mismatch_number_as_null.yml
···
1
+
value: 42
+1
tests/data/scalars/mismatch_string_as_bool.yml
+1
tests/data/scalars/mismatch_string_as_bool.yml
···
1
+
value: hello
+1
tests/data/scalars/mismatch_string_as_number.yml
+1
tests/data/scalars/mismatch_string_as_number.yml
···
1
+
value: not-a-number
+1
tests/data/scalars/null_empty.yml
+1
tests/data/scalars/null_empty.yml
···
1
+
value:
+1
tests/data/scalars/null_explicit.yml
+1
tests/data/scalars/null_explicit.yml
···
1
+
value: null
+1
tests/data/scalars/null_tilde.yml
+1
tests/data/scalars/null_tilde.yml
···
1
+
value: ~
+1
tests/data/scalars/number_float.yml
+1
tests/data/scalars/number_float.yml
···
1
+
value: 3.14159
+1
tests/data/scalars/number_float.yml.json
+1
tests/data/scalars/number_float.yml.json
···
1
+
{"value": 3.14159}
+1
tests/data/scalars/number_hex.yml
+1
tests/data/scalars/number_hex.yml
···
1
+
value: 0x2A
+1
tests/data/scalars/number_hex.yml.json
+1
tests/data/scalars/number_hex.yml.json
···
1
+
{"value": 42}
+1
tests/data/scalars/number_int.yml
+1
tests/data/scalars/number_int.yml
···
1
+
value: 42
+1
tests/data/scalars/number_int.yml.json
+1
tests/data/scalars/number_int.yml.json
···
1
+
{"value": 42}
+1
tests/data/scalars/number_negative.yml
+1
tests/data/scalars/number_negative.yml
···
1
+
value: -273.15
+1
tests/data/scalars/number_negative.yml.json
+1
tests/data/scalars/number_negative.yml.json
···
1
+
{"value": -273.15}
+1
tests/data/scalars/number_octal.yml
+1
tests/data/scalars/number_octal.yml
···
1
+
value: 0o52
+1
tests/data/scalars/number_octal.yml.json
+1
tests/data/scalars/number_octal.yml.json
···
1
+
{"value": 42}
+1
tests/data/scalars/special_inf.yml
+1
tests/data/scalars/special_inf.yml
···
1
+
value: .inf
+1
tests/data/scalars/special_nan.yml
+1
tests/data/scalars/special_nan.yml
···
1
+
value: .nan
+1
tests/data/scalars/special_neg_inf.yml
+1
tests/data/scalars/special_neg_inf.yml
···
1
+
value: -.inf
+1
tests/data/scalars/string_empty.yml
+1
tests/data/scalars/string_empty.yml
···
1
+
value: ""
+1
tests/data/scalars/string_empty.yml.json
+1
tests/data/scalars/string_empty.yml.json
···
1
+
{"value": ""}
+1
tests/data/scalars/string_plain.yml
+1
tests/data/scalars/string_plain.yml
···
1
+
value: hello world
+1
tests/data/scalars/string_plain.yml.json
+1
tests/data/scalars/string_plain.yml.json
···
1
+
{"value": "hello world"}
+1
tests/data/scalars/string_quoted.yml
+1
tests/data/scalars/string_quoted.yml
···
1
+
value: "42"
+1
tests/data/scalars/string_quoted.yml.json
+1
tests/data/scalars/string_quoted.yml.json
···
1
+
{"value": "42"}
+28
yamlt.opam
+28
yamlt.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "YAML codec using Jsont type descriptions"
4
+
description:
5
+
"Allows the same Jsont.t codec definitions to work for both JSON and YAML"
6
+
depends: [
7
+
"dune" {>= "3.18"}
8
+
"ocaml" {>= "4.14.0"}
9
+
"yamlrw"
10
+
"jsont"
11
+
"bytesrw"
12
+
"odoc" {with-doc}
13
+
]
14
+
build: [
15
+
["dune" "subst"] {dev}
16
+
[
17
+
"dune"
18
+
"build"
19
+
"-p"
20
+
name
21
+
"-j"
22
+
jobs
23
+
"@install"
24
+
"@runtest" {with-test}
25
+
"@doc" {with-doc}
26
+
]
27
+
]
28
+
x-maintenance-intent: ["(latest)"]