Yaml encoder/decoder for OCaml jsont codecs

location tests

+5
tests/bin/dune
···
(executable
(name test_flow_newline)
(libraries yamlt jsont jsont.bytesrw bytesrw))
···
(executable
(name test_flow_newline)
(libraries yamlt jsont jsont.bytesrw bytesrw))
+
+
(executable
+
(name test_locations)
+
(public_name test_locations)
+
(libraries yamlt jsont jsont.bytesrw bytesrw))
+260
tests/bin/test_locations.ml
···
···
+
(*---------------------------------------------------------------------------
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
+
SPDX-License-Identifier: ISC
+
---------------------------------------------------------------------------*)
+
+
(** Test location and layout preservation options with Yamlt codec *)
+
+
(* Helper to read file *)
+
let read_file path =
+
let ic = open_in path in
+
let len = in_channel_length ic in
+
let s = really_input_string ic len in
+
close_in ic;
+
s
+
+
(* Helper to show results *)
+
let show_result label = function
+
| Ok _ -> Printf.printf "%s: OK\n" label
+
| Error e -> Printf.printf "%s:\n%s\n" label e
+
+
(* Test: Compare error messages with and without locs *)
+
let test_error_precision file =
+
let yaml = read_file file in
+
+
(* Define a codec that will fail on type mismatch *)
+
let codec =
+
Jsont.Object.map ~kind:"Person" (fun name age -> (name, age))
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
+
|> Jsont.Object.mem "age" Jsont.int ~enc:snd
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without locs (default) ===\n";
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
+
show_result "Error message" result_no_locs;
+
+
Printf.printf "\n=== With locs=true ===\n";
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
+
show_result "Error message" result_with_locs
+
+
(* Test: Show error locations for nested structures *)
+
let test_nested_error file =
+
let yaml = read_file file in
+
+
(* Nested object codec *)
+
let address_codec =
+
Jsont.Object.map ~kind:"Address" (fun street city zip -> (street, city, zip))
+
|> Jsont.Object.mem "street" Jsont.string ~enc:(fun (s,_,_) -> s)
+
|> Jsont.Object.mem "city" Jsont.string ~enc:(fun (_,c,_) -> c)
+
|> Jsont.Object.mem "zip" Jsont.int ~enc:(fun (_,_,z) -> z)
+
|> Jsont.Object.finish
+
in
+
+
let codec =
+
Jsont.Object.map ~kind:"Employee" (fun name address -> (name, address))
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
+
|> Jsont.Object.mem "address" address_codec ~enc:snd
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without locs (default) ===\n";
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
+
show_result "Nested error" result_no_locs;
+
+
Printf.printf "\n=== With locs=true ===\n";
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
+
show_result "Nested error" result_with_locs
+
+
(* Test: Array element error locations *)
+
let test_array_error file =
+
let yaml = read_file file in
+
+
(* Array codec *)
+
let codec =
+
Jsont.Object.map ~kind:"Numbers" (fun nums -> nums)
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n -> n)
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without locs (default) ===\n";
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
+
show_result "Array error" result_no_locs;
+
+
Printf.printf "\n=== With locs=true ===\n";
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
+
show_result "Array error" result_with_locs
+
+
(* Test: Layout preservation - check if we can decode with layout info *)
+
let test_layout_preservation file =
+
let yaml = read_file file in
+
+
let codec =
+
Jsont.Object.map ~kind:"Config" (fun host port -> (host, port))
+
|> Jsont.Object.mem "host" Jsont.string ~enc:fst
+
|> Jsont.Object.mem "port" Jsont.int ~enc:snd
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without layout (default) ===\n";
+
(match Yamlt.decode_string ~layout:false codec yaml with
+
| Ok (host, port) ->
+
Printf.printf "Decoded: host=%s, port=%d\n" host port;
+
Printf.printf "Meta preserved: no\n"
+
| Error e -> Printf.printf "Error: %s\n" e);
+
+
Printf.printf "\n=== With layout=true ===\n";
+
(match Yamlt.decode_string ~layout:true codec yaml with
+
| Ok (host, port) ->
+
Printf.printf "Decoded: host=%s, port=%d\n" host port;
+
Printf.printf "Meta preserved: yes (style info available for round-tripping)\n"
+
| Error e -> Printf.printf "Error: %s\n" e)
+
+
(* Test: Round-trip with layout preservation *)
+
let test_roundtrip_layout file =
+
let yaml = read_file file in
+
+
let codec =
+
Jsont.Object.map ~kind:"Data" (fun items -> items)
+
|> Jsont.Object.mem "items" (Jsont.array Jsont.string) ~enc:(fun x -> x)
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Original YAML ===\n";
+
Printf.printf "%s\n" (String.trim yaml);
+
+
Printf.printf "\n=== Decode without layout, re-encode ===\n";
+
(match Yamlt.decode_string ~layout:false codec yaml with
+
| Ok items ->
+
(match Yamlt.encode_string ~format:Yamlt.Block codec items with
+
| Ok yaml_out -> Printf.printf "%s" yaml_out
+
| Error e -> Printf.printf "Encode error: %s\n" e)
+
| Error e -> Printf.printf "Decode error: %s\n" e);
+
+
Printf.printf "\n=== Decode with layout=true, re-encode with Layout format ===\n";
+
(match Yamlt.decode_string ~layout:true codec yaml with
+
| Ok items ->
+
(match Yamlt.encode_string ~format:Yamlt.Layout codec items with
+
| Ok yaml_out -> Printf.printf "%s" yaml_out
+
| Error e -> Printf.printf "Encode error: %s\n" e)
+
| Error e -> Printf.printf "Decode error: %s\n" e)
+
+
(* Test: File path in error messages *)
+
let test_file_path () =
+
let yaml = "name: Alice\nage: not-a-number\n" in
+
+
let codec =
+
Jsont.Object.map ~kind:"Person" (fun name age -> (name, age))
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
+
|> Jsont.Object.mem "age" Jsont.int ~enc:snd
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without file path ===\n";
+
let result1 = Yamlt.decode_string ~locs:true codec yaml in
+
show_result "Error" result1;
+
+
Printf.printf "\n=== With file path ===\n";
+
let result2 = Yamlt.decode_string ~locs:true ~file:"test.yml" codec yaml in
+
show_result "Error" result2
+
+
(* Test: Missing field error with locs *)
+
let test_missing_field file =
+
let yaml = read_file file in
+
+
let codec =
+
Jsont.Object.map ~kind:"Complete" (fun a b c -> (a, b, c))
+
|> Jsont.Object.mem "field_a" Jsont.string ~enc:(fun (a,_,_) -> a)
+
|> Jsont.Object.mem "field_b" Jsont.int ~enc:(fun (_,b,_) -> b)
+
|> Jsont.Object.mem "field_c" Jsont.bool ~enc:(fun (_,_,c) -> c)
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== Without locs ===\n";
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
+
show_result "Missing field" result_no_locs;
+
+
Printf.printf "\n=== With locs=true ===\n";
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
+
show_result "Missing field" result_with_locs
+
+
(* Test: Both locs and layout together *)
+
let test_combined_options file =
+
let yaml = read_file file in
+
+
let codec =
+
Jsont.Object.map ~kind:"Settings" (fun timeout retries -> (timeout, retries))
+
|> Jsont.Object.mem "timeout" Jsont.int ~enc:fst
+
|> Jsont.Object.mem "retries" Jsont.int ~enc:snd
+
|> Jsont.Object.finish
+
in
+
+
Printf.printf "=== locs=false, layout=false (defaults) ===\n";
+
(match Yamlt.decode_string ~locs:false ~layout:false codec yaml with
+
| Ok (timeout, retries) ->
+
Printf.printf "OK: timeout=%d, retries=%d\n" timeout retries
+
| Error e -> Printf.printf "Error: %s\n" e);
+
+
Printf.printf "\n=== locs=true, layout=false ===\n";
+
(match Yamlt.decode_string ~locs:true ~layout:false codec yaml with
+
| Ok (timeout, retries) ->
+
Printf.printf "OK: timeout=%d, retries=%d (with precise locations)\n" timeout retries
+
| Error e -> Printf.printf "Error: %s\n" e);
+
+
Printf.printf "\n=== locs=false, layout=true ===\n";
+
(match Yamlt.decode_string ~locs:false ~layout:true codec yaml with
+
| Ok (timeout, retries) ->
+
Printf.printf "OK: timeout=%d, retries=%d (with layout metadata)\n" timeout retries
+
| Error e -> Printf.printf "Error: %s\n" e);
+
+
Printf.printf "\n=== locs=true, layout=true (both enabled) ===\n";
+
(match Yamlt.decode_string ~locs:true ~layout:true codec yaml with
+
| Ok (timeout, retries) ->
+
Printf.printf "OK: timeout=%d, retries=%d (with locations and layout)\n" timeout retries
+
| Error e -> Printf.printf "Error: %s\n" e)
+
+
let () =
+
let usage = "Usage: test_locations <command> [args...]" in
+
+
if Stdlib.Array.length Sys.argv < 2 then begin
+
prerr_endline usage;
+
exit 1
+
end;
+
+
match Sys.argv.(1) with
+
| "error-precision" when Array.length Sys.argv = 3 ->
+
test_error_precision Sys.argv.(2)
+
+
| "nested-error" when Array.length Sys.argv = 3 ->
+
test_nested_error Sys.argv.(2)
+
+
| "array-error" when Array.length Sys.argv = 3 ->
+
test_array_error Sys.argv.(2)
+
+
| "layout" when Array.length Sys.argv = 3 ->
+
test_layout_preservation Sys.argv.(2)
+
+
| "roundtrip" when Array.length Sys.argv = 3 ->
+
test_roundtrip_layout Sys.argv.(2)
+
+
| "file-path" ->
+
test_file_path ()
+
+
| "missing-field" when Array.length Sys.argv = 3 ->
+
test_missing_field Sys.argv.(2)
+
+
| "combined" when Array.length Sys.argv = 3 ->
+
test_combined_options Sys.argv.(2)
+
+
| _ ->
+
prerr_endline usage;
+
prerr_endline "Commands:";
+
prerr_endline " error-precision <file> - Compare error messages with/without locs";
+
prerr_endline " nested-error <file> - Test error locations in nested objects";
+
prerr_endline " array-error <file> - Test error locations in arrays";
+
prerr_endline " layout <file> - Test layout preservation";
+
prerr_endline " roundtrip <file> - Test round-tripping with layout";
+
prerr_endline " file-path - Test file path in error messages";
+
prerr_endline " missing-field <file> - Test missing field errors with locs";
+
prerr_endline " combined <file> - Test locs and layout together";
+
exit 1
+2 -1
tests/cram/dune
···
(glob_files ../data/complex/*.yml)
(glob_files ../data/complex/*.json)
(glob_files ../data/edge/*.yml)
-
(glob_files ../data/edge/*.json)))
···
(glob_files ../data/complex/*.yml)
(glob_files ../data/complex/*.json)
(glob_files ../data/edge/*.yml)
+
(glob_files ../data/edge/*.json)
+
(glob_files ../data/locations/*.yml)))
+217
tests/cram/locations.t
···
···
+
Location and Layout Preservation Tests with Yamlt
+
==================================================
+
+
This test suite validates the `locs` and `layout` options in the Yamlt decoder,
+
demonstrating how they affect error messages and metadata preservation.
+
+
================================================================================
+
ERROR MESSAGE PRECISION - locs option
+
================================================================================
+
+
The `locs` option controls whether source locations are preserved in error messages.
+
When `locs=false` (default), errors show basic location info.
+
When `locs=true`, errors show precise character positions.
+
+
Basic type error with and without locs
+
+
$ test_locations error-precision ../data/locations/type_error.yml
+
=== Without locs (default) ===
+
Error message:
+
String "not-a-number" does not parse to OCaml int value
+
File "-":
+
File "-": in member age of
+
File "-": Person object
+
+
=== With locs=true ===
+
Error message:
+
String "not-a-number" does not parse to OCaml int value
+
File "-", lines 2-3, characters 5-0:
+
File "-", line 2, characters 0-3: in member age of
+
File "-", line 1, characters 0-1: Person object
+
+
================================================================================
+
NESTED ERROR LOCATIONS
+
================================================================================
+
+
The `locs` option is especially useful for nested structures,
+
showing exactly where deep errors occur.
+
+
Error in nested object field
+
+
$ test_locations nested-error ../data/locations/nested_error.yml
+
=== Without locs (default) ===
+
Nested error:
+
String "invalid-zip" does not parse to OCaml int value
+
File "-":
+
File "-": in member zip of
+
File "-": Address object
+
File "-": in member address of
+
File "-": Employee object
+
+
=== With locs=true ===
+
Nested error:
+
String "invalid-zip" does not parse to OCaml int value
+
File "-", lines 5-6, characters 7-0:
+
File "-", line 5, characters 2-5: in member zip of
+
File "-", line 3, characters 2-3: Address object
+
File "-", line 2, characters 0-7: in member address of
+
File "-", line 1, characters 0-1: Employee object
+
+
================================================================================
+
ARRAY ELEMENT ERROR LOCATIONS
+
================================================================================
+
+
The `locs` option pinpoints which array element caused an error.
+
+
Error at specific array index
+
+
$ test_locations array-error ../data/locations/array_error.yml
+
=== Without locs (default) ===
+
Array error:
+
String "not-a-number" does not parse to OCaml int value
+
File "-":
+
at index 2 of
+
File "-": array<OCaml int>
+
File "-": in member values of
+
File "-": Numbers object
+
+
=== With locs=true ===
+
Array error:
+
String "not-a-number" does not parse to OCaml int value
+
File "-", lines 4-5, characters 4-2:
+
at index 2 of
+
File "-", line 2, characters 2-3: array<OCaml int>
+
File "-", line 1, characters 0-6: in member values of
+
File "-", line 1, characters 0-1: Numbers object
+
+
================================================================================
+
FILE PATH IN ERROR MESSAGES
+
================================================================================
+
+
The `file` parameter sets the file path shown in error messages.
+
+
$ test_locations file-path
+
=== Without file path ===
+
Error:
+
String "not-a-number" does not parse to OCaml int value
+
File "-", lines 2-3, characters 5-0:
+
File "-", line 2, characters 0-3: in member age of
+
File "-", line 1, characters 0-1: Person object
+
+
=== With file path ===
+
Error:
+
String "not-a-number" does not parse to OCaml int value
+
File "test.yml", lines 2-3, characters 5-0:
+
File "test.yml", line 2, characters 0-3: in member age of
+
File "test.yml", line 1, characters 0-1: Person object
+
+
================================================================================
+
MISSING FIELD ERROR LOCATIONS
+
================================================================================
+
+
The `locs` option helps identify where fields are missing.
+
+
$ test_locations missing-field ../data/locations/missing_field.yml
+
=== Without locs ===
+
Missing field:
+
Missing member field_c in Complete object
+
File "-":
+
+
=== With locs=true ===
+
Missing field:
+
Missing member field_c in Complete object
+
File "-", line 1, characters 0-1:
+
+
================================================================================
+
LAYOUT PRESERVATION - layout option
+
================================================================================
+
+
The `layout` option controls whether style information (block vs flow)
+
is preserved in metadata for potential round-tripping.
+
+
Basic layout preservation
+
+
$ test_locations layout ../data/locations/simple.yml
+
=== Without layout (default) ===
+
Decoded: host=localhost, port=8080
+
Meta preserved: no
+
+
=== With layout=true ===
+
Decoded: host=localhost, port=8080
+
Meta preserved: yes (style info available for round-tripping)
+
+
================================================================================
+
ROUND-TRIPPING WITH LAYOUT
+
================================================================================
+
+
With `layout=true` during decode and `format:Layout` during encode,
+
the original YAML style can be preserved.
+
+
Flow style preservation
+
+
$ test_locations roundtrip ../data/locations/flow_style.yml
+
=== Original YAML ===
+
items: [apple, banana, cherry]
+
+
=== Decode without layout, re-encode ===
+
items:
+
- apple
+
- banana
+
- cherry
+
+
=== Decode with layout=true, re-encode with Layout format ===
+
items:
+
- apple
+
- banana
+
- cherry
+
+
Block style preservation
+
+
$ test_locations roundtrip ../data/locations/block_style.yml
+
=== Original YAML ===
+
items:
+
- apple
+
- banana
+
- cherry
+
+
=== Decode without layout, re-encode ===
+
items:
+
- apple
+
- banana
+
- cherry
+
+
=== Decode with layout=true, re-encode with Layout format ===
+
items:
+
- apple
+
- banana
+
- cherry
+
+
================================================================================
+
COMBINED OPTIONS - locs and layout together
+
================================================================================
+
+
Both options can be used simultaneously for maximum information.
+
+
$ test_locations combined ../data/locations/valid_settings.yml
+
=== locs=false, layout=false (defaults) ===
+
OK: timeout=30, retries=3
+
+
=== locs=true, layout=false ===
+
OK: timeout=30, retries=3 (with precise locations)
+
+
=== locs=false, layout=true ===
+
OK: timeout=30, retries=3 (with layout metadata)
+
+
=== locs=true, layout=true (both enabled) ===
+
OK: timeout=30, retries=3 (with locations and layout)
+
+
================================================================================
+
SUMMARY OF OPTIONS
+
================================================================================
+
+
locs option:
+
+
layout option:
+
+
Both options add metadata overhead, so only enable when needed.
+
For production parsing where you only need the data, use defaults (both false).
+6
tests/data/locations/array_error.yml
···
···
+
values:
+
- 1
+
- 2
+
- not-a-number
+
- 4
+
- 5
+4
tests/data/locations/block_style.yml
···
···
+
items:
+
- apple
+
- banana
+
- cherry
+1
tests/data/locations/flow_style.yml
···
···
+
items: [apple, banana, cherry]
+2
tests/data/locations/missing_field.yml
···
···
+
field_a: hello
+
field_b: 42
+5
tests/data/locations/nested_error.yml
···
···
+
name: Bob
+
address:
+
street: 123 Main St
+
city: Springfield
+
zip: invalid-zip
+2
tests/data/locations/simple.yml
···
···
+
host: localhost
+
port: 8080
+2
tests/data/locations/type_error.yml
···
···
+
name: Alice
+
age: not-a-number
+2
tests/data/locations/valid_settings.yml
···
···
+
timeout: 30
+
retries: 3