anil.recoil.org
Yaml encoder/decoder for OCaml jsont codecs
fix unknown member round tripping
Bug report and fix from Thomas Gazagnaire <thomas@tarides.com>
+75
-2
+14
-2
lib/yamlt.ml
+14
-2
lib/yamlt.ml
···
900
900
encode e mem.type' mem_v
901
901
end)
902
902
map.mem_encs;
903
-
(* Handle case objects *)
903
+
(* Handle unknown members (for as_string_map objects) *)
904
904
(match map.shape with
905
-
| Object_basic _ -> ()
905
+
| Object_basic (Unknown_keep (mmap, enc_fn)) ->
906
+
let mems = enc_fn v in
907
+
let _acc : unit =
908
+
mmap.enc
909
+
(fun _meta name mem_v () ->
910
+
(* Emit key *)
911
+
emit e (scalar_event ~value:name ~style:`Plain ());
912
+
(* Emit value *)
913
+
encode e mmap.mems_type mem_v)
914
+
mems ()
915
+
in
916
+
()
917
+
| Object_basic (Unknown_skip | Unknown_error) -> ()
906
918
| Object_cases (_, cases) ->
907
919
let (Case_value (case_map, case_v)) = cases.enc_case (cases.enc v) in
908
920
(* Emit case tag *)
+50
tests/bin/test_objects.ml
+50
tests/bin/test_objects.ml
···
255
255
| Ok () -> Printf.printf "YAML Flow: %s" (Buffer.contents b)
256
256
| Error e -> Printf.printf "YAML Flow ERROR: %s\n" e
257
257
258
+
(* Test: Roundtrip encoding of objects with unknown members *)
259
+
let test_unknown_keep_roundtrip file =
260
+
let module M = struct
261
+
type flexible = { name : string; extra : Jsont.json }
262
+
263
+
let flexible_codec =
264
+
Jsont.Object.map ~kind:"Flexible" (fun name extra -> { name; extra })
265
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun f -> f.name)
266
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun f -> f.extra)
267
+
|> Jsont.Object.finish
268
+
269
+
let show_json json =
270
+
match Jsont_bytesrw.encode_string Jsont.json json with
271
+
| Ok s -> String.trim s
272
+
| Error e -> Printf.sprintf "ERROR: %s" e
273
+
end in
274
+
let yaml = read_file file in
275
+
276
+
(* Decode from YAML *)
277
+
match Yamlt.decode M.flexible_codec (Bytes.Reader.of_string yaml) with
278
+
| Error e -> Printf.printf "Decode error: %s\n" e
279
+
| Ok v ->
280
+
Printf.printf "Decoded: name=%S, extra=%s\n" v.M.name (M.show_json v.M.extra);
281
+
282
+
(* Encode to YAML Block *)
283
+
let b = Buffer.create 256 in
284
+
let writer = Bytes.Writer.of_buffer b in
285
+
(match
286
+
Yamlt.encode ~format:Yamlt.Block M.flexible_codec v ~eod:true writer
287
+
with
288
+
| Ok () -> Printf.printf "Encoded Block:\n%s" (Buffer.contents b)
289
+
| Error e -> Printf.printf "Encode Block ERROR: %s\n" e);
290
+
291
+
(* Re-decode the encoded YAML to verify roundtrip *)
292
+
let encoded = Buffer.contents b in
293
+
(match
294
+
Yamlt.decode M.flexible_codec (Bytes.Reader.of_string encoded)
295
+
with
296
+
| Error e -> Printf.printf "Re-decode error: %s\n" e
297
+
| Ok v2 ->
298
+
Printf.printf "Re-decoded: name=%S, extra=%s\n" v2.M.name
299
+
(M.show_json v2.M.extra);
300
+
if M.show_json v.M.extra = M.show_json v2.M.extra then
301
+
Printf.printf "Roundtrip: OK (extra members preserved)\n"
302
+
else Printf.printf "Roundtrip: FAILED (extra members lost)\n")
303
+
258
304
let () =
259
305
let usage = "Usage: test_objects <command> [args...]" in
260
306
···
276
322
test_unknown_members_error Sys.argv.(2)
277
323
| "unknown-keep" when Stdlib.Array.length Sys.argv = 3 ->
278
324
test_unknown_members_keep Sys.argv.(2)
325
+
| "unknown-keep-roundtrip" when Stdlib.Array.length Sys.argv = 3 ->
326
+
test_unknown_keep_roundtrip Sys.argv.(2)
279
327
| "cases" when Stdlib.Array.length Sys.argv = 3 ->
280
328
test_object_cases Sys.argv.(2)
281
329
| "missing-required" when Stdlib.Array.length Sys.argv = 3 ->
···
290
338
prerr_endline " nested <file> - Test nested objects";
291
339
prerr_endline " unknown-error <file> - Test unknown member error";
292
340
prerr_endline " unknown-keep <file> - Test keeping unknown members";
341
+
prerr_endline
342
+
" unknown-keep-roundtrip <file> - Test roundtrip of unknown members";
293
343
prerr_endline " cases <file> - Test object cases (unions)";
294
344
prerr_endline
295
345
" missing-required <file> - Test missing required field error";
+11
tests/cram/objects_codec.t
+11
tests/cram/objects_codec.t
···
81
81
JSON: flexible: {name="Charlie"; has_extra=true}
82
82
YAML: flexible: {name="Charlie"; has_extra=true}
83
83
84
+
Unknown members are preserved during encoding roundtrip
85
+
86
+
$ test_objects unknown-keep-roundtrip ../data/objects/unknown_keep.yml
87
+
Decoded: name="Charlie", extra={"extra1":"value1","extra2":"value2"}
88
+
Encoded Block:
89
+
name: Charlie
90
+
extra1: value1
91
+
extra2: value2
92
+
Re-decoded: name="Charlie", extra={"extra1":"value1","extra2":"value2"}
93
+
Roundtrip: OK (extra members preserved)
94
+
84
95
================================================================================
85
96
OBJECT CASES (DISCRIMINATED UNIONS)
86
97
================================================================================