commit d888d384574158577a295560e2d03e58236e2342 · anil.recoil.org/ocaml-yamlt

+19 -1

.gitignore

···

       1
       -
       _build

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       2
        
       ocaml-yamlrw

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
       +
       # OCaml build artifacts

     

       2
       +
       _build/

     

       3
       +
       *.install

     

       4
       +
       *.merlin

     

       5
       +
       

     

       6
       +
       # Third-party sources (fetch locally with opam source)

     

       7
       +
       third_party/

     

       8
       +
       

     

       9
       +
       # Symlinked dependencies

     

       10
        
       ocaml-yamlrw

     

       11
       +
       

     

       12
       +
       # Editor and OS files

     

       13
       +
       .DS_Store

     

       14
       +
       *.swp

     

       15
       +
       *~

     

       16
       +
       .vscode/

     

       17
       +
       .idea/

     

       18
       +
       

     

       19
       +
       # Opam local switch

     

       20
       +
       _opam/

.ocamlformat

···

       0

···

       1
       +
       version=0.28.1

+52

.tangled/workflows/build.yml

···

       1
       +
       when:

     

       2
       +
         - event: ["push", "pull_request"]

     

       3
       +
           branch: ["main"]

     

       4
       +
       

     

       5
       +
       engine: nixery

     

       6
       +
       

     

       7
       +
       dependencies:

     

       8
       +
         nixpkgs:

     

       9
       +
           - shell

     

       10
       +
           - stdenv

     

       11
       +
           - findutils

     

       12
       +
           - binutils

     

       13
       +
           - libunwind

     

       14
       +
           - ncurses

     

       15
       +
           - opam

     

       16
       +
           - git

     

       17
       +
           - gawk

     

       18
       +
           - gnupatch

     

       19
       +
           - gnum4

     

       20
       +
           - gnumake

     

       21
       +
           - gnutar

     

       22
       +
           - gnused

     

       23
       +
           - gnugrep

     

       24
       +
           - diffutils

     

       25
       +
           - gzip

     

       26
       +
           - bzip2

     

       27
       +
           - gcc

     

       28
       +
           - ocaml

     

       29
       +
       

     

       30
       +
       steps:

     

       31
       +
         - name: opam

     

       32
       +
           command: |

     

       33
       +
              opam init --disable-sandboxing -a -y

     

       34
       +
         - name: repo

     

       35
       +
           command: |

     

       36
       +
              opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git

     

       37
       +
         - name: switch

     

       38
       +
           command: |

     

       39
       +
              opam install . --confirm-level=unsafe-yes --deps-only

     

       40
       +
         - name: build

     

       41
       +
           command: |

     

       42
       +
              opam exec -- dune build

     

       43
       +
         - name: switch-test

     

       44
       +
           command: |

     

       45
       +
              opam install . --confirm-level=unsafe-yes --deps-only --with-test

     

       46
       +
         - name: test

     

       47
       +
           command: |

     

       48
       +
              opam exec -- dune runtest --verbose

     

       49
       +
         - name: doc

     

       50
       +
           command: |

     

       51
       +
              opam install -y odoc

     

       52
       +
              opam exec -- dune build @doc

+15

LICENSE.md

···

       1
       +
       ISC License

     

       2
       +
       

     

       3
       +
       Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>

     

       4
       +
       

     

       5
       +
       Permission to use, copy, modify, and distribute this software for any

     

       6
       +
       purpose with or without fee is hereby granted, provided that the above

     

       7
       +
       copyright notice and this permission notice appear in all copies.

     

       8
       +
       

     

       9
       +
       THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES

     

       10
       +
       WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF

     

       11
       +
       MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

     

       12
       +
       ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

     

       13
       +
       WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

     

       14
       +
       ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF

     

       15
       +
       OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

+62

README.md

···

       1
       +
       # yamlt - YAML codec using Jsont type descriptions

     

       2
       +
       

     

       3
       +
       Yamlt provides YAML streaming encode/decode that interprets Jsont.t type descriptions, allowing the same codec definitions to work for both JSON and YAML.

     

       4
       +
       

     

       5
       +
       ## Key Features

     

       6
       +
       

     

       7
       +
       - Use the same Jsont.t codec for both JSON and YAML formats

     

       8
       +
       - Streaming encode/decode with configurable depth and node limits

     

       9
       +
       - Support for YAML-specific features (scalars, sequences, mappings)

     

       10
       +
       - Billion laughs protection with configurable limits

     

       11
       +
       - Multiple output formats (block, flow, layout preservation)

     

       12
       +
       

     

       13
       +
       ## Usage

     

       14
       +
       

     

       15
       +
       ```ocaml

     

       16
       +
       (* Define a codec once using Jsont *)

     

       17
       +
       module Config = struct

     

       18
       +
         type t = { name: string; port: int }

     

       19
       +
         let make name port = { name; port }

     

       20
       +
         let jsont =

     

       21
       +
           Jsont.Object.map ~kind:"Config" make

     

       22
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.name)

     

       23
       +
           |> Jsont.Object.mem "port" Jsont.int ~enc:(fun c -> c.port)

     

       24
       +
           |> Jsont.Object.finish

     

       25
       +
       end

     

       26
       +
       

     

       27
       +
       (* Use the same codec for both JSON and YAML *)

     

       28
       +
       let from_json = Jsont_bytesrw.decode_string Config.jsont json_str

     

       29
       +
       let from_yaml = Yamlt.decode_string Config.jsont yaml_str

     

       30
       +
       ```

     

       31
       +
       

     

       32
       +
       For encoding:

     

       33
       +
       

     

       34
       +
       ```ocaml

     

       35
       +
       (* Encode to YAML with different formats *)

     

       36
       +
       let config = Config.make "server" 8080

     

       37
       +
       

     

       38
       +
       (* Block style (default) *)

     

       39
       +
       let yaml_block = Yamlt.encode_string Config.jsont config

     

       40
       +
       

     

       41
       +
       (* Flow style (JSON-like) *)

     

       42
       +
       let yaml_flow = Yamlt.encode_string ~format:Flow Config.jsont config

     

       43
       +
       ```

     

       44
       +
       

     

       45
       +
       ## Installation

     

       46
       +
       

     

       47
       +
       ```

     

       48
       +
       opam install yamlt

     

       49
       +
       ```

     

       50
       +
       

     

       51
       +
       ## Documentation

     

       52
       +
       

     

       53
       +
       API documentation is available at https://tangled.org/@anil.recoil.org/ocaml-yamlt or via:

     

       54
       +
       

     

       55
       +
       ```

     

       56
       +
       opam install yamlt

     

       57
       +
       odig doc yamlt

     

       58
       +
       ```

     

       59
       +
       

     

       60
       +
       ## License

     

       61
       +
       

     

       62
       +
       ISC

dune

···

       1
       +
       ; Root dune file

     

       2
       +
       

     

       3
       +
       ; Ignore third_party directory (for fetched dependency sources)

     

       4
       +
       

     

       5
       +
       (data_only_dirs third_party)

+10 -1

dune-project

···

       1
        
       (lang dune 3.18)

     

       0
        
       
     

       2
        
       (name yamlt)

     

       3
        
       

     

       4
        
       (generate_opam_files true)

     

       5
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       6
        
       (package

     

       7
        
        (name yamlt)

     

       8
        
        (synopsis "YAML codec using Jsont type descriptions")

     
···

       11
        
         (ocaml (>= 4.14.0))

     

       12
        
         yamlrw

     

       13
        
         jsont

     

       14
       -
         bytesrw))

     

       0

···

       1
        
       (lang dune 3.18)

     

       2
       +
       

     

       3
        
       (name yamlt)

     

       4
        
       

     

       5
        
       (generate_opam_files true)

     

       6
        
       

     

       7
       +
       (license ISC)

     

       8
       +
       (authors "Anil Madhavapeddy")

     

       9
       +
       (homepage "https://tangled.org/@anil.recoil.org/ocaml-yamlt")

     

       10
       +
       (maintainers "Anil Madhavapeddy <anil@recoil.org>")

     

       11
       +
       (bug_reports "https://tangled.org/@anil.recoil.org/ocaml-yamlt/issues")

     

       12
       +
       (maintenance_intent "(latest)")

     

       13
       +
       

     

       14
        
       (package

     

       15
        
        (name yamlt)

     

       16
        
        (synopsis "YAML codec using Jsont type descriptions")

     
···

       19
        
         (ocaml (>= 4.14.0))

     

       20
        
         yamlrw

     

       21
        
         jsont

     

       22
       +
         bytesrw

     

       23
       +
         (odoc :with-doc)))

+469 -389

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

     
···

       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 }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       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

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       79
        
         | None ->

     

       80
       -
             Jsont.Error.msgf Jsont.Meta.none "Expected %s but reached end of stream" name

     

       0
        
       
     

       81
        
       

     

       82
        
       (* Error helpers *)

     

       83
        
       

     
···

       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 =

     
···

       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 *)

     
···

       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

     

       0
        
       
     

       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.

     
···

       168
        
         | Rec lazy_t ->

     

       169
        
             (* Handle recursive types *)

     

       170
        
             decode_scalar_as d ev value style (Lazy.force lazy_t)

     

       171
       -
         | _ ->

     

       172
       -
             err_type_mismatch d ev.span t ~fnd:"scalar"

     

       173
        
       

     

       174
        
       (* Forward declaration for mutual recursion *)

     

       175
        
       let rec decode : type a. decoder -> nest:int -> a t -> a =

     

       176
       -
         fun d ~nest t ->

     

       177
        
         check_depth d ~nest;

     

       178
        
         match peek_event d with

     

       179
        
         | None -> Jsont.Error.msgf Jsont.Meta.none "Unexpected end of YAML stream"

     

       180
       -
         | Some ev ->

     

       181
       -
             match ev.Event.event, t with

     

       182
        
             (* Scalar events *)

     

       183
        
             | Event.Scalar { value; style; anchor; _ }, _ ->

     

       184
        
                 skip_event d;

     

       185
        
                 let result = decode_scalar d ~nest ev value style t in

     

       186
        
                 (* Store anchor if present - TODO: implement anchor storage *)

     

       187
        
                 (match anchor with

     

       188
       -
                  | Some _name ->

     

       189
       -
                      (* We need generic JSON for anchors - decode as json and convert back *)

     

       190
       -
                      ()

     

       191
       -
                  | None -> ());

     

       192
        
                 result

     

       193
       -
       

     

       194
        
             (* Alias *)

     

       195
        
             | Event.Alias { anchor }, _ ->

     

       196
        
                 skip_event d;

     

       197
        
                 decode_alias d ev anchor t

     

       198
       -
       

     

       199
        
             (* Map combinator - must come before specific event matches *)

     

       200
       -
             | _, Map m ->

     

       201
       -
                 m.dec (decode d ~nest m.dom)

     

       202
       -
       

     

       203
        
             (* Recursive types - must come before specific event matches *)

     

       204
       -
             | _, Rec lazy_t ->

     

       205
       -
                 decode d ~nest (Lazy.force lazy_t)

     

       206
       -
       

     

       207
        
             (* Sequence -> Array *)

     

       208
       -
             | Event.Sequence_start _, Array map ->

     

       209
       -
                 decode_array d ~nest ev map

     

       210
       -
       

     

       211
       -
             | Event.Sequence_start _, Any map ->

     

       212
       -
                 decode_any_sequence d ~nest ev t map

     

       213
       -
       

     

       214
        
             | Event.Sequence_start _, _ ->

     

       215
        
                 err_type_mismatch d ev.span t ~fnd:"sequence"

     

       216
       -
       

     

       217
        
             (* Mapping -> Object *)

     

       218
       -
             | Event.Mapping_start _, Object map ->

     

       219
       -
                 decode_object d ~nest ev map

     

       220
       -
       

     

       221
       -
             | Event.Mapping_start _, Any map ->

     

       222
       -
                 decode_any_mapping d ~nest ev t map

     

       223
       -
       

     

       224
       -
             | Event.Mapping_start _, _ ->

     

       225
       -
                 err_type_mismatch d ev.span t ~fnd:"mapping"

     

       226
       -
       

     

       227
        
             (* Unexpected events *)

     

       228
        
             | Event.Sequence_end, _ ->

     

       229
        
                 Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected sequence end"

     
···

       236
        
             | Event.Stream_start _, _ ->

     

       237
        
                 Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected stream start"

     

       238
        
             | Event.Stream_end, _ ->

     

       239
       -
                 Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected stream end"

     

       240
        
       

     

       241
       -
       and decode_scalar : type a. decoder -> nest:int -> Event.spanned -> string -> Scalar_style.t -> a t -> a =

     

       242
       -
         fun d ~nest ev value style t ->

     

       0
        
       
     

       0
        
       
     

       243
        
         match t with

     

       244
        
         | Any map -> decode_any_scalar d ev value style t map

     

       245
        
         | Map m -> m.dec (decode_scalar d ~nest ev value style m.dom)

     

       246
        
         | Rec lazy_t -> decode_scalar d ~nest ev value style (Lazy.force lazy_t)

     

       247
        
         | _ -> decode_scalar_as d ev value style t

     

       248
        
       

     

       249
       -
       and decode_any_scalar : type a. decoder -> Event.spanned -> string -> Scalar_style.t -> a t -> a any_map -> a =

     

       250
       -
         fun d ev value style t map ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       251
        
         check_nodes d;

     

       252
        
         (* Determine which decoder to use based on scalar content *)

     

       253
        
         if is_null_scalar value then

     

       254
        
           match map.dec_null with

     

       255
        
           | Some t' -> decode_scalar_as d ev value style t'

     

       256
       -
           | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Null

     

       0
        
       
     

       257
        
         else if style = `Plain then

     

       258
        
           (* Try bool, then number, then string *)

     

       259
        
           match bool_of_scalar_opt value with

     

       260
       -
           | Some _ ->

     

       261
       -
               (match map.dec_bool with

     

       262
       -
                | Some t' -> decode_scalar_as d ev value style t'

     

       263
       -
                | None ->

     

       264
       -
                    match map.dec_string with

     

       265
       -
                    | Some t' -> decode_scalar_as d ev value style t'

     

       266
       -
                    | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Bool)

     

       267
       -
           | None ->

     

       0
        
       
     

       0
        
       
     

       268
        
               match float_of_scalar_opt value with

     

       269
       -
               | Some _ ->

     

       270
       -
                   (match map.dec_number with

     

       271
       -
                    | Some t' -> decode_scalar_as d ev value style t'

     

       272
       -
                    | None ->

     

       273
       -
                        match map.dec_string with

     

       274
       -
                        | Some t' -> decode_scalar_as d ev value style t'

     

       275
       -
                        | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Number)

     

       276
       -
               | None ->

     

       0
        
       
     

       0
        
       
     

       277
        
                   (* Plain scalar that's not bool/number -> string *)

     

       278
        
                   match map.dec_string with

     

       279
        
                   | Some t' -> decode_scalar_as d ev value style t'

     

       280
       -
                   | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.String

     

       0
        
       
     

       0
        
       
     

       281
        
         else

     

       282
        
           (* Quoted scalars are strings *)

     

       283
        
           match map.dec_string with

     

       284
        
           | Some t' -> decode_scalar_as d ev value style t'

     

       285
       -
           | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.String

     

       0
        
       
     

       286
        
       

     

       287
        
       and decode_alias : type a. decoder -> Event.spanned -> string -> a t -> a =

     

       288
       -
         fun d ev anchor t ->

     

       289
        
         check_nodes d;

     

       290
        
         match Hashtbl.find_opt d._anchors anchor with

     

       291
        
         | None ->

     

       292
        
             let meta = meta_of_span d ev.span in

     

       293
        
             Jsont.Error.msgf meta "Unknown anchor: %s" anchor

     

       294
       -
         | Some json ->

     

       295
        
             (* Decode the stored JSON value through the type *)

     

       296
        
             let t' = Jsont.Repr.unsafe_to_t t in

     

       297
        
             match Jsont.Json.decode' t' json with

     

       298
        
             | Ok v -> v

     

       299
       -
             | Error e -> raise (Jsont.Error e)

     

       300
        
       

     

       301
       -
       and decode_array : type a elt b. decoder -> nest:int -> Event.spanned -> (a, elt, b) array_map -> a =

     

       302
       -
         fun d ~nest start_ev map ->

     

       303
       -
         skip_event d; (* consume Sequence_start *)

     

       0
        
       
     

       0
        
       
     

       304
        
         check_nodes d;

     

       305
        
         let meta = meta_of_span d start_ev.span in

     

       306
        
         let builder = ref (map.dec_empty ()) in

     
···

       316
        
               (try

     

       317
        
                  if map.dec_skip i !builder then begin

     

       318
        
                    (* Skip this element by decoding as ignore *)

     

       319
       -
                    let _ : unit = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore) in

     

       0
        
       
     

       0
        
       
     

       320
        
                    ()

     

       321
       -
                  end else begin

     

       0
        
       
     

       322
        
                    let elt = decode d ~nest:(nest + 1) map.elt in

     

       323
        
                    builder := map.dec_add i elt !builder

     

       324
        
                  end

     
···

       327
        
                  Jsont.Repr.error_push_array meta map (i, imeta) e);

     

       328
        
               incr idx;

     

       329
        
               loop ()

     

       330
       -
           | None ->

     

       331
       -
               Jsont.Error.msgf meta "Unclosed sequence"

     

       332
        
         in

     

       333
        
         loop ()

     

       334
        
       

     

       335
       -
       and decode_any_sequence : type a. decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =

     

       336
       -
         fun d ~nest ev t map ->

     

       0
        
       
     

       337
        
         match map.dec_array with

     

       338
       -
         | Some t' ->

     

       339
        
             (* The t' decoder might be wrapped (e.g., Map for option types)

     

       340
        
                Directly decode the array and let the wrapper handle it *)

     

       341
       -
             (match t' with

     

       342
       -
              | Array array_map ->

     

       343
       -
                  decode_array d ~nest ev array_map

     

       344
       -
              | _ ->

     

       345
       -
                  (* For wrapped types like Map (Array ...), use full decode *)

     

       346
       -
                  decode d ~nest t')

     

       347
       -
         | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Array

     

       348
        
       

     

       349
       -
       and decode_object : type o. decoder -> nest:int -> Event.spanned -> (o, o) object_map -> o =

     

       350
       -
         fun d ~nest start_ev map ->

     

       351
       -
         skip_event d; (* consume Mapping_start *)

     

       0
        
       
     

       0
        
       
     

       352
        
         check_nodes d;

     

       353
        
         let meta = meta_of_span d start_ev.span in

     

       354
       -
         let dict = decode_object_members d ~nest meta map String_map.empty Dict.empty in

     

       0
        
       
     

       0
        
       
     

       355
        
         let dict = Dict.add object_meta_arg meta dict in

     

       356
        
         apply_dict map.dec dict

     

       357
        
       

     

       358
        
       and decode_object_members : type o.

     

       359
       -
         decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->

     

       360
       -
         mem_dec String_map.t -> Dict.t -> Dict.t =

     

       361
       -
         fun d ~nest obj_meta map mem_miss dict ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       362
        
         (* Merge expected member decoders *)

     

       363
        
         let u _ _ _ = assert false in

     

       364
        
         let mem_miss = String_map.union u mem_miss map.mem_decs in

     
···

       371
        
             decode_object_cases d ~nest obj_meta map umems cases mem_miss [] dict

     

       372
        
       

     

       373
        
       and decode_object_basic : type o mems builder.

     

       374
       -
         decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->

     

       375
       -
         (o, mems, builder) unknown_mems ->

     

       376
       -
         mem_dec String_map.t -> Dict.t -> Dict.t =

     

       377
       -
         fun d ~nest obj_meta map umems mem_miss dict ->

     

       378
       -
         let ubuilder = ref (match umems with

     

       379
       -
           | Unknown_skip | Unknown_error -> Obj.magic ()

     

       380
       -
           | Unknown_keep (mmap, _) -> mmap.dec_empty ()) in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       381
        
         let mem_miss = ref mem_miss in

     

       382
        
         let dict = ref dict in

     

       383
        
         let rec loop () =

     
···

       391
        
               let name, name_meta = decode_mapping_key d ev in

     

       392
        
               (* Look up member decoder *)

     

       393
        
               (match String_map.find_opt name map.mem_decs with

     

       394
       -
                | Some (Mem_dec mem) ->

     

       395
       -
                    mem_miss := String_map.remove name !mem_miss;

     

       396
       -
                    (try

     

       397
       -
                       let v = decode d ~nest:(nest + 1) mem.type' in

     

       398
       -
                       dict := Dict.add mem.id v !dict

     

       399
       -
                     with Jsont.Error e ->

     

       400
       -
                       Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)

     

       401
       -
                | None ->

     

       402
       -
                    (* Unknown member *)

     

       403
       -
                    match umems with

     

       404
       -
                    | Unknown_skip ->

     

       405
       -
                        let _ : unit = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore) in

     

       406
       -
                        ()

     

       407
       -
                    | Unknown_error ->

     

       408
       -
                        Jsont.Repr.unexpected_mems_error obj_meta map ~fnd:[(name, name_meta)]

     

       409
       -
                    | Unknown_keep (mmap, _) ->

     

       410
       -
                        (try

     

       411
       -
                           let v = decode d ~nest:(nest + 1) mmap.mems_type in

     

       412
       -
                           ubuilder := mmap.dec_add name_meta name v !ubuilder

     

       413
       -
                         with Jsont.Error e ->

     

       414
       -
                           Jsont.Repr.error_push_object obj_meta map (name, name_meta) e));

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       415
        
               loop ()

     

       416
       -
           | None ->

     

       417
       -
               Jsont.Error.msgf obj_meta "Unclosed mapping"

     

       418
        
         in

     

       419
        
         loop ()

     

       420
        
       

     

       421
        
       and finish_object : type o mems builder.

     

       422
       -
         Jsont.Meta.t -> (o, o) object_map -> (o, mems, builder) unknown_mems ->

     

       423
       -
         builder -> mem_dec String_map.t -> Dict.t -> Dict.t =

     

       424
       -
         fun meta map umems ubuilder mem_miss dict ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       425
        
         let dict = Dict.add object_meta_arg meta dict in

     

       426
       -
         let dict = match umems with

     

       0
        
       
     

       427
        
           | Unknown_skip | Unknown_error -> dict

     

       428
       -
           | Unknown_keep (mmap, _) -> Dict.add mmap.id (mmap.dec_finish meta ubuilder) dict

     

       0
        
       
     

       429
        
         in

     

       430
        
         (* Check for missing required members *)

     

       431
        
         let add_default _ (Mem_dec mem_map) dict =

     
···

       440
        
           Jsont.Repr.missing_mems_error meta map ~exp ~fnd:[]

     

       441
        
       

     

       442
        
       and decode_object_cases : type o cases tag.

     

       443
       -
         decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->

     

       444
       -
         unknown_mems_option ->

     

       445
       -
         (o, cases, tag) object_cases ->

     

       446
       -
         mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =

     

       447
       -
         fun d ~nest obj_meta map umems cases mem_miss delayed dict ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       448
        
         match peek_event d with

     

       449
       -
         | Some { Event.event = Event.Mapping_end; _ } ->

     

       450
        
             skip_event d;

     

       451
        
             (* No tag found - use dec_absent if available *)

     

       452
       -
             (match cases.tag.dec_absent with

     

       453
       -
              | Some tag ->

     

       454
       -
                  decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss delayed dict

     

       455
       -
              | None ->

     

       456
       -
                  (* Missing required case tag *)

     

       457
       -
                  let exp = String_map.singleton cases.tag.name (Mem_dec cases.tag) in

     

       458
       -
                  let fnd = List.map (fun ((n, _), _) -> n) delayed in

     

       459
       -
                  Jsont.Repr.missing_mems_error obj_meta map ~exp ~fnd)

     

       0
        
       
     

       460
        
         | Some ev ->

     

       461
        
             let name, name_meta = decode_mapping_key d ev in

     

       462
        
             if String.equal name cases.tag.name then begin

     

       463
        
               (* Found the case tag *)

     

       464
        
               let tag = decode d ~nest:(nest + 1) cases.tag.type' in

     

       465
       -
               decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss delayed dict

     

       466
       -
             end else begin

     

       0
        
       
     

       0
        
       
     

       467
        
               (* Not the case tag - check if known member or delay *)

     

       468
        
               match String_map.find_opt name map.mem_decs with

     

       469
       -
               | Some (Mem_dec mem) ->

     

       470
        
                   let mem_miss = String_map.remove name mem_miss in

     

       471
       -
                   (try

     

       472
       -
                      let v = decode d ~nest:(nest + 1) mem.type' in

     

       473
       -
                      let dict = Dict.add mem.id v dict in

     

       474
       -
                      decode_object_cases d ~nest obj_meta map umems cases mem_miss delayed dict

     

       475
       -
                    with Jsont.Error e ->

     

       476
       -
                      Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)

     

       0
        
       
     

       477
        
               | None ->

     

       478
        
                   (* Unknown member - decode as generic JSON and delay *)

     

       479
        
                   let v = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.json) in

     

       480
        
                   let delayed = ((name, name_meta), v) :: delayed in

     

       481
       -
                   decode_object_cases d ~nest obj_meta map umems cases mem_miss delayed dict

     

       0
        
       
     

       482
        
             end

     

       483
       -
         | None ->

     

       484
       -
             Jsont.Error.msgf obj_meta "Unclosed mapping"

     

       485
        
       

     

       486
        
       and decode_with_case_tag : type o cases tag.

     

       487
       -
         decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->

     

       488
       -
         unknown_mems_option ->

     

       489
       -
         (o, cases, tag) object_cases -> tag ->

     

       490
       -
         mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =

     

       491
       -
         fun d ~nest obj_meta map umems cases tag mem_miss delayed dict ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       492
        
         let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in

     

       493
        
         match List.find_opt eq_tag cases.cases with

     

       494
       -
         | None ->

     

       495
       -
             Jsont.Repr.unexpected_case_tag_error obj_meta map cases tag

     

       496
        
         | Some (Case case) ->

     

       497
        
             (* Continue decoding with the case's object map *)

     

       498
       -
             let case_dict = decode_case_remaining d ~nest obj_meta case.object_map

     

       499
       -
                 umems mem_miss delayed dict in

     

       0
        
       
     

       0
        
       
     

       500
        
             let case_value = apply_dict case.object_map.dec case_dict in

     

       501
        
             Dict.add cases.id (case.dec case_value) dict

     

       502
        
       

     

       503
        
       and decode_case_remaining : type o.

     

       504
       -
         decoder -> nest:int -> Jsont.Meta.t -> (o, o) object_map ->

     

       505
       -
         unknown_mems_option ->

     

       506
       -
         mem_dec String_map.t -> (Jsont.name * Jsont.json) list -> Dict.t -> Dict.t =

     

       507
       -
         fun d ~nest obj_meta case_map _umems mem_miss delayed dict ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       508
        
         (* First, process delayed members against the case map *)

     

       509
        
         let u _ _ _ = assert false in

     

       510
        
         let mem_miss = String_map.union u mem_miss case_map.mem_decs in

     

       511
       -
         let dict, mem_miss = List.fold_left (fun (dict, mem_miss) ((name, meta), json) ->

     

       512
       -
           match String_map.find_opt name case_map.mem_decs with

     

       513
       -
           | Some (Mem_dec mem) ->

     

       514
       -
               let t' = Jsont.Repr.unsafe_to_t mem.type' in

     

       515
       -
               (match Jsont.Json.decode' t' json with

     

       516
       -
                | Ok v ->

     

       517
       -
                    let dict = Dict.add mem.id v dict in

     

       518
       -
                    let mem_miss = String_map.remove name mem_miss in

     

       519
       -
                    (dict, mem_miss)

     

       520
       -
                | Error e ->

     

       521
       -
                    Jsont.Repr.error_push_object obj_meta case_map (name, meta) e)

     

       522
       -
           | None ->

     

       523
       -
               (* Unknown for case too - skip them *)

     

       524
       -
               (dict, mem_miss)

     

       525
       -
         ) (dict, mem_miss) delayed in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       526
        
         (* Then continue reading remaining members using case's own unknown handling *)

     

       527
        
         match case_map.shape with

     

       528
        
         | Object_basic case_umems ->

     
···

       531
        
             (* Nested cases shouldn't happen - use skip for safety *)

     

       532
        
             decode_object_basic d ~nest obj_meta case_map Unknown_skip mem_miss dict

     

       533
        
       

     

       534
       -
       and decode_any_mapping : type a. decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =

     

       535
       -
         fun d ~nest ev t map ->

     

       0
        
       
     

       536
        
         match map.dec_object with

     

       537
        
         | Some t' -> decode d ~nest t'

     

       538
       -
         | None -> Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Object

     

       0
        
       
     

       539
        
       

     

       540
        
       and decode_mapping_key : decoder -> Event.spanned -> string * Jsont.Meta.t =

     

       541
       -
         fun d ev ->

     

       542
        
         match ev.Event.event with

     

       543
        
         | Event.Scalar { value; _ } ->

     

       544
        
             skip_event d;

     
···

       553
        
       let skip_to_content d =

     

       554
        
         let rec loop () =

     

       555
        
           match peek_event d with

     

       556
       -
           | Some { Event.event = Event.Stream_start _; _ } -> skip_event d; loop ()

     

       557
       -
           | Some { Event.event = Event.Document_start _; _ } -> skip_event d; loop ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       558
        
           | _ -> ()

     

       559
        
         in

     

       560
        
         loop ()

     
···

       562
        
       let skip_end_wrappers d =

     

       563
        
         let rec loop () =

     

       564
        
           match peek_event d with

     

       565
       -
           | Some { Event.event = Event.Document_end _; _ } -> skip_event d; loop ()

     

       566
       -
           | Some { Event.event = Event.Stream_end; _ } -> skip_event d; loop ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       567
        
           | None -> ()

     

       568
        
           | Some ev ->

     

       569
        
               let meta = meta_of_span d ev.span in

     

       570
       -
               Jsont.Error.msgf meta "Expected end of document but found %a" Event.pp ev.event

     

       0
        
       
     

       571
        
         in

     

       572
        
         loop ()

     

       573
        
       

     
···

       608
        
         scalar_style : Scalar_style.t;

     

       609
        
       }

     

       610
        
       

     

       611
       -
       let make_encoder

     

       612
       -
           ?(format = Block) ?(indent = 2) ?(explicit_doc = false)

     

       613
        
           ?(scalar_style = `Any) emitter =

     

       614
        
         { emitter; format; _indent = indent; explicit_doc; scalar_style }

     

       615
        
       

     
···

       627
        
       

     

       628
        
       (* Encode null *)

     

       629
        
       let encode_null e _meta =

     

       630
       -
         Emitter.emit e.emitter (Event.Scalar {

     

       631
       -
           anchor = None;

     

       632
       -
           tag = None;

     

       633
       -
           value = "null";

     

       634
       -
           plain_implicit = true;

     

       635
       -
           quoted_implicit = true;

     

       636
       -
           style = `Plain;

     

       637
       -
         })

     

       0
        
       
     

       0
        
       
     

       638
        
       

     

       639
        
       (* Encode boolean *)

     

       640
        
       let encode_bool e _meta b =

     

       641
       -
         Emitter.emit e.emitter (Event.Scalar {

     

       642
       -
           anchor = None;

     

       643
       -
           tag = None;

     

       644
       -
           value = if b then "true" else "false";

     

       645
       -
           plain_implicit = true;

     

       646
       -
           quoted_implicit = true;

     

       647
       -
           style = `Plain;

     

       648
       -
         })

     

       0
        
       
     

       0
        
       
     

       649
        
       

     

       650
        
       (* Encode number *)

     

       651
        
       let encode_number e _meta f =

     
···

       654
        
           | FP_nan -> ".nan"

     

       655
        
           | FP_infinite -> if f > 0.0 then ".inf" else "-.inf"

     

       656
        
           | _ ->

     

       657
       -
               if Float.is_integer f && Float.abs f < 1e15 then

     

       658
       -
                 Printf.sprintf "%.0f" f

     

       659
       -
               else

     

       660
       -
                 Printf.sprintf "%g" f

     

       661
        
         in

     

       662
       -
         Emitter.emit e.emitter (Event.Scalar {

     

       663
       -
           anchor = None;

     

       664
       -
           tag = None;

     

       665
       -
           value;

     

       666
       -
           plain_implicit = true;

     

       667
       -
           quoted_implicit = true;

     

       668
       -
           style = `Plain;

     

       669
       -
         })

     

       0
        
       
     

       0
        
       
     

       670
        
       

     

       671
        
       (* Encode string *)

     

       672
        
       let encode_string e _meta s =

     

       673
        
         let style = choose_scalar_style ~preferred:e.scalar_style s in

     

       674
       -
         Emitter.emit e.emitter (Event.Scalar {

     

       675
       -
           anchor = None;

     

       676
       -
           tag = None;

     

       677
       -
           value = s;

     

       678
       -
           plain_implicit = true;

     

       679
       -
           quoted_implicit = true;

     

       680
       -
           style;

     

       681
       -
         })

     

       0
        
       
     

       0
        
       
     

       682
        
       

     

       683
        
       let rec encode : type a. encoder -> a t -> a -> unit =

     

       684
       -
         fun e t v ->

     

       685
        
         match t with

     

       686
        
         | Null map ->

     

       687
        
             let meta = map.enc_meta v in

     

       688
        
             let () = map.enc v in

     

       689
        
             encode_null e meta

     

       690
       -
       

     

       691
        
         | Bool map ->

     

       692
        
             let meta = map.enc_meta v in

     

       693
        
             let b = map.enc v in

     

       694
        
             encode_bool e meta b

     

       695
       -
       

     

       696
        
         | Number map ->

     

       697
        
             let meta = map.enc_meta v in

     

       698
        
             let f = map.enc v in

     

       699
        
             encode_number e meta f

     

       700
       -
       

     

       701
        
         | String map ->

     

       702
        
             let meta = map.enc_meta v in

     

       703
        
             let s = map.enc v in

     

       704
        
             encode_string e meta s

     

       705
       -
       

     

       706
       -
         | Array map ->

     

       707
       -
             encode_array e map v

     

       708
       -
       

     

       709
       -
         | Object map ->

     

       710
       -
             encode_object e map v

     

       711
       -
       

     

       712
        
         | Any map ->

     

       713
        
             let t' = map.enc v in

     

       714
        
             encode e t' v

     

       715
       -
       

     

       716
       -
         | Map m ->

     

       717
       -
             encode e m.dom (m.enc v)

     

       718
       -
       

     

       719
       -
         | Rec lazy_t ->

     

       720
       -
             encode e (Lazy.force lazy_t) v

     

       721
        
       

     

       722
        
       and encode_array : type a elt b. encoder -> (a, elt, b) array_map -> a -> unit =

     

       723
       -
         fun e map v ->

     

       724
        
         let style = layout_style_of_format e.format in

     

       725
       -
         Emitter.emit e.emitter (Event.Sequence_start {

     

       726
       -
           anchor = None;

     

       727
       -
           tag = None;

     

       728
       -
           implicit = true;

     

       729
       -
           style;

     

       730
       -
         });

     

       731
       -
         let _ = map.enc (fun () _idx elt ->

     

       732
       -
           encode e map.elt elt;

     

       733
       -
           ()

     

       734
       -
         ) () v in

     

       735
        
         Emitter.emit e.emitter Event.Sequence_end

     

       736
        
       

     

       737
        
       and encode_object : type o. encoder -> (o, o) object_map -> o -> unit =

     

       738
       -
         fun e map v ->

     

       739
        
         let style = layout_style_of_format e.format in

     

       740
       -
         Emitter.emit e.emitter (Event.Mapping_start {

     

       741
       -
           anchor = None;

     

       742
       -
           tag = None;

     

       743
       -
           implicit = true;

     

       744
       -
           style;

     

       745
       -
         });

     

       746
        
         (* Encode each member *)

     

       747
       -
         List.iter (fun (Mem_enc mem) ->

     

       748
       -
           let mem_v = mem.enc v in

     

       749
       -
           if not (mem.enc_omit mem_v) then begin

     

       750
       -
             (* Emit key *)

     

       751
       -
             Emitter.emit e.emitter (Event.Scalar {

     

       752
       -
               anchor = None;

     

       753
       -
               tag = None;

     

       754
       -
               value = mem.name;

     

       755
       -
               plain_implicit = true;

     

       756
       -
               quoted_implicit = true;

     

       757
       -
               style = `Plain;

     

       758
       -
             });

     

       759
       -
             (* Emit value *)

     

       760
       -
             encode e mem.type' mem_v

     

       761
       -
           end

     

       762
       -
         ) map.mem_encs;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       763
        
         (* Handle case objects *)

     

       764
        
         (match map.shape with

     

       765
       -
          | Object_basic _ -> ()

     

       766
       -
          | Object_cases (_, cases) ->

     

       767
       -
              let Case_value (case_map, case_v) = cases.enc_case (cases.enc v) in

     

       768
       -
              (* Emit case tag *)

     

       769
       -
              if not (cases.tag.enc_omit (case_map.tag)) then begin

     

       770
       -
                Emitter.emit e.emitter (Event.Scalar {

     

       771
       -
                  anchor = None;

     

       772
       -
                  tag = None;

     

       773
       -
                  value = cases.tag.name;

     

       774
       -
                  plain_implicit = true;

     

       775
       -
                  quoted_implicit = true;

     

       776
       -
                  style = `Plain;

     

       777
       -
                });

     

       778
       -
                encode e cases.tag.type' case_map.tag

     

       779
       -
              end;

     

       780
       -
              (* Emit case members *)

     

       781
       -
              List.iter (fun (Mem_enc mem) ->

     

       782
       -
                let mem_v = mem.enc case_v in

     

       783
       -
                if not (mem.enc_omit mem_v) then begin

     

       784
       -
                  Emitter.emit e.emitter (Event.Scalar {

     

       785
       -
                    anchor = None;

     

       786
       -
                    tag = None;

     

       787
       -
                    value = mem.name;

     

       788
       -
                    plain_implicit = true;

     

       789
       -
                    quoted_implicit = true;

     

       790
       -
                    style = `Plain;

     

       791
       -
                  });

     

       792
       -
                  encode e mem.type' mem_v

     

       793
       -
                end

     

       794
       -
              ) case_map.object_map.mem_encs);

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       795
        
         Emitter.emit e.emitter Event.Mapping_end

     

       796
        
       

     

       797
        
       (* Public encode API *)

     

       798
        
       

     

       799
        
       let encode' ?buf:_ ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer =

     

       800
       -
         let config = {

     

       801
       -
           Emitter.default_config with

     

       802
       -
           indent = Option.value ~default:2 indent;

     

       803
       -
           layout_style = (match format with

     

       804
       -
             | Some Flow -> `Flow

     

       805
       -
             | _ -> `Block);

     

       806
       -
         } in

     

       807
        
         let emitter = Emitter.of_writer ~config writer in

     

       808
        
         let e = make_encoder ?format ?indent ?explicit_doc ?scalar_style emitter in

     

       809
        
         try

     

       810
        
           Emitter.emit e.emitter (Event.Stream_start { encoding = `Utf8 });

     

       811
       -
           Emitter.emit e.emitter (Event.Document_start {

     

       812
       -
             version = None;

     

       813
       -
             implicit = not e.explicit_doc;

     

       814
       -
           });

     

       815
        
           let t' = Jsont.Repr.of_t t in

     

       816
        
           encode e t' v;

     

       817
       -
           Emitter.emit e.emitter (Event.Document_end { implicit = not e.explicit_doc });

     

       0
        
       
     

       818
        
           Emitter.emit e.emitter Event.Stream_end;

     

       819
        
           if eod then Emitter.flush e.emitter;

     

       820
        
           Ok ()

     
···

       831
        
       let encode_string' ?buf ?format ?indent ?explicit_doc ?scalar_style t v =

     

       832
        
         let b = Buffer.create 256 in

     

       833
        
         let writer = Bytes.Writer.of_buffer b in

     

       834
       -
         match encode' ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod:true writer with

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       835
        
         | Ok () -> Ok (Buffer.contents b)

     

       836
        
         | Error e -> Error e

     

       837
        
       

     
···

       841
        
       

     

       842
        
       (* Recode *)

     

       843
        
       

     

       844
       -
       let recode ?layout ?locs ?file ?max_depth ?max_nodes

     

       845
       -
           ?buf ?format ?indent ?explicit_doc ?scalar_style t reader writer ~eod =

     

       846
       -
         let format = match layout, format with

     

       847
       -
           | Some true, None -> Some Layout

     

       848
       -
           | _, f -> f

     

       849
        
         in

     

       850
       -
         let layout = match layout, format with

     

       851
       -
           | None, Some Layout -> Some true

     

       852
       -
           | l, _ -> l

     

       853
        
         in

     

       854
        
         match decode' ?layout ?locs ?file ?max_depth ?max_nodes t reader with

     

       855
       -
         | Ok v -> encode ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer

     

       0
        
       
     

       856
        
         | Error e -> Error (Jsont.Error.to_string e)

     

       857
        
       

     

       858
       -
       let recode_string ?layout ?locs ?file ?max_depth ?max_nodes

     

       859
       -
           ?buf ?format ?indent ?explicit_doc ?scalar_style t s =

     

       860
       -
         let format = match layout, format with

     

       861
       -
           | Some true, None -> Some Layout

     

       862
       -
           | _, f -> f

     

       863
        
         in

     

       864
       -
         let layout = match layout, format with

     

       865
       -
           | None, Some Layout -> Some true

     

       866
       -
           | l, _ -> l

     

       867
        
         in

     

       868
        
         match decode_string' ?layout ?locs ?file ?max_depth ?max_nodes t s with

     

       869
        
         | Ok v -> encode_string ?buf ?format ?indent ?explicit_doc ?scalar_style t v

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       open Bytesrw

     

       7
        
       open Jsont.Repr

     
···

       26
        
         meta_none : Jsont.Meta.t;

     

       27
        
       }

     

       28
        
       

     

       29
       +
       let make_decoder ?(locs = false) ?(layout = false) ?(file = "-")

     

       0
        
       
     

       30
        
           ?(max_depth = 100) ?(max_nodes = 10_000_000) parser =

     

       31
        
         let meta_none = Jsont.Meta.make (Jsont.Textloc.(set_file none) file) in

     

       32
       +
         {

     

       33
       +
           parser;

     

       34
       +
           file;

     

       35
       +
           locs;

     

       36
       +
           _layout = layout;

     

       37
       +
           max_depth;

     

       38
       +
           max_nodes;

     

       39
       +
           node_count = 0;

     

       40
       +
           current = None;

     

       41
       +
           _anchors = Hashtbl.create 16;

     

       42
       +
           meta_none;

     

       43
       +
         }

     

       44
        
       

     

       45
        
       (* Decoder helpers *)

     

       46
        
       

     

       47
        
       let check_depth d ~nest =

     

       48
        
         if nest > d.max_depth then

     

       49
       +
           Jsont.Error.msgf Jsont.Meta.none "Maximum nesting depth %d exceeded"

     

       50
       +
             d.max_depth

     

       51
        
       

     

       52
        
       let check_nodes d =

     

       53
        
         d.node_count <- d.node_count + 1;

     

       54
        
         if d.node_count > d.max_nodes then

     

       55
       +
           Jsont.Error.msgf Jsont.Meta.none "Maximum node count %d exceeded"

     

       56
       +
             d.max_nodes

     

       57
        
       

     

       58
        
       let meta_of_span d span =

     

       59
       +
         if not d.locs then d.meta_none

     

       60
       +
         else

     

       61
       +
           let start = span.Span.start and stop = span.Span.stop in

     

       62
       +
           let first_byte = start.Position.index in

     

       63
       +
           let last_byte = max first_byte (stop.Position.index - 1) in

     

       64
       +
           (* line_pos is (line_number, byte_position_of_line_start) *)

     

       65
       +
           let first_line =

     

       66
       +
             (start.Position.line, start.Position.index - start.Position.column + 1)

     

       67
       +
           in

     

       68
       +
           let last_line =

     

       69
       +
             (stop.Position.line, stop.Position.index - stop.Position.column + 1)

     

       70
       +
           in

     

       71
       +
           let textloc =

     

       72
       +
             Jsont.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line

     

       73
       +
               ~last_line

     

       74
       +
           in

     

       75
       +
           Jsont.Meta.make textloc

     

       76
        
       

     

       77
        
       let next_event d =

     

       78
        
         d.current <- Parser.next d.parser;

     

       79
        
         d.current

     

       80
        
       

     

       81
        
       let peek_event d =

     

       82
       +
         match d.current with Some _ -> d.current | None -> next_event d

     

       0
        
       
     

       0
        
       
     

       83
        
       

     

       84
       +
       let skip_event d = d.current <- None

     

       0
        
       
     

       85
        
       

     

       86
        
       let _expect_event d pred name =

     

       87
        
         match peek_event d with

     

       88
       +
         | Some ev when pred ev.Event.event ->

     

       89
       +
             skip_event d;

     

       90
       +
             ev

     

       91
        
         | Some ev ->

     

       92
        
             let span = ev.Event.span in

     

       93
        
             let meta = meta_of_span d span in

     

       94
       +
             Jsont.Error.msgf meta "Expected %s but found %a" name Event.pp

     

       95
       +
               ev.Event.event

     

       96
        
         | None ->

     

       97
       +
             Jsont.Error.msgf Jsont.Meta.none "Expected %s but reached end of stream"

     

       98
       +
               name

     

       99
        
       

     

       100
        
       (* Error helpers *)

     

       101
        
       

     
···

       105
        
       

     

       106
        
       let err_type_mismatch d span t ~fnd =

     

       107
        
         let meta = meta_of_span d span in

     

       108
       +
         Jsont.Error.msgf meta "Expected %s but found %s" (Jsont.Repr.kinded_sort t)

     

       109
       +
           fnd

     

       110
        
       

     

       111
        
       (* YAML scalar resolution *)

     

       112
        
       

     

       113
        
       let is_null_scalar s =

     

       114
       +
         s = "" || s = "~" || s = "null" || s = "Null" || s = "NULL"

     

       0
        
       
     

       115
        
       

     

       116
        
       let bool_of_scalar_opt s =

     

       117
        
         match s with

     

       118
       +
         | "true" | "True" | "TRUE" | "yes" | "Yes" | "YES" | "on" | "On" | "ON" ->

     

       119
       +
             Some true

     

       120
       +
         | "false" | "False" | "FALSE" | "no" | "No" | "NO" | "off" | "Off" | "OFF" ->

     

       121
       +
             Some false

     

       0
        
       
     

       0
        
       
     

       122
        
         | _ -> None

     

       123
        
       

     

       124
        
       let float_of_scalar_opt s =

     
···

       128
        
         | "+.inf" | "+.Inf" | "+.INF" -> Some Float.infinity

     

       129
        
         | "-.inf" | "-.Inf" | "-.INF" -> Some Float.neg_infinity

     

       130
        
         | ".nan" | ".NaN" | ".NAN" -> Some Float.nan

     

       131
       +
         | _ -> (

     

       132
        
             (* Try parsing as number, allowing underscores *)

     

       133
        
             let s' = String.concat "" (String.split_on_char '_' s) in

     

       134
        
             (* Try int first (supports 0o, 0x, 0b) then float *)

     

       135
        
             match int_of_string_opt s' with

     

       136
        
             | Some i -> Some (float_of_int i)

     

       137
       +
             | None -> float_of_string_opt s')

     

       138
        
       

     

       139
        
       let _int_of_scalar_opt s =

     

       140
        
         (* Handle hex, octal, and regular integers with underscores *)

     
···

       142
        
         int_of_string_opt s'

     

       143
        
       

     

       144
        
       (* Decode a scalar value according to expected type *)

     

       145
       +
       let rec decode_scalar_as : type a.

     

       146
       +
           decoder -> Event.spanned -> string -> Scalar_style.t -> a t -> a =

     

       147
       +
        fun d ev value style t ->

     

       148
        
         check_nodes d;

     

       149
        
         let meta = meta_of_span d ev.Event.span in

     

       150
        
         match t with

     

       151
        
         | Null map ->

     

       152
        
             if is_null_scalar value then map.dec meta ()

     

       153
        
             else err_type_mismatch d ev.span t ~fnd:("scalar " ^ value)

     

       154
       +
         | Bool map -> (

     

       155
       +
             match bool_of_scalar_opt value with

     

       156
       +
             | Some b -> map.dec meta b

     

       157
       +
             | None ->

     

       158
       +
                 (* For explicitly quoted strings, fail *)

     

       159
       +
                 if style <> `Plain then

     

       160
       +
                   err_type_mismatch d ev.span t ~fnd:("string " ^ value)

     

       161
       +
                 else err_type_mismatch d ev.span t ~fnd:("scalar " ^ value))

     

       162
       +
         | Number map -> (

     

       163
       +
             if

     

       164
       +
               (* Handle null -> nan mapping like jsont *)

     

       165
       +
               is_null_scalar value

     

       166
       +
             then map.dec meta Float.nan

     

       167
        
             else

     

       168
       +
               match float_of_scalar_opt value with

     

       169
       +
               | Some f -> map.dec meta f

     

       170
       +
               | None -> err_type_mismatch d ev.span t ~fnd:("scalar " ^ value))

     

       171
        
         | String map ->

     

       172
        
             (* Don't decode null values as strings - they should fail so outer combinators

     

       173
        
                like 'option' or 'any' can handle them properly.

     
···

       184
        
         | Rec lazy_t ->

     

       185
        
             (* Handle recursive types *)

     

       186
        
             decode_scalar_as d ev value style (Lazy.force lazy_t)

     

       187
       +
         | _ -> err_type_mismatch d ev.span t ~fnd:"scalar"

     

       0
        
       
     

       188
        
       

     

       189
        
       (* Forward declaration for mutual recursion *)

     

       190
        
       let rec decode : type a. decoder -> nest:int -> a t -> a =

     

       191
       +
        fun d ~nest t ->

     

       192
        
         check_depth d ~nest;

     

       193
        
         match peek_event d with

     

       194
        
         | None -> Jsont.Error.msgf Jsont.Meta.none "Unexpected end of YAML stream"

     

       195
       +
         | Some ev -> (

     

       196
       +
             match (ev.Event.event, t) with

     

       197
        
             (* Scalar events *)

     

       198
        
             | Event.Scalar { value; style; anchor; _ }, _ ->

     

       199
        
                 skip_event d;

     

       200
        
                 let result = decode_scalar d ~nest ev value style t in

     

       201
        
                 (* Store anchor if present - TODO: implement anchor storage *)

     

       202
        
                 (match anchor with

     

       203
       +
                 | Some _name ->

     

       204
       +
                     (* We need generic JSON for anchors - decode as json and convert back *)

     

       205
       +
                     ()

     

       206
       +
                 | None -> ());

     

       207
        
                 result

     

       0
        
       
     

       208
        
             (* Alias *)

     

       209
        
             | Event.Alias { anchor }, _ ->

     

       210
        
                 skip_event d;

     

       211
        
                 decode_alias d ev anchor t

     

       0
        
       
     

       212
        
             (* Map combinator - must come before specific event matches *)

     

       213
       +
             | _, Map m -> m.dec (decode d ~nest m.dom)

     

       0
        
       
     

       0
        
       
     

       214
        
             (* Recursive types - must come before specific event matches *)

     

       215
       +
             | _, Rec lazy_t -> decode d ~nest (Lazy.force lazy_t)

     

       0
        
       
     

       0
        
       
     

       216
        
             (* Sequence -> Array *)

     

       217
       +
             | Event.Sequence_start _, Array map -> decode_array d ~nest ev map

     

       218
       +
             | Event.Sequence_start _, Any map -> decode_any_sequence d ~nest ev t map

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       219
        
             | Event.Sequence_start _, _ ->

     

       220
        
                 err_type_mismatch d ev.span t ~fnd:"sequence"

     

       0
        
       
     

       221
        
             (* Mapping -> Object *)

     

       222
       +
             | Event.Mapping_start _, Object map -> decode_object d ~nest ev map

     

       223
       +
             | Event.Mapping_start _, Any map -> decode_any_mapping d ~nest ev t map

     

       224
       +
             | Event.Mapping_start _, _ -> err_type_mismatch d ev.span t ~fnd:"mapping"

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       225
        
             (* Unexpected events *)

     

       226
        
             | Event.Sequence_end, _ ->

     

       227
        
                 Jsont.Error.msgf (meta_of_span d ev.span) "Unexpected sequence 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.

     

       240
       +
           decoder -> nest:int -> Event.spanned -> string -> Scalar_style.t -> a t -> a

     

       241
       +
           =

     

       242
       +
        fun d ~nest ev value style t ->

     

       243
        
         match t with

     

       244
        
         | Any map -> decode_any_scalar d ev value style t map

     

       245
        
         | Map m -> m.dec (decode_scalar d ~nest ev value style m.dom)

     

       246
        
         | Rec lazy_t -> decode_scalar d ~nest ev value style (Lazy.force lazy_t)

     

       247
        
         | _ -> decode_scalar_as d ev value style t

     

       248
        
       

     

       249
       +
       and decode_any_scalar : type a.

     

       250
       +
           decoder ->

     

       251
       +
           Event.spanned ->

     

       252
       +
           string ->

     

       253
       +
           Scalar_style.t ->

     

       254
       +
           a t ->

     

       255
       +
           a any_map ->

     

       256
       +
           a =

     

       257
       +
        fun d ev value style t map ->

     

       258
        
         check_nodes d;

     

       259
        
         (* Determine which decoder to use based on scalar content *)

     

       260
        
         if is_null_scalar value then

     

       261
        
           match map.dec_null with

     

       262
        
           | Some t' -> decode_scalar_as d ev value style t'

     

       263
       +
           | None ->

     

       264
       +
               Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Null

     

       265
        
         else if style = `Plain then

     

       266
        
           (* Try bool, then number, then string *)

     

       267
        
           match bool_of_scalar_opt value with

     

       268
       +
           | Some _ -> (

     

       269
       +
               match map.dec_bool with

     

       270
       +
               | Some t' -> decode_scalar_as d ev value style t'

     

       271
       +
               | None -> (

     

       272
       +
                   match map.dec_string with

     

       273
       +
                   | Some t' -> decode_scalar_as d ev value style t'

     

       274
       +
                   | None ->

     

       275
       +
                       Jsont.Repr.type_error (meta_of_span d ev.span) t

     

       276
       +
                         ~fnd:Jsont.Sort.Bool))

     

       277
       +
           | None -> (

     

       278
        
               match float_of_scalar_opt value with

     

       279
       +
               | Some _ -> (

     

       280
       +
                   match map.dec_number with

     

       281
       +
                   | Some t' -> decode_scalar_as d ev value style t'

     

       282
       +
                   | None -> (

     

       283
       +
                       match map.dec_string with

     

       284
       +
                       | Some t' -> decode_scalar_as d ev value style t'

     

       285
       +
                       | None ->

     

       286
       +
                           Jsont.Repr.type_error (meta_of_span d ev.span) t

     

       287
       +
                             ~fnd:Jsont.Sort.Number))

     

       288
       +
               | None -> (

     

       289
        
                   (* Plain scalar that's not bool/number -> string *)

     

       290
        
                   match map.dec_string with

     

       291
        
                   | Some t' -> decode_scalar_as d ev value style t'

     

       292
       +
                   | None ->

     

       293
       +
                       Jsont.Repr.type_error (meta_of_span d ev.span) t

     

       294
       +
                         ~fnd:Jsont.Sort.String))

     

       295
        
         else

     

       296
        
           (* Quoted scalars are strings *)

     

       297
        
           match map.dec_string with

     

       298
        
           | Some t' -> decode_scalar_as d ev value style t'

     

       299
       +
           | None ->

     

       300
       +
               Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.String

     

       301
        
       

     

       302
        
       and decode_alias : type a. decoder -> Event.spanned -> string -> a t -> a =

     

       303
       +
        fun d ev anchor t ->

     

       304
        
         check_nodes d;

     

       305
        
         match Hashtbl.find_opt d._anchors anchor with

     

       306
        
         | None ->

     

       307
        
             let meta = meta_of_span d ev.span in

     

       308
        
             Jsont.Error.msgf meta "Unknown anchor: %s" anchor

     

       309
       +
         | Some json -> (

     

       310
        
             (* Decode the stored JSON value through the type *)

     

       311
        
             let t' = Jsont.Repr.unsafe_to_t t in

     

       312
        
             match Jsont.Json.decode' t' json with

     

       313
        
             | Ok v -> v

     

       314
       +
             | Error e -> raise (Jsont.Error e))

     

       315
        
       

     

       316
       +
       and decode_array : type a elt b.

     

       317
       +
           decoder -> nest:int -> Event.spanned -> (a, elt, b) array_map -> a =

     

       318
       +
        fun d ~nest start_ev map ->

     

       319
       +
         skip_event d;

     

       320
       +
         (* consume Sequence_start *)

     

       321
        
         check_nodes d;

     

       322
        
         let meta = meta_of_span d start_ev.span in

     

       323
        
         let builder = ref (map.dec_empty ()) in

     
···

       333
        
               (try

     

       334
        
                  if map.dec_skip i !builder then begin

     

       335
        
                    (* Skip this element by decoding as ignore *)

     

       336
       +
                    let _ : unit =

     

       337
       +
                      decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore)

     

       338
       +
                    in

     

       339
        
                    ()

     

       340
       +
                  end

     

       341
       +
                  else begin

     

       342
        
                    let elt = decode d ~nest:(nest + 1) map.elt in

     

       343
        
                    builder := map.dec_add i elt !builder

     

       344
        
                  end

     
···

       347
        
                  Jsont.Repr.error_push_array meta map (i, imeta) e);

     

       348
        
               incr idx;

     

       349
        
               loop ()

     

       350
       +
           | None -> Jsont.Error.msgf meta "Unclosed sequence"

     

       0
        
       
     

       351
        
         in

     

       352
        
         loop ()

     

       353
        
       

     

       354
       +
       and decode_any_sequence : type a.

     

       355
       +
           decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =

     

       356
       +
        fun d ~nest ev t map ->

     

       357
        
         match map.dec_array with

     

       358
       +
         | Some t' -> (

     

       359
        
             (* The t' decoder might be wrapped (e.g., Map for option types)

     

       360
        
                Directly decode the array and let the wrapper handle it *)

     

       361
       +
             match t' with

     

       362
       +
             | Array array_map -> decode_array d ~nest ev array_map

     

       363
       +
             | _ ->

     

       364
       +
                 (* For wrapped types like Map (Array ...), use full decode *)

     

       365
       +
                 decode d ~nest t')

     

       366
       +
         | None ->

     

       367
       +
             Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Array

     

       368
        
       

     

       369
       +
       and decode_object : type o.

     

       370
       +
           decoder -> nest:int -> Event.spanned -> (o, o) object_map -> o =

     

       371
       +
        fun d ~nest start_ev map ->

     

       372
       +
         skip_event d;

     

       373
       +
         (* consume Mapping_start *)

     

       374
        
         check_nodes d;

     

       375
        
         let meta = meta_of_span d start_ev.span in

     

       376
       +
         let dict =

     

       377
       +
           decode_object_members d ~nest meta map String_map.empty Dict.empty

     

       378
       +
         in

     

       379
        
         let dict = Dict.add object_meta_arg meta dict in

     

       380
        
         apply_dict map.dec dict

     

       381
        
       

     

       382
        
       and decode_object_members : type o.

     

       383
       +
           decoder ->

     

       384
       +
           nest:int ->

     

       385
       +
           Jsont.Meta.t ->

     

       386
       +
           (o, o) object_map ->

     

       387
       +
           mem_dec String_map.t ->

     

       388
       +
           Dict.t ->

     

       389
       +
           Dict.t =

     

       390
       +
        fun d ~nest obj_meta map mem_miss dict ->

     

       391
        
         (* Merge expected member decoders *)

     

       392
        
         let u _ _ _ = assert false in

     

       393
        
         let mem_miss = String_map.union u mem_miss map.mem_decs in

     
···

       400
        
             decode_object_cases d ~nest obj_meta map umems cases mem_miss [] dict

     

       401
        
       

     

       402
        
       and decode_object_basic : type o mems builder.

     

       403
       +
           decoder ->

     

       404
       +
           nest:int ->

     

       405
       +
           Jsont.Meta.t ->

     

       406
       +
           (o, o) object_map ->

     

       407
       +
           (o, mems, builder) unknown_mems ->

     

       408
       +
           mem_dec String_map.t ->

     

       409
       +
           Dict.t ->

     

       410
       +
           Dict.t =

     

       411
       +
        fun d ~nest obj_meta map umems mem_miss dict ->

     

       412
       +
         let ubuilder =

     

       413
       +
           ref

     

       414
       +
             (match umems with

     

       415
       +
             | Unknown_skip | Unknown_error -> Obj.magic ()

     

       416
       +
             | Unknown_keep (mmap, _) -> mmap.dec_empty ())

     

       417
       +
         in

     

       418
        
         let mem_miss = ref mem_miss in

     

       419
        
         let dict = ref dict in

     

       420
        
         let rec loop () =

     
···

       428
        
               let name, name_meta = decode_mapping_key d ev in

     

       429
        
               (* Look up member decoder *)

     

       430
        
               (match String_map.find_opt name map.mem_decs with

     

       431
       +
               | Some (Mem_dec mem) -> (

     

       432
       +
                   mem_miss := String_map.remove name !mem_miss;

     

       433
       +
                   try

     

       434
       +
                     let v = decode d ~nest:(nest + 1) mem.type' in

     

       435
       +
                     dict := Dict.add mem.id v !dict

     

       436
       +
                   with Jsont.Error e ->

     

       437
       +
                     Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)

     

       438
       +
               | None -> (

     

       439
       +
                   (* Unknown member *)

     

       440
       +
                   match umems with

     

       441
       +
                   | Unknown_skip ->

     

       442
       +
                       let _ : unit =

     

       443
       +
                         decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.ignore)

     

       444
       +
                       in

     

       445
       +
                       ()

     

       446
       +
                   | Unknown_error ->

     

       447
       +
                       Jsont.Repr.unexpected_mems_error obj_meta map

     

       448
       +
                         ~fnd:[ (name, name_meta) ]

     

       449
       +
                   | Unknown_keep (mmap, _) -> (

     

       450
       +
                       try

     

       451
       +
                         let v = decode d ~nest:(nest + 1) mmap.mems_type in

     

       452
       +
                         ubuilder := mmap.dec_add name_meta name v !ubuilder

     

       453
       +
                       with Jsont.Error e ->

     

       454
       +
                         Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)

     

       455
       +
                   ));

     

       456
        
               loop ()

     

       457
       +
           | None -> Jsont.Error.msgf obj_meta "Unclosed mapping"

     

       0
        
       
     

       458
        
         in

     

       459
        
         loop ()

     

       460
        
       

     

       461
        
       and finish_object : type o mems builder.

     

       462
       +
           Jsont.Meta.t ->

     

       463
       +
           (o, o) object_map ->

     

       464
       +
           (o, mems, builder) unknown_mems ->

     

       465
       +
           builder ->

     

       466
       +
           mem_dec String_map.t ->

     

       467
       +
           Dict.t ->

     

       468
       +
           Dict.t =

     

       469
       +
        fun meta map umems ubuilder mem_miss dict ->

     

       470
        
         let dict = Dict.add object_meta_arg meta dict in

     

       471
       +
         let dict =

     

       472
       +
           match umems with

     

       473
        
           | Unknown_skip | Unknown_error -> dict

     

       474
       +
           | Unknown_keep (mmap, _) ->

     

       475
       +
               Dict.add mmap.id (mmap.dec_finish meta ubuilder) dict

     

       476
        
         in

     

       477
        
         (* Check for missing required members *)

     

       478
        
         let add_default _ (Mem_dec mem_map) dict =

     
···

       487
        
           Jsont.Repr.missing_mems_error meta map ~exp ~fnd:[]

     

       488
        
       

     

       489
        
       and decode_object_cases : type o cases tag.

     

       490
       +
           decoder ->

     

       491
       +
           nest:int ->

     

       492
       +
           Jsont.Meta.t ->

     

       493
       +
           (o, o) object_map ->

     

       494
       +
           unknown_mems_option ->

     

       495
       +
           (o, cases, tag) object_cases ->

     

       496
       +
           mem_dec String_map.t ->

     

       497
       +
           (Jsont.name * Jsont.json) list ->

     

       498
       +
           Dict.t ->

     

       499
       +
           Dict.t =

     

       500
       +
        fun d ~nest obj_meta map umems cases mem_miss delayed dict ->

     

       501
        
         match peek_event d with

     

       502
       +
         | Some { Event.event = Event.Mapping_end; _ } -> (

     

       503
        
             skip_event d;

     

       504
        
             (* No tag found - use dec_absent if available *)

     

       505
       +
             match cases.tag.dec_absent with

     

       506
       +
             | Some tag ->

     

       507
       +
                 decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss

     

       508
       +
                   delayed dict

     

       509
       +
             | None ->

     

       510
       +
                 (* Missing required case tag *)

     

       511
       +
                 let exp = String_map.singleton cases.tag.name (Mem_dec cases.tag) in

     

       512
       +
                 let fnd = List.map (fun ((n, _), _) -> n) delayed in

     

       513
       +
                 Jsont.Repr.missing_mems_error obj_meta map ~exp ~fnd)

     

       514
        
         | Some ev ->

     

       515
        
             let name, name_meta = decode_mapping_key d ev in

     

       516
        
             if String.equal name cases.tag.name then begin

     

       517
        
               (* Found the case tag *)

     

       518
        
               let tag = decode d ~nest:(nest + 1) cases.tag.type' in

     

       519
       +
               decode_with_case_tag d ~nest obj_meta map umems cases tag mem_miss

     

       520
       +
                 delayed dict

     

       521
       +
             end

     

       522
       +
             else begin

     

       523
        
               (* Not the case tag - check if known member or delay *)

     

       524
        
               match String_map.find_opt name map.mem_decs with

     

       525
       +
               | Some (Mem_dec mem) -> (

     

       526
        
                   let mem_miss = String_map.remove name mem_miss in

     

       527
       +
                   try

     

       528
       +
                     let v = decode d ~nest:(nest + 1) mem.type' in

     

       529
       +
                     let dict = Dict.add mem.id v dict in

     

       530
       +
                     decode_object_cases d ~nest obj_meta map umems cases mem_miss

     

       531
       +
                       delayed dict

     

       532
       +
                   with Jsont.Error e ->

     

       533
       +
                     Jsont.Repr.error_push_object obj_meta map (name, name_meta) e)

     

       534
        
               | None ->

     

       535
        
                   (* Unknown member - decode as generic JSON and delay *)

     

       536
        
                   let v = decode d ~nest:(nest + 1) (Jsont.Repr.of_t Jsont.json) in

     

       537
        
                   let delayed = ((name, name_meta), v) :: delayed in

     

       538
       +
                   decode_object_cases d ~nest obj_meta map umems cases mem_miss

     

       539
       +
                     delayed dict

     

       540
        
             end

     

       541
       +
         | None -> Jsont.Error.msgf obj_meta "Unclosed mapping"

     

       0
        
       
     

       542
        
       

     

       543
        
       and decode_with_case_tag : type o cases tag.

     

       544
       +
           decoder ->

     

       545
       +
           nest:int ->

     

       546
       +
           Jsont.Meta.t ->

     

       547
       +
           (o, o) object_map ->

     

       548
       +
           unknown_mems_option ->

     

       549
       +
           (o, cases, tag) object_cases ->

     

       550
       +
           tag ->

     

       551
       +
           mem_dec String_map.t ->

     

       552
       +
           (Jsont.name * Jsont.json) list ->

     

       553
       +
           Dict.t ->

     

       554
       +
           Dict.t =

     

       555
       +
        fun d ~nest obj_meta map umems cases tag mem_miss delayed dict ->

     

       556
        
         let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in

     

       557
        
         match List.find_opt eq_tag cases.cases with

     

       558
       +
         | None -> Jsont.Repr.unexpected_case_tag_error obj_meta map cases tag

     

       0
        
       
     

       559
        
         | Some (Case case) ->

     

       560
        
             (* Continue decoding with the case's object map *)

     

       561
       +
             let case_dict =

     

       562
       +
               decode_case_remaining d ~nest obj_meta case.object_map umems mem_miss

     

       563
       +
                 delayed dict

     

       564
       +
             in

     

       565
        
             let case_value = apply_dict case.object_map.dec case_dict in

     

       566
        
             Dict.add cases.id (case.dec case_value) dict

     

       567
        
       

     

       568
        
       and decode_case_remaining : type o.

     

       569
       +
           decoder ->

     

       570
       +
           nest:int ->

     

       571
       +
           Jsont.Meta.t ->

     

       572
       +
           (o, o) object_map ->

     

       573
       +
           unknown_mems_option ->

     

       574
       +
           mem_dec String_map.t ->

     

       575
       +
           (Jsont.name * Jsont.json) list ->

     

       576
       +
           Dict.t ->

     

       577
       +
           Dict.t =

     

       578
       +
        fun d ~nest obj_meta case_map _umems mem_miss delayed dict ->

     

       579
        
         (* First, process delayed members against the case map *)

     

       580
        
         let u _ _ _ = assert false in

     

       581
        
         let mem_miss = String_map.union u mem_miss case_map.mem_decs in

     

       582
       +
         let dict, mem_miss =

     

       583
       +
           List.fold_left

     

       584
       +
             (fun (dict, mem_miss) ((name, meta), json) ->

     

       585
       +
               match String_map.find_opt name case_map.mem_decs with

     

       586
       +
               | Some (Mem_dec mem) -> (

     

       587
       +
                   let t' = Jsont.Repr.unsafe_to_t mem.type' in

     

       588
       +
                   match Jsont.Json.decode' t' json with

     

       589
       +
                   | Ok v ->

     

       590
       +
                       let dict = Dict.add mem.id v dict in

     

       591
       +
                       let mem_miss = String_map.remove name mem_miss in

     

       592
       +
                       (dict, mem_miss)

     

       593
       +
                   | Error e ->

     

       594
       +
                       Jsont.Repr.error_push_object obj_meta case_map (name, meta) e)

     

       595
       +
               | None ->

     

       596
       +
                   (* Unknown for case too - skip them *)

     

       597
       +
                   (dict, mem_miss))

     

       598
       +
             (dict, mem_miss) delayed

     

       599
       +
         in

     

       600
        
         (* Then continue reading remaining members using case's own unknown handling *)

     

       601
        
         match case_map.shape with

     

       602
        
         | Object_basic case_umems ->

     
···

       605
        
             (* Nested cases shouldn't happen - use skip for safety *)

     

       606
        
             decode_object_basic d ~nest obj_meta case_map Unknown_skip mem_miss dict

     

       607
        
       

     

       608
       +
       and decode_any_mapping : type a.

     

       609
       +
           decoder -> nest:int -> Event.spanned -> a t -> a any_map -> a =

     

       610
       +
        fun d ~nest ev t map ->

     

       611
        
         match map.dec_object with

     

       612
        
         | Some t' -> decode d ~nest t'

     

       613
       +
         | None ->

     

       614
       +
             Jsont.Repr.type_error (meta_of_span d ev.span) t ~fnd:Jsont.Sort.Object

     

       615
        
       

     

       616
        
       and decode_mapping_key : decoder -> Event.spanned -> string * Jsont.Meta.t =

     

       617
       +
        fun d ev ->

     

       618
        
         match ev.Event.event with

     

       619
        
         | Event.Scalar { value; _ } ->

     

       620
        
             skip_event d;

     
···

       629
        
       let skip_to_content d =

     

       630
        
         let rec loop () =

     

       631
        
           match peek_event d with

     

       632
       +
           | Some { Event.event = Event.Stream_start _; _ } ->

     

       633
       +
               skip_event d;

     

       634
       +
               loop ()

     

       635
       +
           | Some { Event.event = Event.Document_start _; _ } ->

     

       636
       +
               skip_event d;

     

       637
       +
               loop ()

     

       638
        
           | _ -> ()

     

       639
        
         in

     

       640
        
         loop ()

     
···

       642
        
       let skip_end_wrappers d =

     

       643
        
         let rec loop () =

     

       644
        
           match peek_event d with

     

       645
       +
           | Some { Event.event = Event.Document_end _; _ } ->

     

       646
       +
               skip_event d;

     

       647
       +
               loop ()

     

       648
       +
           | Some { Event.event = Event.Stream_end; _ } ->

     

       649
       +
               skip_event d;

     

       650
       +
               loop ()

     

       651
        
           | None -> ()

     

       652
        
           | Some ev ->

     

       653
        
               let meta = meta_of_span d ev.span in

     

       654
       +
               Jsont.Error.msgf meta "Expected end of document but found %a" Event.pp

     

       655
       +
                 ev.event

     

       656
        
         in

     

       657
        
         loop ()

     

       658
        
       

     
···

       693
        
         scalar_style : Scalar_style.t;

     

       694
        
       }

     

       695
        
       

     

       696
       +
       let make_encoder ?(format = Block) ?(indent = 2) ?(explicit_doc = false)

     

       0
        
       
     

       697
        
           ?(scalar_style = `Any) emitter =

     

       698
        
         { emitter; format; _indent = indent; explicit_doc; scalar_style }

     

       699
        
       

     
···

       711
        
       

     

       712
        
       (* Encode null *)

     

       713
        
       let encode_null e _meta =

     

       714
       +
         Emitter.emit e.emitter

     

       715
       +
           (Event.Scalar

     

       716
       +
              {

     

       717
       +
                anchor = None;

     

       718
       +
                tag = None;

     

       719
       +
                value = "null";

     

       720
       +
                plain_implicit = true;

     

       721
       +
                quoted_implicit = true;

     

       722
       +
                style = `Plain;

     

       723
       +
              })

     

       724
        
       

     

       725
        
       (* Encode boolean *)

     

       726
        
       let encode_bool e _meta b =

     

       727
       +
         Emitter.emit e.emitter

     

       728
       +
           (Event.Scalar

     

       729
       +
              {

     

       730
       +
                anchor = None;

     

       731
       +
                tag = None;

     

       732
       +
                value = (if b then "true" else "false");

     

       733
       +
                plain_implicit = true;

     

       734
       +
                quoted_implicit = true;

     

       735
       +
                style = `Plain;

     

       736
       +
              })

     

       737
        
       

     

       738
        
       (* Encode number *)

     

       739
        
       let encode_number e _meta f =

     
···

       742
        
           | FP_nan -> ".nan"

     

       743
        
           | FP_infinite -> if f > 0.0 then ".inf" else "-.inf"

     

       744
        
           | _ ->

     

       745
       +
               if Float.is_integer f && Float.abs f < 1e15 then Printf.sprintf "%.0f" f

     

       746
       +
               else Printf.sprintf "%g" f

     

       0
        
       
     

       0
        
       
     

       747
        
         in

     

       748
       +
         Emitter.emit e.emitter

     

       749
       +
           (Event.Scalar

     

       750
       +
              {

     

       751
       +
                anchor = None;

     

       752
       +
                tag = None;

     

       753
       +
                value;

     

       754
       +
                plain_implicit = true;

     

       755
       +
                quoted_implicit = true;

     

       756
       +
                style = `Plain;

     

       757
       +
              })

     

       758
        
       

     

       759
        
       (* Encode string *)

     

       760
        
       let encode_string e _meta s =

     

       761
        
         let style = choose_scalar_style ~preferred:e.scalar_style s in

     

       762
       +
         Emitter.emit e.emitter

     

       763
       +
           (Event.Scalar

     

       764
       +
              {

     

       765
       +
                anchor = None;

     

       766
       +
                tag = None;

     

       767
       +
                value = s;

     

       768
       +
                plain_implicit = true;

     

       769
       +
                quoted_implicit = true;

     

       770
       +
                style;

     

       771
       +
              })

     

       772
        
       

     

       773
        
       let rec encode : type a. encoder -> a t -> a -> unit =

     

       774
       +
        fun e t v ->

     

       775
        
         match t with

     

       776
        
         | Null map ->

     

       777
        
             let meta = map.enc_meta v in

     

       778
        
             let () = map.enc v in

     

       779
        
             encode_null e meta

     

       0
        
       
     

       780
        
         | Bool map ->

     

       781
        
             let meta = map.enc_meta v in

     

       782
        
             let b = map.enc v in

     

       783
        
             encode_bool e meta b

     

       0
        
       
     

       784
        
         | Number map ->

     

       785
        
             let meta = map.enc_meta v in

     

       786
        
             let f = map.enc v in

     

       787
        
             encode_number e meta f

     

       0
        
       
     

       788
        
         | String map ->

     

       789
        
             let meta = map.enc_meta v in

     

       790
        
             let s = map.enc v in

     

       791
        
             encode_string e meta s

     

       792
       +
         | Array map -> encode_array e map v

     

       793
       +
         | Object map -> encode_object e map v

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       794
        
         | Any map ->

     

       795
        
             let t' = map.enc v in

     

       796
        
             encode e t' v

     

       797
       +
         | Map m -> encode e m.dom (m.enc v)

     

       798
       +
         | Rec lazy_t -> encode e (Lazy.force lazy_t) v

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       799
        
       

     

       800
        
       and encode_array : type a elt b. encoder -> (a, elt, b) array_map -> a -> unit =

     

       801
       +
        fun e map v ->

     

       802
        
         let style = layout_style_of_format e.format in

     

       803
       +
         Emitter.emit e.emitter

     

       804
       +
           (Event.Sequence_start { anchor = None; tag = None; implicit = true; style });

     

       805
       +
         let _ =

     

       806
       +
           map.enc

     

       807
       +
             (fun () _idx elt ->

     

       808
       +
               encode e map.elt elt;

     

       809
       +
               ())

     

       810
       +
             () v

     

       811
       +
         in

     

       0
        
       
     

       812
        
         Emitter.emit e.emitter Event.Sequence_end

     

       813
        
       

     

       814
        
       and encode_object : type o. encoder -> (o, o) object_map -> o -> unit =

     

       815
       +
        fun e map v ->

     

       816
        
         let style = layout_style_of_format e.format in

     

       817
       +
         Emitter.emit e.emitter

     

       818
       +
           (Event.Mapping_start { anchor = None; tag = None; implicit = true; style });

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       819
        
         (* Encode each member *)

     

       820
       +
         List.iter

     

       821
       +
           (fun (Mem_enc mem) ->

     

       822
       +
             let mem_v = mem.enc v in

     

       823
       +
             if not (mem.enc_omit mem_v) then begin

     

       824
       +
               (* Emit key *)

     

       825
       +
               Emitter.emit e.emitter

     

       826
       +
                 (Event.Scalar

     

       827
       +
                    {

     

       828
       +
                      anchor = None;

     

       829
       +
                      tag = None;

     

       830
       +
                      value = mem.name;

     

       831
       +
                      plain_implicit = true;

     

       832
       +
                      quoted_implicit = true;

     

       833
       +
                      style = `Plain;

     

       834
       +
                    });

     

       835
       +
               (* Emit value *)

     

       836
       +
               encode e mem.type' mem_v

     

       837
       +
             end)

     

       838
       +
           map.mem_encs;

     

       839
        
         (* Handle case objects *)

     

       840
        
         (match map.shape with

     

       841
       +
         | Object_basic _ -> ()

     

       842
       +
         | Object_cases (_, cases) ->

     

       843
       +
             let (Case_value (case_map, case_v)) = cases.enc_case (cases.enc v) in

     

       844
       +
             (* Emit case tag *)

     

       845
       +
             if not (cases.tag.enc_omit case_map.tag) then begin

     

       846
       +
               Emitter.emit e.emitter

     

       847
       +
                 (Event.Scalar

     

       848
       +
                    {

     

       849
       +
                      anchor = None;

     

       850
       +
                      tag = None;

     

       851
       +
                      value = cases.tag.name;

     

       852
       +
                      plain_implicit = true;

     

       853
       +
                      quoted_implicit = true;

     

       854
       +
                      style = `Plain;

     

       855
       +
                    });

     

       856
       +
               encode e cases.tag.type' case_map.tag

     

       857
       +
             end;

     

       858
       +
             (* Emit case members *)

     

       859
       +
             List.iter

     

       860
       +
               (fun (Mem_enc mem) ->

     

       861
       +
                 let mem_v = mem.enc case_v in

     

       862
       +
                 if not (mem.enc_omit mem_v) then begin

     

       863
       +
                   Emitter.emit e.emitter

     

       864
       +
                     (Event.Scalar

     

       865
       +
                        {

     

       866
       +
                          anchor = None;

     

       867
       +
                          tag = None;

     

       868
       +
                          value = mem.name;

     

       869
       +
                          plain_implicit = true;

     

       870
       +
                          quoted_implicit = true;

     

       871
       +
                          style = `Plain;

     

       872
       +
                        });

     

       873
       +
                   encode e mem.type' mem_v

     

       874
       +
                 end)

     

       875
       +
               case_map.object_map.mem_encs);

     

       876
        
         Emitter.emit e.emitter Event.Mapping_end

     

       877
        
       

     

       878
        
       (* Public encode API *)

     

       879
        
       

     

       880
        
       let encode' ?buf:_ ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer =

     

       881
       +
         let config =

     

       882
       +
           {

     

       883
       +
             Emitter.default_config with

     

       884
       +
             indent = Option.value ~default:2 indent;

     

       885
       +
             layout_style = (match format with Some Flow -> `Flow | _ -> `Block);

     

       886
       +
           }

     

       887
       +
         in

     

       888
        
         let emitter = Emitter.of_writer ~config writer in

     

       889
        
         let e = make_encoder ?format ?indent ?explicit_doc ?scalar_style emitter in

     

       890
        
         try

     

       891
        
           Emitter.emit e.emitter (Event.Stream_start { encoding = `Utf8 });

     

       892
       +
           Emitter.emit e.emitter

     

       893
       +
             (Event.Document_start { version = None; implicit = not e.explicit_doc });

     

       0
        
       
     

       0
        
       
     

       894
        
           let t' = Jsont.Repr.of_t t in

     

       895
        
           encode e t' v;

     

       896
       +
           Emitter.emit e.emitter

     

       897
       +
             (Event.Document_end { implicit = not e.explicit_doc });

     

       898
        
           Emitter.emit e.emitter Event.Stream_end;

     

       899
        
           if eod then Emitter.flush e.emitter;

     

       900
        
           Ok ()

     
···

       911
        
       let encode_string' ?buf ?format ?indent ?explicit_doc ?scalar_style t v =

     

       912
        
         let b = Buffer.create 256 in

     

       913
        
         let writer = Bytes.Writer.of_buffer b in

     

       914
       +
         match

     

       915
       +
           encode' ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod:true

     

       916
       +
             writer

     

       917
       +
         with

     

       918
        
         | Ok () -> Ok (Buffer.contents b)

     

       919
        
         | Error e -> Error e

     

       920
        
       

     
···

       924
        
       

     

       925
        
       (* Recode *)

     

       926
        
       

     

       927
       +
       let recode ?layout ?locs ?file ?max_depth ?max_nodes ?buf ?format ?indent

     

       928
       +
           ?explicit_doc ?scalar_style t reader writer ~eod =

     

       929
       +
         let format =

     

       930
       +
           match (layout, format) with Some true, None -> Some Layout | _, f -> f

     

       0
        
       
     

       931
        
         in

     

       932
       +
         let layout =

     

       933
       +
           match (layout, format) with None, Some Layout -> Some true | l, _ -> l

     

       0
        
       
     

       934
        
         in

     

       935
        
         match decode' ?layout ?locs ?file ?max_depth ?max_nodes t reader with

     

       936
       +
         | Ok v ->

     

       937
       +
             encode ?buf ?format ?indent ?explicit_doc ?scalar_style t v ~eod writer

     

       938
        
         | Error e -> Error (Jsont.Error.to_string e)

     

       939
        
       

     

       940
       +
       let recode_string ?layout ?locs ?file ?max_depth ?max_nodes ?buf ?format ?indent

     

       941
       +
           ?explicit_doc ?scalar_style t s =

     

       942
       +
         let format =

     

       943
       +
           match (layout, format) with Some true, None -> Some Layout | _, f -> f

     

       0
        
       
     

       944
        
         in

     

       945
       +
         let layout =

     

       946
       +
           match (layout, format) with None, Some Layout -> Some true | l, _ -> l

     

       0
        
       
     

       947
        
         in

     

       948
        
         match decode_string' ?layout ?locs ?file ?max_depth ?max_nodes t s with

     

       949
        
         | Ok v -> encode_string ?buf ?format ?indent ?explicit_doc ?scalar_style t v

+149 -91

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 }

     

       0
        
       
     

       17
        
               let make name port = { name; port }

     

       0
        
       
     

       18
        
               let jsont =

     

       19
        
                 Jsont.Object.map ~kind:"Config" make

     

       20
        
                 |> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.name)

     
···

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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. *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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 ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
        
       

     
···

       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]. *)

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. 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 {!Jsont.t}

     

       9
       +
           type descriptions, allowing the same codec definitions to work for both JSON

     

       10
       +
           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
       +
       

     

       18
        
               let make name port = { name; port }

     

       19
       +
       

     

       20
        
               let jsont =

     

       21
        
                 Jsont.Object.map ~kind:"Config" make

     

       22
        
                 |> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.name)

     
···

       30
        
           ]}

     

       31
        
       

     

       32
        
           See notes about {{!yaml_mapping}YAML to JSON mapping} and

     

       33
       +
           {{!yaml_scalars}YAML scalar resolution}. *)

     

       0
        
       
     

       34
        
       

     

       35
        
       open Bytesrw

     

       36
        
       

     

       37
        
       (** {1:decode Decode} *)

     

       38
        
       

     

       39
        
       val decode :

     

       40
       +
         ?layout:bool ->

     

       41
       +
         ?locs:bool ->

     

       42
       +
         ?file:Jsont.Textloc.fpath ->

     

       43
       +
         ?max_depth:int ->

     

       44
       +
         ?max_nodes:int ->

     

       45
       +
         'a Jsont.t ->

     

       46
       +
         Bytes.Reader.t ->

     

       47
       +
         ('a, string) result

     

       48
        
       (** [decode t r] decodes a value from YAML reader [r] according to type [t].

     

       49
       +
           - If [layout] is [true], style information is preserved in {!Jsont.Meta.t}

     

       50
       +
             values (for potential round-tripping). Defaults to [false].

     

       51
       +
           - If [locs] is [true], source locations are preserved in {!Jsont.Meta.t}

     

       52
       +
             values and error messages are precisely located. Defaults to [false].

     

       53
       +
           - [file] is the file path for error messages. Defaults to

     

       54
       +
             {!Jsont.Textloc.file_none}.

     

       55
       +
           - [max_depth] limits nesting depth to prevent stack overflow (billion laughs

     

       56
       +
             protection). Defaults to [100].

     

       57
       +
           - [max_nodes] limits total decoded nodes (billion laughs protection).

     

       58
       +
             Defaults to [10_000_000].

     

       0
        
       
     

       59
        
       

     

       60
       +
           The YAML input must contain exactly one document. Multi-document streams are

     

       61
       +
           not supported; use {!decode_all} for those. *)

     

       62
        
       

     

       63
        
       val decode' :

     

       64
       +
         ?layout:bool ->

     

       65
       +
         ?locs:bool ->

     

       66
       +
         ?file:Jsont.Textloc.fpath ->

     

       67
       +
         ?max_depth:int ->

     

       68
       +
         ?max_nodes:int ->

     

       69
       +
         'a Jsont.t ->

     

       70
       +
         Bytes.Reader.t ->

     

       71
       +
         ('a, Jsont.Error.t) result

     

       72
        
       (** [decode'] is like {!val-decode} but preserves the error structure. *)

     

       73
        
       

     

       74
        
       val decode_string :

     

       75
       +
         ?layout:bool ->

     

       76
       +
         ?locs:bool ->

     

       77
       +
         ?file:Jsont.Textloc.fpath ->

     

       78
       +
         ?max_depth:int ->

     

       79
       +
         ?max_nodes:int ->

     

       80
       +
         'a Jsont.t ->

     

       81
       +
         string ->

     

       82
       +
         ('a, string) result

     

       83
        
       (** [decode_string] is like {!val-decode} but decodes directly from a string. *)

     

       84
        
       

     

       85
        
       val decode_string' :

     

       86
       +
         ?layout:bool ->

     

       87
       +
         ?locs:bool ->

     

       88
       +
         ?file:Jsont.Textloc.fpath ->

     

       89
       +
         ?max_depth:int ->

     

       90
       +
         ?max_nodes:int ->

     

       91
       +
         'a Jsont.t ->

     

       92
       +
         string ->

     

       93
       +
         ('a, Jsont.Error.t) result

     

       94
       +
       (** [decode_string'] is like {!val-decode'} but decodes directly from a string.

     

       95
       +
       *)

     

       96
        
       

     

       97
        
       (** {1:encode Encode} *)

     

       98
        
       

     

       99
        
       (** YAML output format. *)

     

       100
        
       type yaml_format =

     

       101
       +
         | Block  (** Block style (indented) - default. Clean, readable YAML. *)

     

       102
       +
         | Flow  (** Flow style (JSON-like). Compact, single-line collections. *)

     

       103
        
         | Layout  (** Preserve layout from {!Jsont.Meta.t} when available. *)

     

       104
        
       

     

       105
        
       val encode :

     

       106
       +
         ?buf:Stdlib.Bytes.t ->

     

       107
       +
         ?format:yaml_format ->

     

       108
       +
         ?indent:int ->

     

       109
       +
         ?explicit_doc:bool ->

     

       110
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       111
       +
         'a Jsont.t ->

     

       112
       +
         'a ->

     

       113
       +
         eod:bool ->

     

       114
       +
         Bytes.Writer.t ->

     

       115
       +
         (unit, string) result

     

       116
        
       (** [encode t v w] encodes value [v] according to type [t] to YAML on [w].

     

       117
       +
           - If [buf] is specified, it is used as a buffer for output slices. Defaults

     

       118
       +
             to a buffer of length {!Bytesrw.Bytes.Writer.slice_length}[ w].

     

       119
       +
           - [format] controls the output style. Defaults to {!Block}.

     

       120
       +
           - [indent] is the indentation width in spaces. Defaults to [2].

     

       121
       +
           - [explicit_doc] if [true], emits explicit document markers ([---] and

     

       122
       +
             [...]). Defaults to [false].

     

       123
       +
           - [scalar_style] is the preferred style for string scalars. Defaults to

     

       124
       +
             [`Any] (auto-detect based on content).

     

       125
       +
           - [eod] indicates whether {!Bytesrw.Bytes.Slice.eod} should be written on

     

       126
       +
             [w] after encoding. *)

     

       0
        
       
     

       127
        
       

     

       128
        
       val encode' :

     

       129
       +
         ?buf:Stdlib.Bytes.t ->

     

       130
       +
         ?format:yaml_format ->

     

       131
       +
         ?indent:int ->

     

       132
       +
         ?explicit_doc:bool ->

     

       133
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       134
       +
         'a Jsont.t ->

     

       135
       +
         'a ->

     

       136
       +
         eod:bool ->

     

       137
       +
         Bytes.Writer.t ->

     

       138
       +
         (unit, Jsont.Error.t) result

     

       139
        
       (** [encode'] is like {!val-encode} but preserves the error structure. *)

     

       140
        
       

     

       141
        
       val encode_string :

     

       142
       +
         ?buf:Stdlib.Bytes.t ->

     

       143
       +
         ?format:yaml_format ->

     

       144
       +
         ?indent:int ->

     

       145
       +
         ?explicit_doc:bool ->

     

       146
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       147
       +
         'a Jsont.t ->

     

       148
       +
         'a ->

     

       149
       +
         (string, string) result

     

       150
        
       (** [encode_string] is like {!val-encode} but writes to a string. *)

     

       151
        
       

     

       152
        
       val encode_string' :

     

       153
       +
         ?buf:Stdlib.Bytes.t ->

     

       154
       +
         ?format:yaml_format ->

     

       155
       +
         ?indent:int ->

     

       156
       +
         ?explicit_doc:bool ->

     

       157
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       158
       +
         'a Jsont.t ->

     

       159
       +
         'a ->

     

       160
       +
         (string, Jsont.Error.t) result

     

       161
        
       (** [encode_string'] is like {!val-encode'} but writes to a string. *)

     

       162
        
       

     

       163
        
       (** {1:recode Recode}

     

       164
        
       

     

       165
        
           The defaults in these functions are those of {!val-decode} and

     

       166
       +
           {!val-encode}, except if [layout] is [true], [format] defaults to {!Layout}

     

       167
       +
           and vice-versa. *)

     

       168
        
       

     

       169
        
       val recode :

     

       170
       +
         ?layout:bool ->

     

       171
       +
         ?locs:bool ->

     

       172
       +
         ?file:Jsont.Textloc.fpath ->

     

       173
       +
         ?max_depth:int ->

     

       174
       +
         ?max_nodes:int ->

     

       175
       +
         ?buf:Stdlib.Bytes.t ->

     

       176
       +
         ?format:yaml_format ->

     

       177
       +
         ?indent:int ->

     

       178
       +
         ?explicit_doc:bool ->

     

       179
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       180
       +
         'a Jsont.t ->

     

       181
       +
         Bytes.Reader.t ->

     

       182
       +
         Bytes.Writer.t ->

     

       183
       +
         eod:bool ->

     

       184
        
         (unit, string) result

     

       185
        
       (** [recode t r w] is {!val-decode} followed by {!val-encode}. *)

     

       186
        
       

     

       187
        
       val recode_string :

     

       188
       +
         ?layout:bool ->

     

       189
       +
         ?locs:bool ->

     

       190
       +
         ?file:Jsont.Textloc.fpath ->

     

       191
       +
         ?max_depth:int ->

     

       192
       +
         ?max_nodes:int ->

     

       193
       +
         ?buf:Stdlib.Bytes.t ->

     

       194
       +
         ?format:yaml_format ->

     

       195
       +
         ?indent:int ->

     

       196
       +
         ?explicit_doc:bool ->

     

       197
       +
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       198
       +
         'a Jsont.t ->

     

       199
       +
         string ->

     

       200
       +
         (string, string) result

     

       201
        
       (** [recode_string] is like {!val-recode} but operates on strings. *)

     

       202
        
       

     

       203
        
       (** {1:yaml_mapping YAML to JSON Mapping}

     

       204
        
       

     

       205
       +
           YAML is a superset of JSON. This module maps YAML structures to the JSON

     

       206
       +
           data model that {!Jsont.t} describes:

     

       207
        
       

     

       208
       +
           - YAML scalars map to JSON null, boolean, number, or string depending on

     

       209
       +
             content and the expected type

     

       210
       +
           - YAML sequences map to JSON arrays

     

       211
       +
           - YAML mappings map to JSON objects (keys must be strings)

     

       212
       +
           - YAML aliases are resolved during decoding

     

       213
       +
           - YAML tags are used to guide type resolution when present

     

       0
        
       
     

       214
        
       

     

       215
        
           {b Limitations:}

     

       216
       +
           - Only string keys are supported in mappings (JSON object compatibility)

     

       217
       +
           - Anchors and aliases are resolved; the alias structure is not preserved

     

       218
       +
           - Multi-document streams require {!decode_all} *)

     

       0
        
       
     

       219
        
       

     

       220
        
       (** {1:yaml_scalars YAML Scalar Resolution}

     

       221
        
       

     
···

       223
        
       

     

       224
        
           {b Null:} [null], [Null], [NULL], [~], or empty string

     

       225
        
       

     

       226
       +
           {b Boolean:} [true], [True], [TRUE], [false], [False], [FALSE], [yes],

     

       227
       +
           [Yes], [YES], [no], [No], [NO], [on], [On], [ON], [off], [Off], [OFF]

     

       0
        
       
     

       228
        
       

     

       229
        
           {b Number:} Decimal integers, floats, hex ([0x...]), octal ([0o...]),

     

       230
        
           infinity ([.inf], [-.inf]), NaN ([.nan])

     

       231
        
       

     

       232
        
           {b String:} Anything else, or explicitly quoted scalars

     

       233
        
       

     

       234
       +
           When decoding against a specific {!Jsont.t} type, the expected type takes

     

       235
       +
           precedence over automatic resolution. For example, decoding ["yes"] against

     

       236
       +
           {!Jsont.string} yields the string ["yes"], not [true]. *)

+4 -1

tests/bin/dune

···

       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))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       36
        
       

     

       37
        
       (executable

     

       38
        
        (name test_null_complete)

···

       32
        
        (name test_edge)

     

       33
        
        (public_name test_edge)

     

       34
        
        (libraries yamlt jsont jsont.bytesrw bytesrw))

     

       35
       +
       

     

       36
       +
       (executable

     

       37
       +
        (name test_null_fix)

     

       38
       +
        (libraries yamlt jsont jsont.bytesrw bytesrw))

     

       39
        
       

     

       40
        
       (executable

     

       41
        
        (name test_null_complete)

+13 -10

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)

     

       0
        
       
     

       5
        
           |> Jsont.Object.finish

     

       6
        
         in

     

       7
        
       

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       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)

···

       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 ->

     

       5
       +
               arr)

     

       6
        
           |> Jsont.Object.finish

     

       7
        
         in

     

       8
        
       

     
···

       10
        
       

     

       11
        
         Printf.printf "Test 1: Non-optional array:\n";

     

       12
        
         (match Yamlt.decode_string codec1 yaml1 with

     

       13
       +
         | Ok arr -> Printf.printf "Result: [%d items]\n" (Array.length arr)

     

       14
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       15
        
       

     

       16
        
         let codec2 =

     

       17
        
           Jsont.Object.map ~kind:"Test" (fun arr -> arr)

     

       18
       +
           |> Jsont.Object.mem "values"

     

       19
       +
                (Jsont.option (Jsont.array Jsont.string))

     

       20
       +
                ~enc:(fun arr -> arr)

     

       21
        
           |> Jsont.Object.finish

     

       22
        
         in

     

       23
        
       

     

       24
        
         Printf.printf "\nTest 2: Jsont.option (Jsont.array):\n";

     

       25
       +
         match Yamlt.decode_string codec2 yaml1 with

     

       26
       +
         | Ok arr -> (

     

       27
       +
             match arr with

     

       28
       +
             | None -> Printf.printf "Result: None\n"

     

       29
       +
             | Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))

     

       30
       +
         | Error e -> Printf.printf "Error: %s\n" e

+74 -84

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 =

     
···

       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)

     

       0
        
       
     

       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)))

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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)))

     

       0
        
       
     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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)))

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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

     
···

       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 })

     
···

       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)

     

       0
        
       
     

       136
        
             |> Jsont.Object.finish

     

       137
        
       

     

       138
        
           let show_person p = Printf.sprintf "{%s,%d}" p.name p.age

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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)))

     

       0
        
       
     

       166
        
       

     

       167
        
           let show m =

     

       168
       -
             Printf.sprintf "[%s]" (String.concat "; " (Array.to_list (Array.map show_row m.data)))

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       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)))

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       258
        
             |> Jsont.Object.finish

     

       259
        
         end in

     

       260
       -
       

     

       261
       -
         let data = { M.numbers = [|1; 2; 3; 4; 5|]; strings = [|"hello"; "world"|] } in

     

       0
        
       
     

       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

     
···

       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:";

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test array codec functionality with Yamlt *)

     

       0
        
       
     

       7
        
       

     

       8
        
       (* Helper to read file *)

     

       9
        
       let read_file path =

     
···

       27
        
       (* Test: Simple int array *)

     

       28
        
       let test_int_array file =

     

       29
        
         let module M = struct

     

       30
       +
           type numbers = { values : int array }

     

       31
        
       

     

       32
        
           let numbers_codec =

     

       33
        
             Jsont.Object.map ~kind:"Numbers" (fun values -> { values })

     

       34
       +
             |> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n ->

     

       35
       +
                 n.values)

     

       36
        
             |> Jsont.Object.finish

     

       37
        
       

     

       38
        
           let show n =

     

       39
       +
             Printf.sprintf "[%s]"

     

       40
       +
               (String.concat "; " (Array.to_list (Array.map string_of_int n.values)))

     

       41
        
         end in

     

       0
        
       
     

       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

     
···

       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 ->

     

       59
       +
                 t.items)

     

       60
        
             |> Jsont.Object.finish

     

       61
        
       

     

       62
        
           let show t =

     

       63
       +
             Printf.sprintf "[%s]"

     

       64
       +
               (String.concat "; "

     

       65
       +
                  (Array.to_list (Array.map (Printf.sprintf "%S") t.items)))

     

       66
        
         end in

     

       0
        
       
     

       67
        
         let yaml = read_file file in

     

       68
        
         let json = read_file (file ^ ".json") in

     

       69
        
         let json_result = Jsont_bytesrw.decode_string M.tags_codec json in

     
···

       76
        
       (* Test: Float/number array *)

     

       77
        
       let test_float_array file =

     

       78
        
         let module M = struct

     

       79
       +
           type measurements = { values : float array }

     

       80
        
       

     

       81
        
           let measurements_codec =

     

       82
        
             Jsont.Object.map ~kind:"Measurements" (fun values -> { values })

     

       83
       +
             |> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:(fun m ->

     

       84
       +
                 m.values)

     

       85
        
             |> Jsont.Object.finish

     

       86
        
       

     

       87
        
           let show m =

     

       88
        
             Printf.sprintf "[%s]"

     

       89
       +
               (String.concat "; "

     

       90
       +
                  (Array.to_list (Array.map (Printf.sprintf "%.2f") m.values)))

     

       91
        
         end in

     

       0
        
       
     

       92
        
         let yaml = read_file file in

     

       93
        
         let json = read_file (file ^ ".json") in

     

       94
        
         let json_result = Jsont_bytesrw.decode_string M.measurements_codec json in

     
···

       101
        
       (* Test: Empty array *)

     

       102
        
       let test_empty_array file =

     

       103
        
         let module M = struct

     

       104
       +
           type empty = { items : int array }

     

       105
        
       

     

       106
        
           let empty_codec =

     

       107
        
             Jsont.Object.map ~kind:"Empty" (fun items -> { items })

     

       108
       +
             |> Jsont.Object.mem "items" (Jsont.array Jsont.int) ~enc:(fun e ->

     

       109
       +
                 e.items)

     

       110
        
             |> Jsont.Object.finish

     

       111
        
       

     

       112
       +
           let show e = Printf.sprintf "length=%d" (Stdlib.Array.length e.items)

     

       0
        
       
     

       113
        
         end in

     

       0
        
       
     

       114
        
         let yaml = read_file file in

     

       115
        
         let json = read_file (file ^ ".json") in

     

       116
        
         let json_result = Jsont_bytesrw.decode_string M.empty_codec json in

     
···

       123
        
       (* Test: Array of objects *)

     

       124
        
       let test_object_array file =

     

       125
        
         let module M = struct

     

       126
       +
           type person = { name : string; age : int }

     

       127
       +
           type people = { persons : person array }

     

       128
        
       

     

       129
        
           let person_codec =

     

       130
        
             Jsont.Object.map ~kind:"Person" (fun name age -> { name; age })

     
···

       134
        
       

     

       135
        
           let people_codec =

     

       136
        
             Jsont.Object.map ~kind:"People" (fun persons -> { persons })

     

       137
       +
             |> Jsont.Object.mem "persons" (Jsont.array person_codec) ~enc:(fun p ->

     

       138
       +
                 p.persons)

     

       139
        
             |> Jsont.Object.finish

     

       140
        
       

     

       141
        
           let show_person p = Printf.sprintf "{%s,%d}" p.name p.age

     

       142
       +
       

     

       143
        
           let show ps =

     

       144
        
             Printf.sprintf "[%s]"

     

       145
        
               (String.concat "; " (Array.to_list (Array.map show_person ps.persons)))

     

       146
        
         end in

     

       0
        
       
     

       147
        
         let yaml = read_file file in

     

       148
        
         let json = read_file (file ^ ".json") in

     

       149
        
         let json_result = Jsont_bytesrw.decode_string M.people_codec json in

     
···

       156
        
       (* Test: Nested arrays *)

     

       157
        
       let test_nested_arrays file =

     

       158
        
         let module M = struct

     

       159
       +
           type matrix = { data : int array array }

     

       160
        
       

     

       161
        
           let matrix_codec =

     

       162
        
             Jsont.Object.map ~kind:"Matrix" (fun data -> { data })

     

       163
       +
             |> Jsont.Object.mem "data"

     

       164
       +
                  (Jsont.array (Jsont.array Jsont.int))

     

       165
       +
                  ~enc:(fun m -> m.data)

     

       166
        
             |> Jsont.Object.finish

     

       167
        
       

     

       168
        
           let show_row row =

     

       169
       +
             Printf.sprintf "[%s]"

     

       170
       +
               (String.concat "; " (Array.to_list (Array.map string_of_int row)))

     

       171
        
       

     

       172
        
           let show m =

     

       173
       +
             Printf.sprintf "[%s]"

     

       174
       +
               (String.concat "; " (Array.to_list (Array.map show_row m.data)))

     

       175
        
         end in

     

       0
        
       
     

       176
        
         let yaml = read_file file in

     

       177
        
         let json = read_file (file ^ ".json") in

     

       178
        
         let json_result = Jsont_bytesrw.decode_string M.matrix_codec json in

     
···

       185
        
       (* Test: Mixed types in array (should fail with homogeneous codec) *)

     

       186
        
       let test_type_mismatch file =

     

       187
        
         let module M = struct

     

       188
       +
           type numbers = { values : int array }

     

       189
        
       

     

       190
        
           let numbers_codec =

     

       191
        
             Jsont.Object.map ~kind:"Numbers" (fun values -> { values })

     

       192
       +
             |> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n ->

     

       193
       +
                 n.values)

     

       194
        
             |> Jsont.Object.finish

     

       195
        
         end in

     

       0
        
       
     

       196
        
         let yaml = read_file file in

     

       197
        
         let result = Yamlt.decode_string M.numbers_codec yaml in

     

       198
        
         match result with

     
···

       202
        
       (* Test: Bool array *)

     

       203
        
       let test_bool_array file =

     

       204
        
         let module M = struct

     

       205
       +
           type flags = { values : bool array }

     

       206
        
       

     

       207
        
           let flags_codec =

     

       208
        
             Jsont.Object.map ~kind:"Flags" (fun values -> { values })

     

       209
       +
             |> Jsont.Object.mem "values" (Jsont.array Jsont.bool) ~enc:(fun f ->

     

       210
       +
                 f.values)

     

       211
        
             |> Jsont.Object.finish

     

       212
        
       

     

       213
        
           let show f =

     

       214
        
             Printf.sprintf "[%s]"

     

       215
        
               (String.concat "; " (Array.to_list (Array.map string_of_bool f.values)))

     

       216
        
         end in

     

       0
        
       
     

       217
        
         let yaml = read_file file in

     

       218
        
         let json = read_file (file ^ ".json") in

     

       219
        
         let json_result = Jsont_bytesrw.decode_string M.flags_codec json in

     
···

       226
        
       (* Test: Array with nulls *)

     

       227
        
       let test_nullable_array file =

     

       228
        
         let module M = struct

     

       229
       +
           type nullable = { values : string option array }

     

       230
        
       

     

       231
        
           let nullable_codec =

     

       232
        
             Jsont.Object.map ~kind:"Nullable" (fun values -> { values })

     

       233
       +
             |> Jsont.Object.mem "values"

     

       234
       +
                  (Jsont.array (Jsont.some Jsont.string))

     

       235
       +
                  ~enc:(fun n -> n.values)

     

       236
        
             |> Jsont.Object.finish

     

       237
        
       

     

       238
       +
           let show_opt = function None -> "null" | Some s -> Printf.sprintf "%S" s

     

       0
        
       
     

       0
        
       
     

       239
        
       

     

       240
        
           let show n =

     

       241
       +
             Printf.sprintf "[%s]"

     

       242
       +
               (String.concat "; " (Array.to_list (Array.map show_opt n.values)))

     

       243
        
         end in

     

       0
        
       
     

       244
        
         let yaml = read_file file in

     

       245
        
         let json = read_file (file ^ ".json") in

     

       246
        
         let json_result = Jsont_bytesrw.decode_string M.nullable_codec json in

     
···

       253
        
       (* Test: Encoding arrays to different formats *)

     

       254
        
       let test_encode_arrays () =

     

       255
        
         let module M = struct

     

       256
       +
           type data = { numbers : int array; strings : string array }

     

       257
        
       

     

       258
        
           let data_codec =

     

       259
       +
             Jsont.Object.map ~kind:"Data" (fun numbers strings ->

     

       260
       +
                 { numbers; strings })

     

       261
       +
             |> Jsont.Object.mem "numbers" (Jsont.array Jsont.int) ~enc:(fun d ->

     

       262
       +
                 d.numbers)

     

       263
       +
             |> Jsont.Object.mem "strings" (Jsont.array Jsont.string) ~enc:(fun d ->

     

       264
       +
                 d.strings)

     

       265
        
             |> Jsont.Object.finish

     

       266
        
         end in

     

       267
       +
         let data =

     

       268
       +
           { M.numbers = [| 1; 2; 3; 4; 5 |]; strings = [| "hello"; "world" |] }

     

       269
       +
         in

     

       270
        
       

     

       271
        
         (* Encode to JSON *)

     

       272
        
         (match Jsont_bytesrw.encode_string M.data_codec data with

     

       273
       +
         | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       274
       +
         | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       275
        
       

     

       276
        
         (* Encode to YAML Block *)

     

       277
        
         (match Yamlt.encode_string ~format:Yamlt.Block M.data_codec data with

     

       278
       +
         | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       279
       +
         | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       280
        
       

     

       281
        
         (* Encode to YAML Flow *)

     

       282
       +
         match Yamlt.encode_string ~format:Yamlt.Flow M.data_codec data with

     

       283
       +
         | Ok s -> Printf.printf "YAML Flow: %s" s

     

       284
       +
         | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e

     

       285
        
       

     

       286
        
       let () =

     

       287
        
         let usage = "Usage: test_arrays <command> [args...]" in

     
···

       292
        
         end;

     

       293
        
       

     

       294
        
         match Sys.argv.(1) with

     

       295
       +
         | "int" when Array.length Sys.argv = 3 -> test_int_array Sys.argv.(2)

     

       296
       +
         | "string" when Array.length Sys.argv = 3 -> test_string_array Sys.argv.(2)

     

       297
       +
         | "float" when Array.length Sys.argv = 3 -> test_float_array Sys.argv.(2)

     

       298
       +
         | "empty" when Array.length Sys.argv = 3 -> test_empty_array Sys.argv.(2)

     

       299
       +
         | "objects" when Array.length Sys.argv = 3 -> test_object_array Sys.argv.(2)

     

       300
       +
         | "nested" when Array.length Sys.argv = 3 -> test_nested_arrays Sys.argv.(2)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       301
        
         | "type-mismatch" when Array.length Sys.argv = 3 ->

     

       302
        
             test_type_mismatch Sys.argv.(2)

     

       303
       +
         | "bool" when Array.length Sys.argv = 3 -> test_bool_array Sys.argv.(2)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       304
        
         | "nullable" when Array.length Sys.argv = 3 ->

     

       305
        
             test_nullable_array Sys.argv.(2)

     

       306
       +
         | "encode" when Array.length Sys.argv = 2 -> test_encode_arrays ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       307
        
         | _ ->

     

       308
        
             prerr_endline usage;

     

       309
        
             prerr_endline "Commands:";

+52 -41

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
        
       

     
···

       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 })

     
···

       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

     
···

       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)

     

       0
        
       
     

       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)

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     
···

       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 =

     
···

       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)

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       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

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       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

     
···

       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";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       193
        
             exit 1

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test complex nested types with Yamlt *)

     

       7
        
       

     
···

       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 })

     
···

       54
        
       

     

       55
        
           let show r = Printf.sprintf "depth=4, value=%d" r.top.nested.data.value

     

       56
        
         end in

     

       0
        
       
     

       57
        
         let yaml = read_file file in

     

       58
        
         let json = read_file (file ^ ".json") in

     

       59
        
         let json_result = Jsont_bytesrw.decode_string M.root_codec json in

     
···

       66
        
       (* Test: Array of objects with nested arrays *)

     

       67
        
       let test_mixed_structure file =

     

       68
        
         let module M = struct

     

       69
       +
           type item = { id : int; tags : string array }

     

       70
       +
           type collection = { name : string; items : item array }

     

       71
        
       

     

       72
        
           let item_codec =

     

       73
        
             Jsont.Object.map ~kind:"Item" (fun id tags -> { id; tags })

     

       74
        
             |> Jsont.Object.mem "id" Jsont.int ~enc:(fun i -> i.id)

     

       75
       +
             |> Jsont.Object.mem "tags" (Jsont.array Jsont.string) ~enc:(fun i ->

     

       76
       +
                 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 ->

     

       83
       +
                 c.items)

     

       84
        
             |> Jsont.Object.finish

     

       85
        
       

     

       86
        
           let show c =

     

       87
       +
             let total_tags =

     

       88
       +
               Stdlib.Array.fold_left

     

       89
       +
                 (fun acc item -> acc + Stdlib.Array.length item.tags)

     

       90
       +
                 0 c.items

     

       91
       +
             in

     

       92
       +
             Printf.sprintf "name=%S, items=%d, total_tags=%d" c.name

     

       93
       +
               (Stdlib.Array.length c.items)

     

       94
       +
               total_tags

     

       95
        
         end in

     

       0
        
       
     

       96
        
         let yaml = read_file file in

     

       97
        
         let json = read_file (file ^ ".json") in

     

       98
        
         let json_result = Jsont_bytesrw.decode_string M.collection_codec json in

     
···

       106
        
       let test_complex_optional file =

     

       107
        
         let module M = struct

     

       108
        
           type config = {

     

       109
       +
             host : string;

     

       110
       +
             port : int option;

     

       111
       +
             ssl : bool option;

     

       112
       +
             cert_path : string option;

     

       113
       +
             fallback_hosts : string array option;

     

       114
        
           }

     

       115
        
       

     

       116
        
           let config_codec =

     
···

       120
        
             |> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)

     

       121
        
             |> Jsont.Object.opt_mem "port" Jsont.int ~enc:(fun c -> c.port)

     

       122
        
             |> Jsont.Object.opt_mem "ssl" Jsont.bool ~enc:(fun c -> c.ssl)

     

       123
       +
             |> Jsont.Object.opt_mem "cert_path" Jsont.string ~enc:(fun c ->

     

       124
       +
                 c.cert_path)

     

       125
        
             |> Jsont.Object.opt_mem "fallback_hosts" (Jsont.array Jsont.string)

     

       126
       +
                  ~enc:(fun c -> c.fallback_hosts)

     

       127
        
             |> Jsont.Object.finish

     

       128
        
       

     

       129
        
           let show c =

     

       130
       +
             let port_str =

     

       131
       +
               match c.port with None -> "None" | Some p -> string_of_int p

     

       132
       +
             in

     

       133
       +
             let ssl_str =

     

       134
       +
               match c.ssl with None -> "None" | Some b -> string_of_bool b

     

       135
       +
             in

     

       136
       +
             let fallbacks =

     

       137
       +
               match c.fallback_hosts with

     

       138
        
               | None -> 0

     

       139
       +
               | Some arr -> Stdlib.Array.length arr

     

       140
       +
             in

     

       141
       +
             Printf.sprintf "host=%S, port=%s, ssl=%s, fallbacks=%d" c.host port_str

     

       142
       +
               ssl_str fallbacks

     

       143
        
         end in

     

       0
        
       
     

       144
        
         let yaml = read_file file in

     

       145
        
         let json = read_file (file ^ ".json") in

     

       146
        
         let json_result = Jsont_bytesrw.decode_string M.config_codec json in

     
···

       153
        
       (* Test: Heterogeneous data via any type *)

     

       154
        
       let test_heterogeneous file =

     

       155
        
         let module M = struct

     

       156
       +
           type data = { mixed : Jsont.json array }

     

       157
        
       

     

       158
        
           let data_codec =

     

       159
        
             Jsont.Object.map ~kind:"Data" (fun mixed -> { mixed })

     

       160
       +
             |> Jsont.Object.mem "mixed"

     

       161
       +
                  (Jsont.array (Jsont.any ()))

     

       162
       +
                  ~enc:(fun d -> d.mixed)

     

       163
        
             |> Jsont.Object.finish

     

       164
        
       

     

       165
        
           let show d = Printf.sprintf "items=%d" (Stdlib.Array.length d.mixed)

     

       166
        
         end in

     

       0
        
       
     

       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

     
···

       184
        
         match Sys.argv.(1) with

     

       185
        
         | "deep-nesting" when Stdlib.Array.length Sys.argv = 3 ->

     

       186
        
             test_deep_nesting Sys.argv.(2)

     

       0
        
       
     

       187
        
         | "mixed-structure" when Stdlib.Array.length Sys.argv = 3 ->

     

       188
        
             test_mixed_structure Sys.argv.(2)

     

       0
        
       
     

       189
        
         | "complex-optional" when Stdlib.Array.length Sys.argv = 3 ->

     

       190
        
             test_complex_optional Sys.argv.(2)

     

       0
        
       
     

       191
        
         | "heterogeneous" when Stdlib.Array.length Sys.argv = 3 ->

     

       192
        
             test_heterogeneous Sys.argv.(2)

     

       0
        
       
     

       193
        
         | _ ->

     

       194
        
             prerr_endline usage;

     

       195
        
             prerr_endline "Commands:";

     

       196
        
             prerr_endline "  deep-nesting <file>      - Test deeply nested objects";

     

       197
       +
             prerr_endline

     

       198
       +
               "  mixed-structure <file>   - Test arrays of objects with nested arrays";

     

       199
       +
             prerr_endline

     

       200
       +
               "  complex-optional <file>  - Test complex optional/nullable \

     

       201
       +
                combinations";

     

       202
       +
             prerr_endline

     

       203
       +
               "  heterogeneous <file>     - Test heterogeneous data via any type";

     

       204
        
             exit 1

+48 -44

tests/bin/test_comprehensive.ml

···

       6
        
           |> Jsont.Object.mem "value" (Jsont.option Jsont.string) ~enc:(fun v -> v)

     

       7
        
           |> Jsont.Object.finish

     

       8
        
         in

     

       9
       -
         

     

       10
        
         (match Yamlt.decode_string opt_codec "value: null" with

     

       11
       -
          | Ok None -> Printf.printf "✓ Plain 'null' with option codec: None\n"

     

       12
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       13
       -
         

     

       14
        
         (match Yamlt.decode_string opt_codec "value: hello" with

     

       15
       -
          | Ok (Some "hello") -> Printf.printf "✓ Plain 'hello' with option codec: Some(hello)\n"

     

       16
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       17
       -
         

     

       0
        
       
     

       18
        
         let string_codec =

     

       19
        
           Jsont.Object.map ~kind:"Test" (fun v -> v)

     

       20
        
           |> Jsont.Object.mem "value" Jsont.string ~enc:(fun v -> v)

     

       21
        
           |> Jsont.Object.finish

     

       22
        
         in

     

       23
       -
         

     

       24
        
         (match Yamlt.decode_string string_codec "value: null" with

     

       25
       -
          | Error _ -> Printf.printf "✓ Plain 'null' with string codec: ERROR (expected)\n"

     

       26
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       27
       -
         

     

       0
        
       
     

       28
        
         (match Yamlt.decode_string string_codec "value: \"\"" with

     

       29
       -
          | Ok "" -> Printf.printf "✓ Quoted empty string: \"\"\n"

     

       30
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       31
       -
         

     

       32
        
         (match Yamlt.decode_string string_codec "value: \"null\"" with

     

       33
       -
          | Ok "null" -> Printf.printf "✓ Quoted 'null': \"null\"\n"

     

       34
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       35
       -
         

     

       36
        
         (* Test 2: Number formats *)

     

       37
        
         Printf.printf "\n=== NUMBER FORMATS ===\n";

     

       38
        
         let num_codec =

     
···

       40
        
           |> Jsont.Object.mem "value" Jsont.number ~enc:(fun v -> v)

     

       41
        
           |> Jsont.Object.finish

     

       42
        
         in

     

       43
       -
         

     

       44
        
         (match Yamlt.decode_string num_codec "value: 0xFF" with

     

       45
       -
          | Ok 255. -> Printf.printf "✓ Hex 0xFF: 255\n"

     

       46
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       47
       -
         

     

       48
        
         (match Yamlt.decode_string num_codec "value: 0o77" with

     

       49
       -
          | Ok 63. -> Printf.printf "✓ Octal 0o77: 63\n"

     

       50
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       51
       -
         

     

       52
        
         (match Yamlt.decode_string num_codec "value: 0b1010" with

     

       53
       -
          | Ok 10. -> Printf.printf "✓ Binary 0b1010: 10\n"

     

       54
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       55
       -
         

     

       56
        
         (* Test 3: Optional arrays *)

     

       57
        
         Printf.printf "\n=== OPTIONAL ARRAYS ===\n";

     

       58
        
         let opt_array_codec =

     

       59
        
           Jsont.Object.map ~kind:"Test" (fun v -> v)

     

       60
       -
           |> Jsont.Object.opt_mem "values" (Jsont.array Jsont.string) ~enc:(fun v -> v)

     

       0
        
       
     

       61
        
           |> Jsont.Object.finish

     

       62
        
         in

     

       63
       -
         

     

       64
        
         (match Yamlt.decode_string opt_array_codec "values: [a, b, c]" with

     

       65
       -
          | Ok (Some arr) when Array.length arr = 3 ->

     

       66
       -
              Printf.printf "✓ Optional array [a, b, c]: Some([3 items])\n"

     

       67
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       68
       -
         

     

       69
        
         (match Yamlt.decode_string opt_array_codec "{}" with

     

       70
       -
          | Ok None -> Printf.printf "✓ Missing optional array: None\n"

     

       71
       -
          | _ -> Printf.printf "✗ FAIL\n");

     

       72
       -
         

     

       73
        
         (* Test 4: Flow encoding *)

     

       74
        
         Printf.printf "\n=== FLOW ENCODING ===\n";

     

       75
        
         let encode_codec =

     
···

       78
        
           |> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:snd

     

       79
        
           |> Jsont.Object.finish

     

       80
        
         in

     

       81
       -
         

     

       82
       -
         (match Yamlt.encode_string ~format:Flow encode_codec ("test", [|1.; 2.; 3.|]) with

     

       83
       -
          | Ok yaml_flow when String.equal yaml_flow "{name: test, values: [1.0, 2.0, 3.0]}\n" ->

     

       84
       -
              Printf.printf "✓ Flow encoding with comma separator\n"

     

       85
       -
          | Ok yaml_flow ->

     

       86
       -
              Printf.printf "✗ FAIL: %S\n" yaml_flow

     

       87
       -
          | Error e ->

     

       88
       -
              Printf.printf "✗ ERROR: %s\n" e)

     

       0

···

       6
        
           |> Jsont.Object.mem "value" (Jsont.option Jsont.string) ~enc:(fun v -> v)

     

       7
        
           |> Jsont.Object.finish

     

       8
        
         in

     

       9
       +
       

     

       10
        
         (match Yamlt.decode_string opt_codec "value: null" with

     

       11
       +
         | Ok None -> Printf.printf "✓ Plain 'null' with option codec: None\n"

     

       12
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       13
       +
       

     

       14
        
         (match Yamlt.decode_string opt_codec "value: hello" with

     

       15
       +
         | Ok (Some "hello") ->

     

       16
       +
             Printf.printf "✓ Plain 'hello' with option codec: Some(hello)\n"

     

       17
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       18
       +
       

     

       19
        
         let string_codec =

     

       20
        
           Jsont.Object.map ~kind:"Test" (fun v -> v)

     

       21
        
           |> Jsont.Object.mem "value" Jsont.string ~enc:(fun v -> v)

     

       22
        
           |> Jsont.Object.finish

     

       23
        
         in

     

       24
       +
       

     

       25
        
         (match Yamlt.decode_string string_codec "value: null" with

     

       26
       +
         | Error _ ->

     

       27
       +
             Printf.printf "✓ Plain 'null' with string codec: ERROR (expected)\n"

     

       28
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       29
       +
       

     

       30
        
         (match Yamlt.decode_string string_codec "value: \"\"" with

     

       31
       +
         | Ok "" -> Printf.printf "✓ Quoted empty string: \"\"\n"

     

       32
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       33
       +
       

     

       34
        
         (match Yamlt.decode_string string_codec "value: \"null\"" with

     

       35
       +
         | Ok "null" -> Printf.printf "✓ Quoted 'null': \"null\"\n"

     

       36
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       37
       +
       

     

       38
        
         (* Test 2: Number formats *)

     

       39
        
         Printf.printf "\n=== NUMBER FORMATS ===\n";

     

       40
        
         let num_codec =

     
···

       42
        
           |> Jsont.Object.mem "value" Jsont.number ~enc:(fun v -> v)

     

       43
        
           |> Jsont.Object.finish

     

       44
        
         in

     

       45
       +
       

     

       46
        
         (match Yamlt.decode_string num_codec "value: 0xFF" with

     

       47
       +
         | Ok 255. -> Printf.printf "✓ Hex 0xFF: 255\n"

     

       48
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       49
       +
       

     

       50
        
         (match Yamlt.decode_string num_codec "value: 0o77" with

     

       51
       +
         | Ok 63. -> Printf.printf "✓ Octal 0o77: 63\n"

     

       52
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       53
       +
       

     

       54
        
         (match Yamlt.decode_string num_codec "value: 0b1010" with

     

       55
       +
         | Ok 10. -> Printf.printf "✓ Binary 0b1010: 10\n"

     

       56
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       57
       +
       

     

       58
        
         (* Test 3: Optional arrays *)

     

       59
        
         Printf.printf "\n=== OPTIONAL ARRAYS ===\n";

     

       60
        
         let opt_array_codec =

     

       61
        
           Jsont.Object.map ~kind:"Test" (fun v -> v)

     

       62
       +
           |> Jsont.Object.opt_mem "values" (Jsont.array Jsont.string) ~enc:(fun v ->

     

       63
       +
               v)

     

       64
        
           |> Jsont.Object.finish

     

       65
        
         in

     

       66
       +
       

     

       67
        
         (match Yamlt.decode_string opt_array_codec "values: [a, b, c]" with

     

       68
       +
         | Ok (Some arr) when Array.length arr = 3 ->

     

       69
       +
             Printf.printf "✓ Optional array [a, b, c]: Some([3 items])\n"

     

       70
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       71
       +
       

     

       72
        
         (match Yamlt.decode_string opt_array_codec "{}" with

     

       73
       +
         | Ok None -> Printf.printf "✓ Missing optional array: None\n"

     

       74
       +
         | _ -> Printf.printf "✗ FAIL\n");

     

       75
       +
       

     

       76
        
         (* Test 4: Flow encoding *)

     

       77
        
         Printf.printf "\n=== FLOW ENCODING ===\n";

     

       78
        
         let encode_codec =

     
···

       81
        
           |> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:snd

     

       82
        
           |> Jsont.Object.finish

     

       83
        
         in

     

       84
       +
       

     

       85
       +
         match

     

       86
       +
           Yamlt.encode_string ~format:Flow encode_codec ("test", [| 1.; 2.; 3. |])

     

       87
       +
         with

     

       88
       +
         | Ok yaml_flow

     

       89
       +
           when String.equal yaml_flow "{name: test, values: [1.0, 2.0, 3.0]}\n" ->

     

       90
       +
             Printf.printf "✓ Flow encoding with comma separator\n"

     

       91
       +
         | Ok yaml_flow -> Printf.printf "✗ FAIL: %S\n" yaml_flow

     

       92
       +
         | Error e -> Printf.printf "✗ ERROR: %s\n" e

+32 -32

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
        
       

     
···

       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 }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       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

     
···

       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 })

     
···

       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

     
···

       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 })

     

       0
        
       
     

       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)

     
···

       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

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       115
        
             |> Jsont.Object.finish

     

       116
        
       

     

       117
        
           let show 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

     
···

       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

     
···

       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)

     

       0
        
       
     

       159
        
             |> Jsont.Object.finish

     

       160
        
       

     

       161
        
           let show 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

     
···

       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";

     

       0
        
       
     

       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";

     

       0
        
       
     

       211
        
             prerr_endline "  single-element <file>     - Test single-element arrays";

     

       212
        
             exit 1

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test edge cases with Yamlt *)

     

       7
        
       

     
···

       27
        
       (* Test: Very large numbers *)

     

       28
        
       let test_large_numbers file =

     

       29
        
         let module M = struct

     

       30
       +
           type numbers = {

     

       31
       +
             large_int : float;

     

       32
       +
             large_float : float;

     

       33
       +
             small_float : float;

     

       34
       +
           }

     

       35
        
       

     

       36
        
           let numbers_codec =

     

       37
        
             Jsont.Object.map ~kind:"Numbers" (fun large_int large_float small_float ->

     

       38
       +
                 { large_int; large_float; small_float })

     

       39
        
             |> Jsont.Object.mem "large_int" Jsont.number ~enc:(fun n -> n.large_int)

     

       40
       +
             |> Jsont.Object.mem "large_float" Jsont.number ~enc:(fun n ->

     

       41
       +
                 n.large_float)

     

       42
       +
             |> Jsont.Object.mem "small_float" Jsont.number ~enc:(fun n ->

     

       43
       +
                 n.small_float)

     

       44
        
             |> Jsont.Object.finish

     

       45
        
       

     

       46
        
           let show n =

     

       47
        
             Printf.sprintf "large_int=%.0f, large_float=%e, small_float=%e"

     

       48
        
               n.large_int n.large_float n.small_float

     

       49
        
         end in

     

       0
        
       
     

       50
        
         let yaml = read_file file in

     

       51
        
         let json = read_file (file ^ ".json") in

     

       52
        
         let json_result = Jsont_bytesrw.decode_string M.numbers_codec json in

     
···

       59
        
       (* Test: Special characters in strings *)

     

       60
        
       let test_special_chars file =

     

       61
        
         let module M = struct

     

       62
       +
           type text = { content : string }

     

       63
        
       

     

       64
        
           let text_codec =

     

       65
        
             Jsont.Object.map ~kind:"Text" (fun content -> { content })

     
···

       72
        
               (String.contains t.content '\n')

     

       73
        
               (String.contains t.content '\t')

     

       74
        
         end in

     

       0
        
       
     

       75
        
         let yaml = read_file file in

     

       76
        
         let json = read_file (file ^ ".json") in

     

       77
        
         let json_result = Jsont_bytesrw.decode_string M.text_codec json in

     
···

       84
        
       (* Test: Unicode strings *)

     

       85
        
       let test_unicode file =

     

       86
        
         let module M = struct

     

       87
       +
           type text = { emoji : string; chinese : string; rtl : string }

     

       88
        
       

     

       89
        
           let text_codec =

     

       90
       +
             Jsont.Object.map ~kind:"Text" (fun emoji chinese rtl ->

     

       91
       +
                 { emoji; chinese; rtl })

     

       92
        
             |> Jsont.Object.mem "emoji" Jsont.string ~enc:(fun t -> t.emoji)

     

       93
        
             |> Jsont.Object.mem "chinese" Jsont.string ~enc:(fun t -> t.chinese)

     

       94
        
             |> Jsont.Object.mem "rtl" Jsont.string ~enc:(fun t -> t.rtl)

     
···

       97
        
           let show t =

     

       98
        
             Printf.sprintf "emoji=%S, chinese=%S, rtl=%S" t.emoji t.chinese t.rtl

     

       99
        
         end in

     

       0
        
       
     

       100
        
         let yaml = read_file file in

     

       101
        
         let json = read_file (file ^ ".json") in

     

       102
        
         let json_result = Jsont_bytesrw.decode_string M.text_codec json in

     
···

       109
        
       (* Test: Empty collections *)

     

       110
        
       let test_empty_collections file =

     

       111
        
         let module M = struct

     

       112
       +
           type data = { empty_array : int array; empty_object_array : unit array }

     

       113
        
       

     

       114
        
           let data_codec =

     

       115
        
             Jsont.Object.map ~kind:"Data" (fun empty_array empty_object_array ->

     

       116
       +
                 { empty_array; empty_object_array })

     

       117
       +
             |> Jsont.Object.mem "empty_array" (Jsont.array Jsont.int) ~enc:(fun d ->

     

       118
       +
                 d.empty_array)

     

       119
       +
             |> Jsont.Object.mem "empty_object_array"

     

       120
       +
                  (Jsont.array (Jsont.null ()))

     

       121
       +
                  ~enc:(fun d -> d.empty_object_array)

     

       122
        
             |> Jsont.Object.finish

     

       123
        
       

     

       124
        
           let show d =

     
···

       126
        
               (Stdlib.Array.length d.empty_array)

     

       127
        
               (Stdlib.Array.length d.empty_object_array)

     

       128
        
         end in

     

       0
        
       
     

       129
        
         let yaml = read_file file in

     

       130
        
         let json = read_file (file ^ ".json") in

     

       131
        
         let json_result = Jsont_bytesrw.decode_string M.data_codec json in

     
···

       144
        
             | Ok _ -> "not_object"

     

       145
        
             | Error _ -> "decode_error"

     

       146
        
         end in

     

       0
        
       
     

       147
        
         let yaml = read_file file in

     

       148
        
         let json = read_file (file ^ ".json") in

     

       149
        
         let json_result = Jsont_bytesrw.decode_string (Jsont.any ()) json in

     
···

       156
        
       (* Test: Single-element arrays *)

     

       157
        
       let test_single_element file =

     

       158
        
         let module M = struct

     

       159
       +
           type data = { single : int array }

     

       160
        
       

     

       161
        
           let data_codec =

     

       162
        
             Jsont.Object.map ~kind:"Data" (fun single -> { single })

     

       163
       +
             |> Jsont.Object.mem "single" (Jsont.array Jsont.int) ~enc:(fun d ->

     

       164
       +
                 d.single)

     

       165
        
             |> Jsont.Object.finish

     

       166
        
       

     

       167
        
           let show d =

     
···

       169
        
               (Stdlib.Array.length d.single)

     

       170
        
               (if Stdlib.Array.length d.single > 0 then d.single.(0) else 0)

     

       171
        
         end in

     

       0
        
       
     

       172
        
         let yaml = read_file file in

     

       173
        
         let json = read_file (file ^ ".json") in

     

       174
        
         let json_result = Jsont_bytesrw.decode_string M.data_codec json in

     
···

       189
        
         match Sys.argv.(1) with

     

       190
        
         | "large-numbers" when Stdlib.Array.length Sys.argv = 3 ->

     

       191
        
             test_large_numbers Sys.argv.(2)

     

       0
        
       
     

       192
        
         | "special-chars" when Stdlib.Array.length Sys.argv = 3 ->

     

       193
        
             test_special_chars Sys.argv.(2)

     

       194
       +
         | "unicode" when Stdlib.Array.length Sys.argv = 3 -> test_unicode Sys.argv.(2)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       195
        
         | "empty-collections" when Stdlib.Array.length Sys.argv = 3 ->

     

       196
        
             test_empty_collections Sys.argv.(2)

     

       0
        
       
     

       197
        
         | "special-keys" when Stdlib.Array.length Sys.argv = 3 ->

     

       198
        
             test_special_keys Sys.argv.(2)

     

       0
        
       
     

       199
        
         | "single-element" when Stdlib.Array.length Sys.argv = 3 ->

     

       200
        
             test_single_element Sys.argv.(2)

     

       0
        
       
     

       201
        
         | _ ->

     

       202
        
             prerr_endline usage;

     

       203
        
             prerr_endline "Commands:";

     

       204
        
             prerr_endline "  large-numbers <file>      - Test very large numbers";

     

       205
       +
             prerr_endline

     

       206
       +
               "  special-chars <file>      - Test special characters in strings";

     

       207
        
             prerr_endline "  unicode <file>            - Test Unicode strings";

     

       208
        
             prerr_endline "  empty-collections <file>  - Test empty collections";

     

       209
       +
             prerr_endline

     

       210
       +
               "  special-keys <file>       - Test special characters in keys";

     

       211
        
             prerr_endline "  single-element <file>     - Test single-element arrays";

     

       212
        
             exit 1

+4 -2

tests/bin/test_flow_newline.ml

···

       5
        
           |> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:snd

     

       6
        
           |> Jsont.Object.finish

     

       7
        
         in

     

       8
       -
         

     

       9
       -
         match Yamlt.encode_string ~format:Flow encode_codec ("test", [|1.; 2.; 3.|]) with

     

       0
        
       
     

       0
        
       
     

       10
        
         | Ok yaml_flow ->

     

       11
        
             Printf.printf "Length: %d\n" (String.length yaml_flow);

     

       12
        
             Printf.printf "Repr: %S\n" yaml_flow;

···

       5
        
           |> Jsont.Object.mem "values" (Jsont.array Jsont.number) ~enc:snd

     

       6
        
           |> Jsont.Object.finish

     

       7
        
         in

     

       8
       +
       

     

       9
       +
         match

     

       10
       +
           Yamlt.encode_string ~format:Flow encode_codec ("test", [| 1.; 2.; 3. |])

     

       11
       +
         with

     

       12
        
         | Ok yaml_flow ->

     

       13
        
             Printf.printf "Length: %d\n" (String.length yaml_flow);

     

       14
        
             Printf.printf "Repr: %S\n" yaml_flow;

+40 -52

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
        
       

     
···

       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 })

     
···

       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

     
···

       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 })

     
···

       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))))

     

       0
        
       
     

       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

     
···

       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 })

     

       0
        
       
     

       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)

     
···

       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

     
···

       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 })

     
···

       120
        
             |> Jsont.Object.finish

     

       121
        
       

     

       122
        
           let data_codec =

     

       123
       -
             Jsont.Object.map ~kind:"Data" (fun name values nested -> { name; values; nested })

     

       0
        
       
     

       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)

     

       0
        
       
     

       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

     

       0
        
       
     

       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 })

     

       0
        
       
     

       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)

     
···

       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
        
       

     
···

       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)

     

       0
        
       
     

       177
        
             |> Jsont.Object.finish

     

       178
        
       

     

       179
        
           let show w =

     
···

       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

     
···

       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 })

     
···

       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
        
       

     
···

       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";

     

       0
        
       
     

       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";

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test format-specific features with Yamlt *)

     

       7
        
       

     
···

       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 })

     
···

       39
        
               (List.length (String.split_on_char '\n' t.content))

     

       40
        
               (String.length t.content)

     

       41
        
         end in

     

       0
        
       
     

       42
        
         let yaml = read_file file in

     

       43
        
         let json = read_file (file ^ ".json") in

     

       44
        
         let json_result = Jsont_bytesrw.decode_string M.text_codec json in

     
···

       51
        
       (* Test: Multi-line strings - folded style *)

     

       52
        
       let test_folded_string file =

     

       53
        
         let module M = struct

     

       54
       +
           type text = { content : string }

     

       55
        
       

     

       56
        
           let text_codec =

     

       57
        
             Jsont.Object.map ~kind:"Text" (fun content -> { content })

     
···

       59
        
             |> Jsont.Object.finish

     

       60
        
       

     

       61
        
           let show t =

     

       62
       +
             Printf.sprintf "length=%d, newlines=%d" (String.length t.content)

     

       63
       +
               (List.length

     

       64
       +
                  (List.filter

     

       65
       +
                     (fun c -> c = '\n')

     

       66
       +
                     (List.init (String.length t.content) (String.get t.content))))

     

       67
        
         end in

     

       0
        
       
     

       68
        
         let yaml = read_file file in

     

       69
        
         let json = read_file (file ^ ".json") in

     

       70
        
         let json_result = Jsont_bytesrw.decode_string M.text_codec json in

     
···

       77
        
       (* Test: Number formats - hex, octal, binary *)

     

       78
        
       let test_number_formats file =

     

       79
        
         let module M = struct

     

       80
       +
           type numbers = { hex : float; octal : float; binary : float }

     

       81
        
       

     

       82
        
           let numbers_codec =

     

       83
       +
             Jsont.Object.map ~kind:"Numbers" (fun hex octal binary ->

     

       84
       +
                 { 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)

     
···

       90
        
           let show n =

     

       91
        
             Printf.sprintf "hex=%.0f, octal=%.0f, binary=%.0f" n.hex n.octal n.binary

     

       92
        
         end in

     

       0
        
       
     

       93
        
         let yaml = read_file file in

     

       94
        
         let json = read_file (file ^ ".json") in

     

       95
        
         let json_result = Jsont_bytesrw.decode_string M.numbers_codec json in

     
···

       102
        
       (* Test: Block vs Flow style encoding *)

     

       103
        
       let test_encode_styles () =

     

       104
        
         let module M = struct

     

       105
       +
           type data = { name : string; values : int array; nested : nested_data }

     

       106
       +
           and nested_data = { enabled : bool; count : int }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       107
        
       

     

       108
        
           let nested_codec =

     

       109
        
             Jsont.Object.map ~kind:"Nested" (fun enabled count -> { enabled; count })

     
···

       112
        
             |> Jsont.Object.finish

     

       113
        
       

     

       114
        
           let data_codec =

     

       115
       +
             Jsont.Object.map ~kind:"Data" (fun name values nested ->

     

       116
       +
                 { name; values; nested })

     

       117
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun d -> d.name)

     

       118
       +
             |> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun d ->

     

       119
       +
                 d.values)

     

       120
        
             |> Jsont.Object.mem "nested" nested_codec ~enc:(fun d -> d.nested)

     

       121
        
             |> Jsont.Object.finish

     

       122
        
         end in

     

       123
       +
         let data =

     

       124
       +
           {

     

       125
       +
             M.name = "test";

     

       126
       +
             values = [| 1; 2; 3 |];

     

       127
       +
             nested = { enabled = true; count = 5 };

     

       128
       +
           }

     

       129
       +
         in

     

       130
        
       

     

       131
        
         (* Encode to YAML Block style *)

     

       132
        
         (match Yamlt.encode_string ~format:Yamlt.Block M.data_codec data with

     

       133
       +
         | Ok s -> Printf.printf "YAML Block:\n%s\n" s

     

       134
       +
         | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       135
        
       

     

       136
        
         (* Encode to YAML Flow style *)

     

       137
       +
         match Yamlt.encode_string ~format:Yamlt.Flow M.data_codec data with

     

       138
       +
         | Ok s -> Printf.printf "YAML Flow:\n%s\n" s

     

       139
       +
         | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e

     

       140
        
       

     

       141
        
       (* Test: Comments in YAML (should be ignored) *)

     

       142
        
       let test_comments file =

     

       143
        
         let module M = struct

     

       144
       +
           type config = { host : string; port : int; debug : bool }

     

       145
        
       

     

       146
        
           let config_codec =

     

       147
       +
             Jsont.Object.map ~kind:"Config" (fun host port debug ->

     

       148
       +
                 { host; port; debug })

     

       149
        
             |> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)

     

       150
        
             |> Jsont.Object.mem "port" Jsont.int ~enc:(fun c -> c.port)

     

       151
        
             |> Jsont.Object.mem "debug" Jsont.bool ~enc:(fun c -> c.debug)

     
···

       154
        
           let show c =

     

       155
        
             Printf.sprintf "host=%S, port=%d, debug=%b" c.host c.port c.debug

     

       156
        
         end in

     

       0
        
       
     

       157
        
         let yaml = read_file file in

     

       158
        
         let yaml_result = Yamlt.decode_string M.config_codec yaml in

     

       159
        
       

     
···

       164
        
       (* Test: Empty documents and null documents *)

     

       165
        
       let test_empty_document file =

     

       166
        
         let module M = struct

     

       167
       +
           type wrapper = { value : string option }

     

       168
        
       

     

       169
        
           let wrapper_codec =

     

       170
        
             Jsont.Object.map ~kind:"Wrapper" (fun value -> { value })

     

       171
       +
             |> Jsont.Object.mem "value" (Jsont.some Jsont.string) ~enc:(fun w ->

     

       172
       +
                 w.value)

     

       173
        
             |> Jsont.Object.finish

     

       174
        
       

     

       175
        
           let show w =

     
···

       177
        
             | None -> "value=None"

     

       178
        
             | Some s -> Printf.sprintf "value=Some(%S)" s

     

       179
        
         end in

     

       0
        
       
     

       180
        
         let yaml = read_file file in

     

       181
        
         let json = read_file (file ^ ".json") in

     

       182
        
         let json_result = Jsont_bytesrw.decode_string M.wrapper_codec json in

     
···

       189
        
       (* Test: Explicit typing with tags (if supported) *)

     

       190
        
       let test_explicit_tags file =

     

       191
        
         let module M = struct

     

       192
       +
           type value_holder = { data : string }

     

       193
        
       

     

       194
        
           let value_codec =

     

       195
        
             Jsont.Object.map ~kind:"ValueHolder" (fun data -> { data })

     
···

       198
        
       

     

       199
        
           let show v = Printf.sprintf "data=%S" v.data

     

       200
        
         end in

     

       0
        
       
     

       201
        
         let yaml = read_file file in

     

       202
        
         let yaml_result = Yamlt.decode_string M.value_codec yaml in

     

       203
        
       

     
···

       216
        
         match Sys.argv.(1) with

     

       217
        
         | "literal" when Stdlib.Array.length Sys.argv = 3 ->

     

       218
        
             test_literal_string Sys.argv.(2)

     

       0
        
       
     

       219
        
         | "folded" when Stdlib.Array.length Sys.argv = 3 ->

     

       220
        
             test_folded_string Sys.argv.(2)

     

       0
        
       
     

       221
        
         | "number-formats" when Stdlib.Array.length Sys.argv = 3 ->

     

       222
        
             test_number_formats Sys.argv.(2)

     

       0
        
       
     

       223
        
         | "encode-styles" when Stdlib.Array.length Sys.argv = 2 ->

     

       224
        
             test_encode_styles ()

     

       0
        
       
     

       225
        
         | "comments" when Stdlib.Array.length Sys.argv = 3 ->

     

       226
        
             test_comments Sys.argv.(2)

     

       0
        
       
     

       227
        
         | "empty-doc" when Stdlib.Array.length Sys.argv = 3 ->

     

       228
        
             test_empty_document Sys.argv.(2)

     

       0
        
       
     

       229
        
         | "explicit-tags" when Stdlib.Array.length Sys.argv = 3 ->

     

       230
        
             test_explicit_tags Sys.argv.(2)

     

       0
        
       
     

       231
        
         | _ ->

     

       232
        
             prerr_endline usage;

     

       233
        
             prerr_endline "Commands:";

     

       234
        
             prerr_endline "  literal <file>         - Test literal multi-line strings";

     

       235
        
             prerr_endline "  folded <file>          - Test folded multi-line strings";

     

       236
       +
             prerr_endline

     

       237
       +
               "  number-formats <file>  - Test hex/octal/binary number formats";

     

       238
        
             prerr_endline "  encode-styles          - Test block vs flow encoding";

     

       239
        
             prerr_endline "  comments <file>        - Test YAML with comments";

     

       240
        
             prerr_endline "  empty-doc <file>       - Test empty documents";

+65 -61

tests/bin/test_locations.ml

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       -
          Copyright (c) 2024 The yamlrw programmers. All rights reserved.

     

       3
       -
          SPDX-License-Identifier: ISC

     

       4
       -
         ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test location and layout preservation options with Yamlt codec *)

     

       7
        
       

     
···

       44
        
       

     

       45
        
         (* Nested object codec *)

     

       46
        
         let address_codec =

     

       47
       -
           Jsont.Object.map ~kind:"Address" (fun street city zip -> (street, city, zip))

     

       48
       -
           |> Jsont.Object.mem "street" Jsont.string ~enc:(fun (s,_,_) -> s)

     

       49
       -
           |> Jsont.Object.mem "city" Jsont.string ~enc:(fun (_,c,_) -> c)

     

       50
       -
           |> Jsont.Object.mem "zip" Jsont.int ~enc:(fun (_,_,z) -> z)

     

       0
        
       
     

       51
        
           |> Jsont.Object.finish

     

       52
        
         in

     

       53
        
       

     
···

       98
        
       

     

       99
        
         Printf.printf "=== Without layout (default) ===\n";

     

       100
        
         (match Yamlt.decode_string ~layout:false codec yaml with

     

       101
       -
          | Ok (host, port) ->

     

       102
       -
              Printf.printf "Decoded: host=%s, port=%d\n" host port;

     

       103
       -
              Printf.printf "Meta preserved: no\n"

     

       104
       -
          | Error e -> Printf.printf "Error: %s\n" e);

     

       105
        
       

     

       106
        
         Printf.printf "\n=== With layout=true ===\n";

     

       107
       -
         (match Yamlt.decode_string ~layout:true codec yaml with

     

       108
       -
          | Ok (host, port) ->

     

       109
       -
              Printf.printf "Decoded: host=%s, port=%d\n" host port;

     

       110
       -
              Printf.printf "Meta preserved: yes (style info available for round-tripping)\n"

     

       111
       -
          | Error e -> Printf.printf "Error: %s\n" e)

     

       0
        
       
     

       112
        
       

     

       113
        
       (* Test: Round-trip with layout preservation *)

     

       114
        
       let test_roundtrip_layout file =

     
···

       125
        
       

     

       126
        
         Printf.printf "\n=== Decode without layout, re-encode ===\n";

     

       127
        
         (match Yamlt.decode_string ~layout:false codec yaml with

     

       128
       -
          | Ok items ->

     

       129
       -
              (match Yamlt.encode_string ~format:Yamlt.Block codec items with

     

       130
       -
               | Ok yaml_out -> Printf.printf "%s" yaml_out

     

       131
       -
               | Error e -> Printf.printf "Encode error: %s\n" e)

     

       132
       -
          | Error e -> Printf.printf "Decode error: %s\n" e);

     

       133
        
       

     

       134
       -
         Printf.printf "\n=== Decode with layout=true, re-encode with Layout format ===\n";

     

       135
       -
         (match Yamlt.decode_string ~layout:true codec yaml with

     

       136
       -
          | Ok items ->

     

       137
       -
              (match Yamlt.encode_string ~format:Yamlt.Layout codec items with

     

       138
       -
               | Ok yaml_out -> Printf.printf "%s" yaml_out

     

       139
       -
               | Error e -> Printf.printf "Encode error: %s\n" e)

     

       140
       -
          | Error e -> Printf.printf "Decode error: %s\n" e)

     

       0
        
       
     

       141
        
       

     

       142
        
       (* Test: File path in error messages *)

     

       143
        
       let test_file_path () =

     
···

       164
        
       

     

       165
        
         let codec =

     

       166
        
           Jsont.Object.map ~kind:"Complete" (fun a b c -> (a, b, c))

     

       167
       -
           |> Jsont.Object.mem "field_a" Jsont.string ~enc:(fun (a,_,_) -> a)

     

       168
       -
           |> Jsont.Object.mem "field_b" Jsont.int ~enc:(fun (_,b,_) -> b)

     

       169
       -
           |> Jsont.Object.mem "field_c" Jsont.bool ~enc:(fun (_,_,c) -> c)

     

       170
        
           |> Jsont.Object.finish

     

       171
        
         in

     

       172
        
       

     
···

       183
        
         let yaml = read_file file in

     

       184
        
       

     

       185
        
         let codec =

     

       186
       -
           Jsont.Object.map ~kind:"Settings" (fun timeout retries -> (timeout, retries))

     

       0
        
       
     

       187
        
           |> Jsont.Object.mem "timeout" Jsont.int ~enc:fst

     

       188
        
           |> Jsont.Object.mem "retries" Jsont.int ~enc:snd

     

       189
        
           |> Jsont.Object.finish

     
···

       191
        
       

     

       192
        
         Printf.printf "=== locs=false, layout=false (defaults) ===\n";

     

       193
        
         (match Yamlt.decode_string ~locs:false ~layout:false codec yaml with

     

       194
       -
          | Ok (timeout, retries) ->

     

       195
       -
              Printf.printf "OK: timeout=%d, retries=%d\n" timeout retries

     

       196
       -
          | Error e -> Printf.printf "Error: %s\n" e);

     

       197
        
       

     

       198
        
         Printf.printf "\n=== locs=true, layout=false ===\n";

     

       199
        
         (match Yamlt.decode_string ~locs:true ~layout:false codec yaml with

     

       200
       -
          | Ok (timeout, retries) ->

     

       201
       -
              Printf.printf "OK: timeout=%d, retries=%d (with precise locations)\n" timeout retries

     

       202
       -
          | Error e -> Printf.printf "Error: %s\n" e);

     

       0
        
       
     

       203
        
       

     

       204
        
         Printf.printf "\n=== locs=false, layout=true ===\n";

     

       205
        
         (match Yamlt.decode_string ~locs:false ~layout:true codec yaml with

     

       206
       -
          | Ok (timeout, retries) ->

     

       207
       -
              Printf.printf "OK: timeout=%d, retries=%d (with layout metadata)\n" timeout retries

     

       208
       -
          | Error e -> Printf.printf "Error: %s\n" e);

     

       0
        
       
     

       209
        
       

     

       210
        
         Printf.printf "\n=== locs=true, layout=true (both enabled) ===\n";

     

       211
       -
         (match Yamlt.decode_string ~locs:true ~layout:true codec yaml with

     

       212
       -
          | Ok (timeout, retries) ->

     

       213
       -
              Printf.printf "OK: timeout=%d, retries=%d (with locations and layout)\n" timeout retries

     

       214
       -
          | Error e -> Printf.printf "Error: %s\n" e)

     

       0
        
       
     

       215
        
       

     

       216
        
       let () =

     

       217
        
         let usage = "Usage: test_locations <command> [args...]" in

     
···

       224
        
         match Sys.argv.(1) with

     

       225
        
         | "error-precision" when Array.length Sys.argv = 3 ->

     

       226
        
             test_error_precision Sys.argv.(2)

     

       227
       -
       

     

       228
        
         | "nested-error" when Array.length Sys.argv = 3 ->

     

       229
        
             test_nested_error Sys.argv.(2)

     

       230
       -
       

     

       231
        
         | "array-error" when Array.length Sys.argv = 3 ->

     

       232
        
             test_array_error Sys.argv.(2)

     

       233
       -
       

     

       234
        
         | "layout" when Array.length Sys.argv = 3 ->

     

       235
        
             test_layout_preservation Sys.argv.(2)

     

       236
       -
       

     

       237
        
         | "roundtrip" when Array.length Sys.argv = 3 ->

     

       238
        
             test_roundtrip_layout Sys.argv.(2)

     

       239
       -
       

     

       240
       -
         | "file-path" ->

     

       241
       -
             test_file_path ()

     

       242
       -
       

     

       243
        
         | "missing-field" when Array.length Sys.argv = 3 ->

     

       244
        
             test_missing_field Sys.argv.(2)

     

       245
       -
       

     

       246
        
         | "combined" when Array.length Sys.argv = 3 ->

     

       247
        
             test_combined_options Sys.argv.(2)

     

       248
       -
       

     

       249
        
         | _ ->

     

       250
        
             prerr_endline usage;

     

       251
        
             prerr_endline "Commands:";

     

       252
       -
             prerr_endline "  error-precision <file>   - Compare error messages with/without locs";

     

       253
       -
             prerr_endline "  nested-error <file>      - Test error locations in nested objects";

     

       254
       -
             prerr_endline "  array-error <file>       - Test error locations in arrays";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       255
        
             prerr_endline "  layout <file>            - Test layout preservation";

     

       256
       -
             prerr_endline "  roundtrip <file>         - Test round-tripping with layout";

     

       257
       -
             prerr_endline "  file-path                - Test file path in error messages";

     

       258
       -
             prerr_endline "  missing-field <file>     - Test missing field errors with locs";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       259
        
             prerr_endline "  combined <file>          - Test locs and layout together";

     

       260
        
             exit 1

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test location and layout preservation options with Yamlt codec *)

     

       7
        
       

     
···

       44
        
       

     

       45
        
         (* Nested object codec *)

     

       46
        
         let address_codec =

     

       47
       +
           Jsont.Object.map ~kind:"Address" (fun street city zip ->

     

       48
       +
               (street, city, zip))

     

       49
       +
           |> Jsont.Object.mem "street" Jsont.string ~enc:(fun (s, _, _) -> s)

     

       50
       +
           |> Jsont.Object.mem "city" Jsont.string ~enc:(fun (_, c, _) -> c)

     

       51
       +
           |> Jsont.Object.mem "zip" Jsont.int ~enc:(fun (_, _, z) -> z)

     

       52
        
           |> Jsont.Object.finish

     

       53
        
         in

     

       54
        
       

     
···

       99
        
       

     

       100
        
         Printf.printf "=== Without layout (default) ===\n";

     

       101
        
         (match Yamlt.decode_string ~layout:false codec yaml with

     

       102
       +
         | Ok (host, port) ->

     

       103
       +
             Printf.printf "Decoded: host=%s, port=%d\n" host port;

     

       104
       +
             Printf.printf "Meta preserved: no\n"

     

       105
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       106
        
       

     

       107
        
         Printf.printf "\n=== With layout=true ===\n";

     

       108
       +
         match Yamlt.decode_string ~layout:true codec yaml with

     

       109
       +
         | Ok (host, port) ->

     

       110
       +
             Printf.printf "Decoded: host=%s, port=%d\n" host port;

     

       111
       +
             Printf.printf

     

       112
       +
               "Meta preserved: yes (style info available for round-tripping)\n"

     

       113
       +
         | Error e -> Printf.printf "Error: %s\n" e

     

       114
        
       

     

       115
        
       (* Test: Round-trip with layout preservation *)

     

       116
        
       let test_roundtrip_layout file =

     
···

       127
        
       

     

       128
        
         Printf.printf "\n=== Decode without layout, re-encode ===\n";

     

       129
        
         (match Yamlt.decode_string ~layout:false codec yaml with

     

       130
       +
         | Ok items -> (

     

       131
       +
             match Yamlt.encode_string ~format:Yamlt.Block codec items with

     

       132
       +
             | Ok yaml_out -> Printf.printf "%s" yaml_out

     

       133
       +
             | Error e -> Printf.printf "Encode error: %s\n" e)

     

       134
       +
         | Error e -> Printf.printf "Decode error: %s\n" e);

     

       135
        
       

     

       136
       +
         Printf.printf

     

       137
       +
           "\n=== Decode with layout=true, re-encode with Layout format ===\n";

     

       138
       +
         match Yamlt.decode_string ~layout:true codec yaml with

     

       139
       +
         | Ok items -> (

     

       140
       +
             match Yamlt.encode_string ~format:Yamlt.Layout codec items with

     

       141
       +
             | Ok yaml_out -> Printf.printf "%s" yaml_out

     

       142
       +
             | Error e -> Printf.printf "Encode error: %s\n" e)

     

       143
       +
         | Error e -> Printf.printf "Decode error: %s\n" e

     

       144
        
       

     

       145
        
       (* Test: File path in error messages *)

     

       146
        
       let test_file_path () =

     
···

       167
        
       

     

       168
        
         let codec =

     

       169
        
           Jsont.Object.map ~kind:"Complete" (fun a b c -> (a, b, c))

     

       170
       +
           |> Jsont.Object.mem "field_a" Jsont.string ~enc:(fun (a, _, _) -> a)

     

       171
       +
           |> Jsont.Object.mem "field_b" Jsont.int ~enc:(fun (_, b, _) -> b)

     

       172
       +
           |> Jsont.Object.mem "field_c" Jsont.bool ~enc:(fun (_, _, c) -> c)

     

       173
        
           |> Jsont.Object.finish

     

       174
        
         in

     

       175
        
       

     
···

       186
        
         let yaml = read_file file in

     

       187
        
       

     

       188
        
         let codec =

     

       189
       +
           Jsont.Object.map ~kind:"Settings" (fun timeout retries ->

     

       190
       +
               (timeout, retries))

     

       191
        
           |> Jsont.Object.mem "timeout" Jsont.int ~enc:fst

     

       192
        
           |> Jsont.Object.mem "retries" Jsont.int ~enc:snd

     

       193
        
           |> Jsont.Object.finish

     
···

       195
        
       

     

       196
        
         Printf.printf "=== locs=false, layout=false (defaults) ===\n";

     

       197
        
         (match Yamlt.decode_string ~locs:false ~layout:false codec yaml with

     

       198
       +
         | Ok (timeout, retries) ->

     

       199
       +
             Printf.printf "OK: timeout=%d, retries=%d\n" timeout retries

     

       200
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       201
        
       

     

       202
        
         Printf.printf "\n=== locs=true, layout=false ===\n";

     

       203
        
         (match Yamlt.decode_string ~locs:true ~layout:false codec yaml with

     

       204
       +
         | Ok (timeout, retries) ->

     

       205
       +
             Printf.printf "OK: timeout=%d, retries=%d (with precise locations)\n"

     

       206
       +
               timeout retries

     

       207
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       208
        
       

     

       209
        
         Printf.printf "\n=== locs=false, layout=true ===\n";

     

       210
        
         (match Yamlt.decode_string ~locs:false ~layout:true codec yaml with

     

       211
       +
         | Ok (timeout, retries) ->

     

       212
       +
             Printf.printf "OK: timeout=%d, retries=%d (with layout metadata)\n"

     

       213
       +
               timeout retries

     

       214
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       215
        
       

     

       216
        
         Printf.printf "\n=== locs=true, layout=true (both enabled) ===\n";

     

       217
       +
         match Yamlt.decode_string ~locs:true ~layout:true codec yaml with

     

       218
       +
         | Ok (timeout, retries) ->

     

       219
       +
             Printf.printf "OK: timeout=%d, retries=%d (with locations and layout)\n"

     

       220
       +
               timeout retries

     

       221
       +
         | Error e -> Printf.printf "Error: %s\n" e

     

       222
        
       

     

       223
        
       let () =

     

       224
        
         let usage = "Usage: test_locations <command> [args...]" in

     
···

       231
        
         match Sys.argv.(1) with

     

       232
        
         | "error-precision" when Array.length Sys.argv = 3 ->

     

       233
        
             test_error_precision Sys.argv.(2)

     

       0
        
       
     

       234
        
         | "nested-error" when Array.length Sys.argv = 3 ->

     

       235
        
             test_nested_error Sys.argv.(2)

     

       0
        
       
     

       236
        
         | "array-error" when Array.length Sys.argv = 3 ->

     

       237
        
             test_array_error Sys.argv.(2)

     

       0
        
       
     

       238
        
         | "layout" when Array.length Sys.argv = 3 ->

     

       239
        
             test_layout_preservation Sys.argv.(2)

     

       0
        
       
     

       240
        
         | "roundtrip" when Array.length Sys.argv = 3 ->

     

       241
        
             test_roundtrip_layout Sys.argv.(2)

     

       242
       +
         | "file-path" -> test_file_path ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       243
        
         | "missing-field" when Array.length Sys.argv = 3 ->

     

       244
        
             test_missing_field Sys.argv.(2)

     

       0
        
       
     

       245
        
         | "combined" when Array.length Sys.argv = 3 ->

     

       246
        
             test_combined_options Sys.argv.(2)

     

       0
        
       
     

       247
        
         | _ ->

     

       248
        
             prerr_endline usage;

     

       249
        
             prerr_endline "Commands:";

     

       250
       +
             prerr_endline

     

       251
       +
               "  error-precision <file>   - Compare error messages with/without locs";

     

       252
       +
             prerr_endline

     

       253
       +
               "  nested-error <file>      - Test error locations in nested objects";

     

       254
       +
             prerr_endline

     

       255
       +
               "  array-error <file>       - Test error locations in arrays";

     

       256
        
             prerr_endline "  layout <file>            - Test layout preservation";

     

       257
       +
             prerr_endline

     

       258
       +
               "  roundtrip <file>         - Test round-tripping with layout";

     

       259
       +
             prerr_endline

     

       260
       +
               "  file-path                - Test file path in error messages";

     

       261
       +
             prerr_endline

     

       262
       +
               "  missing-field <file>     - Test missing field errors with locs";

     

       263
        
             prerr_endline "  combined <file>          - Test locs and layout together";

     

       264
        
             exit 1

+13 -9

tests/bin/test_null_complete.ml

···

       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);

     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       0
        
       
     

       18
        
       

     

       19
        
         Printf.printf "\n=== Test 3: Jsont.string with YAML null (should error) ===\n";

     

       20
        
         let codec2 =

     
···

       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)

···

       8
        
           |> Object.finish

     

       9
        
         in

     

       10
        
         (match Yamlt.decode_string codec1 yaml1 with

     

       11
       +
         | Ok v ->

     

       12
       +
             Printf.printf "Result: %s\n"

     

       13
       +
               (match v with None -> "None" | Some s -> "Some(" ^ s ^ ")")

     

       14
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       15
        
       

     

       16
        
         Printf.printf "\n=== Test 2: Jsont.option with YAML string ===\n";

     

       17
        
         (match Yamlt.decode_string codec1 "value: hello" with

     

       18
       +
         | Ok v ->

     

       19
       +
             Printf.printf "Result: %s\n"

     

       20
       +
               (match v with None -> "None" | Some s -> "Some(" ^ s ^ ")")

     

       21
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       22
        
       

     

       23
        
         Printf.printf "\n=== Test 3: Jsont.string with YAML null (should error) ===\n";

     

       24
        
         let codec2 =

     
···

       28
        
           |> Object.finish

     

       29
        
         in

     

       30
        
         (match Yamlt.decode_string codec2 "value: null" with

     

       31
       +
         | Ok v -> Printf.printf "Result: %s\n" v

     

       32
       +
         | Error e -> Printf.printf "Error (expected): %s\n" e);

     

       33
        
       

     

       34
        
         Printf.printf "\n=== Test 4: Jsont.string with YAML string ===\n";

     

       35
       +
         match Yamlt.decode_string codec2 "value: hello" with

     

       36
       +
         | Ok v -> Printf.printf "Result: %s\n" v

     

       37
       +
         | Error e -> Printf.printf "Error: %s\n" e

+17 -16

tests/bin/test_null_fix.ml

···

       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)

     

       0
        
       
     

       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;

     

       0
        
       
     

       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

···

       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 ->

     

       10
       +
                 d.value)

     

       11
        
             |> Jsont.Object.finish

     

       12
        
         end in

     

       0
        
       
     

       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 -> (

     

       23
       +
             Printf.printf "YAML ERROR: %s\n" e;

     

       24
        
       

     

       25
       +
             let json_null = "{\"value\": null}" in

     

       26
       +
             match Jsont_bytesrw.decode_string M.data_codec json_null with

     

       27
       +
             | Ok data -> (

     

       28
       +
                 match data.M.value with

     

       29
       +
                 | None -> Printf.printf "JSON: value=None (CORRECT)\n"

     

       30
       +
                 | Some s -> Printf.printf "JSON: value=Some(%S) (BUG!)\n" s)

     

       31
       +
             | Error e -> Printf.printf "JSON ERROR: %s\n" e)

+54 -65

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
        
       

     
···

       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 })

     
···

       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

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     
···

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     
···

       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

     
···

       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

     
···

       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 })

     
···

       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

     
···

       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 })

     
···

       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

     
···

       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 })

     
···

       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

     
···

       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 })

     

       0
        
       
     

       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

     
···

       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:";

     
···

       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";

     

       0
        
       
     

       301
        
             prerr_endline "  encode                  - Test encoding objects";

     

       302
        
             exit 1

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test object codec functionality with Yamlt *)

     

       7
        
       

     
···

       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 })

     
···

       37
        
       

     

       38
        
           let show p = Printf.sprintf "{name=%S; age=%d}" p.name p.age

     

       39
        
         end in

     

       0
        
       
     

       40
        
         let yaml = read_file file in

     

       41
        
         let json = read_file (file ^ ".json") in

     

       42
        
         let json_result = Jsont_bytesrw.decode_string M.person_codec json in

     
···

       49
        
       (* Test: Object with optional fields *)

     

       50
        
       let test_optional_fields file =

     

       51
        
         let module M = struct

     

       52
       +
           type config = { host : string; port : int option; debug : bool option }

     

       53
        
       

     

       54
        
           let config_codec =

     

       55
       +
             Jsont.Object.map ~kind:"Config" (fun host port debug ->

     

       56
       +
                 { host; port; debug })

     

       57
        
             |> Jsont.Object.mem "host" Jsont.string ~enc:(fun c -> c.host)

     

       58
        
             |> Jsont.Object.opt_mem "port" Jsont.int ~enc:(fun c -> c.port)

     

       59
        
             |> Jsont.Object.opt_mem "debug" Jsont.bool ~enc:(fun c -> c.debug)

     

       60
        
             |> Jsont.Object.finish

     

       61
        
       

     

       62
        
           let show c =

     

       63
       +
             Printf.sprintf "{host=%S; port=%s; debug=%s}" c.host

     

       64
       +
               (match c.port with

     

       65
       +
               | None -> "None"

     

       66
       +
               | Some p -> Printf.sprintf "Some %d" p)

     

       67
       +
               (match c.debug with

     

       68
       +
               | None -> "None"

     

       69
       +
               | Some b -> Printf.sprintf "Some %b" b)

     

       70
        
         end in

     

       0
        
       
     

       71
        
         let yaml = read_file file in

     

       72
        
         let json = read_file (file ^ ".json") in

     

       73
        
         let json_result = Jsont_bytesrw.decode_string M.config_codec json in

     
···

       80
        
       (* Test: Object with default values *)

     

       81
        
       let test_default_values file =

     

       82
        
         let module M = struct

     

       83
       +
           type settings = { timeout : int; retries : int; verbose : bool }

     

       84
        
       

     

       85
        
           let settings_codec =

     

       86
       +
             Jsont.Object.map ~kind:"Settings" (fun timeout retries verbose ->

     

       87
       +
                 { timeout; retries; verbose })

     

       88
       +
             |> Jsont.Object.mem "timeout" Jsont.int

     

       89
       +
                  ~enc:(fun s -> s.timeout)

     

       90
       +
                  ~dec_absent:30

     

       91
       +
             |> Jsont.Object.mem "retries" Jsont.int

     

       92
       +
                  ~enc:(fun s -> s.retries)

     

       93
       +
                  ~dec_absent:3

     

       94
       +
             |> Jsont.Object.mem "verbose" Jsont.bool

     

       95
       +
                  ~enc:(fun s -> s.verbose)

     

       96
       +
                  ~dec_absent:false

     

       97
        
             |> Jsont.Object.finish

     

       98
        
       

     

       99
        
           let show s =

     

       100
       +
             Printf.sprintf "{timeout=%d; retries=%d; verbose=%b}" s.timeout s.retries

     

       101
       +
               s.verbose

     

       102
        
         end in

     

       0
        
       
     

       103
        
         let yaml = read_file file in

     

       104
        
         let json = read_file (file ^ ".json") in

     

       105
        
         let json_result = Jsont_bytesrw.decode_string M.settings_codec json in

     
···

       112
        
       (* Test: Nested objects *)

     

       113
        
       let test_nested_objects file =

     

       114
        
         let module M = struct

     

       115
       +
           type address = { street : string; city : string; zip : string }

     

       116
       +
           type employee = { name : string; address : address }

     

       117
        
       

     

       118
        
           let address_codec =

     

       119
       +
             Jsont.Object.map ~kind:"Address" (fun street city zip ->

     

       120
       +
                 { street; city; zip })

     

       121
        
             |> Jsont.Object.mem "street" Jsont.string ~enc:(fun a -> a.street)

     

       122
        
             |> Jsont.Object.mem "city" Jsont.string ~enc:(fun a -> a.city)

     

       123
        
             |> Jsont.Object.mem "zip" Jsont.string ~enc:(fun a -> a.zip)

     

       124
        
             |> Jsont.Object.finish

     

       125
        
       

     

       126
        
           let employee_codec =

     

       127
       +
             Jsont.Object.map ~kind:"Employee" (fun name address -> { name; address })

     

       0
        
       
     

       128
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun e -> e.name)

     

       129
        
             |> Jsont.Object.mem "address" address_codec ~enc:(fun e -> e.address)

     

       130
        
             |> Jsont.Object.finish

     

       131
        
       

     

       132
        
           let show e =

     

       133
       +
             Printf.sprintf "{name=%S; address={street=%S; city=%S; zip=%S}}" e.name

     

       134
       +
               e.address.street e.address.city e.address.zip

     

       135
        
         end in

     

       0
        
       
     

       136
        
         let yaml = read_file file in

     

       137
        
         let json = read_file (file ^ ".json") in

     

       138
        
         let json_result = Jsont_bytesrw.decode_string M.employee_codec json in

     
···

       145
        
       (* Test: Unknown member handling - error *)

     

       146
        
       let test_unknown_members_error file =

     

       147
        
         let module M = struct

     

       148
       +
           type strict = { name : string }

     

       149
        
       

     

       150
        
           let strict_codec =

     

       151
        
             Jsont.Object.map ~kind:"Strict" (fun name -> { name })

     

       152
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun s -> s.name)

     

       153
        
             |> Jsont.Object.finish

     

       154
        
         end in

     

       0
        
       
     

       155
        
         let yaml = read_file file in

     

       156
        
         let result = Yamlt.decode_string M.strict_codec yaml in

     

       157
        
         match result with

     
···

       161
        
       (* Test: Unknown member handling - keep *)

     

       162
        
       let test_unknown_members_keep file =

     

       163
        
         let module M = struct

     

       164
       +
           type flexible = { name : string; extra : Jsont.json }

     

       165
        
       

     

       166
        
           let flexible_codec =

     

       167
        
             Jsont.Object.map ~kind:"Flexible" (fun name extra -> { name; extra })

     
···

       169
        
             |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun f -> f.extra)

     

       170
        
             |> Jsont.Object.finish

     

       171
        
       

     

       172
       +
           let show f = Printf.sprintf "{name=%S; has_extra=true}" f.name

     

       0
        
       
     

       173
        
         end in

     

       0
        
       
     

       174
        
         let yaml = read_file file in

     

       175
        
         let json = read_file (file ^ ".json") in

     

       176
        
         let json_result = Jsont_bytesrw.decode_string M.flexible_codec json in

     
···

       183
        
       (* Test: Object cases (discriminated unions) - simplified version *)

     

       184
        
       let test_object_cases file =

     

       185
        
         let module M = struct

     

       186
       +
           type circle = { type_ : string; radius : float }

     

       187
        
       

     

       188
        
           let circle_codec =

     

       189
        
             Jsont.Object.map ~kind:"Circle" (fun type_ radius -> { type_; radius })

     
···

       191
        
             |> Jsont.Object.mem "radius" Jsont.number ~enc:(fun c -> c.radius)

     

       192
        
             |> Jsont.Object.finish

     

       193
        
       

     

       194
       +
           let show c = Printf.sprintf "Circle{radius=%.2f}" c.radius

     

       0
        
       
     

       195
        
         end in

     

       0
        
       
     

       196
        
         let yaml = read_file file in

     

       197
        
         let json = read_file (file ^ ".json") in

     

       198
        
         let json_result = Jsont_bytesrw.decode_string M.circle_codec json in

     
···

       205
        
       (* Test: Missing required field error *)

     

       206
        
       let test_missing_required file =

     

       207
        
         let module M = struct

     

       208
       +
           type required = { name : string; age : int }

     

       209
        
       

     

       210
        
           let required_codec =

     

       211
        
             Jsont.Object.map ~kind:"Required" (fun name age -> { name; age })

     
···

       213
        
             |> Jsont.Object.mem "age" Jsont.int ~enc:(fun r -> r.age)

     

       214
        
             |> Jsont.Object.finish

     

       215
        
         end in

     

       0
        
       
     

       216
        
         let yaml = read_file file in

     

       217
        
         let result = Yamlt.decode_string M.required_codec yaml in

     

       218
        
         match result with

     
···

       222
        
       (* Test: Encoding objects to different formats *)

     

       223
        
       let test_encode_object () =

     

       224
        
         let module M = struct

     

       225
       +
           type person = { name : string; age : int; active : bool }

     

       226
        
       

     

       227
        
           let person_codec =

     

       228
       +
             Jsont.Object.map ~kind:"Person" (fun name age active ->

     

       229
       +
                 { name; age; active })

     

       230
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)

     

       231
        
             |> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)

     

       232
        
             |> Jsont.Object.mem "active" Jsont.bool ~enc:(fun p -> p.active)

     

       233
        
             |> Jsont.Object.finish

     

       234
        
         end in

     

       0
        
       
     

       235
        
         let person = M.{ name = "Alice"; age = 30; active = true } in

     

       236
        
       

     

       237
        
         (* Encode to JSON *)

     

       238
        
         (match Jsont_bytesrw.encode_string M.person_codec person with

     

       239
       +
         | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       240
       +
         | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       241
        
       

     

       242
        
         (* Encode to YAML Block *)

     

       243
        
         (match Yamlt.encode_string ~format:Yamlt.Block M.person_codec person with

     

       244
       +
         | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       245
       +
         | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       246
        
       

     

       247
        
         (* Encode to YAML Flow *)

     

       248
       +
         match Yamlt.encode_string ~format:Yamlt.Flow M.person_codec person with

     

       249
       +
         | Ok s -> Printf.printf "YAML Flow: %s" s

     

       250
       +
         | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e

     

       251
        
       

     

       252
        
       let () =

     

       253
        
         let usage = "Usage: test_objects <command> [args...]" in

     
···

       260
        
         match Sys.argv.(1) with

     

       261
        
         | "simple" when Stdlib.Array.length Sys.argv = 3 ->

     

       262
        
             test_simple_object Sys.argv.(2)

     

       0
        
       
     

       263
        
         | "optional" when Stdlib.Array.length Sys.argv = 3 ->

     

       264
        
             test_optional_fields Sys.argv.(2)

     

       0
        
       
     

       265
        
         | "defaults" when Stdlib.Array.length Sys.argv = 3 ->

     

       266
        
             test_default_values Sys.argv.(2)

     

       0
        
       
     

       267
        
         | "nested" when Stdlib.Array.length Sys.argv = 3 ->

     

       268
        
             test_nested_objects Sys.argv.(2)

     

       0
        
       
     

       269
        
         | "unknown-error" when Stdlib.Array.length Sys.argv = 3 ->

     

       270
        
             test_unknown_members_error Sys.argv.(2)

     

       0
        
       
     

       271
        
         | "unknown-keep" when Stdlib.Array.length Sys.argv = 3 ->

     

       272
        
             test_unknown_members_keep Sys.argv.(2)

     

       0
        
       
     

       273
        
         | "cases" when Stdlib.Array.length Sys.argv = 3 ->

     

       274
        
             test_object_cases Sys.argv.(2)

     

       0
        
       
     

       275
        
         | "missing-required" when Stdlib.Array.length Sys.argv = 3 ->

     

       276
        
             test_missing_required Sys.argv.(2)

     

       277
       +
         | "encode" when Stdlib.Array.length Sys.argv = 2 -> test_encode_object ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       278
        
         | _ ->

     

       279
        
             prerr_endline usage;

     

       280
        
             prerr_endline "Commands:";

     
···

       285
        
             prerr_endline "  unknown-error <file>    - Test unknown member error";

     

       286
        
             prerr_endline "  unknown-keep <file>     - Test keeping unknown members";

     

       287
        
             prerr_endline "  cases <file>            - Test object cases (unions)";

     

       288
       +
             prerr_endline

     

       289
       +
               "  missing-required <file> - Test missing required field error";

     

       290
        
             prerr_endline "  encode                  - Test encoding objects";

     

       291
        
             exit 1

+6 -5

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)

     

       0
        
       
     

       5
        
           |> Jsont.Object.finish

     

       6
        
         in

     

       7
        
       

     
···

       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

···

       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 ->

     

       5
       +
               arr)

     

       6
        
           |> Jsont.Object.finish

     

       7
        
         in

     

       8
        
       

     
···

       10
        
       

     

       11
        
         Printf.printf "Testing optional array field:\n";

     

       12
        
         match Yamlt.decode_string codec 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

+134 -88

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 })

     
···

       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

     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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 })

     

       0
        
       
     

       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 })

     

       0
        
       
     

       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)

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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 }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       144
        
       

     

       145
        
           let data_codec =

     

       146
       -
             Jsont.Object.map ~kind:"Data" (fun required optional nullable -> { required; optional; nullable })

     

       0
        
       
     

       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)

     

       0
        
       
     

       150
        
             |> Jsont.Object.finish

     

       151
        
       

     

       152
        
           let equal d1 d2 =

     

       153
       -
             d1.required = d2.required && d1.optional = d2.optional && d1.nullable = d2.nullable

     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       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);

     

       0
        
       
     

       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)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       175
        
       

     

       176
        
       let () =

     

       177
        
         let usage = "Usage: test_roundtrip <command>" in

     
···

       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:";

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. 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 })

     
···

       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

     

       0
        
       
     

       24
        
         let original = { M.s = "hello"; n = 42.5; b = true; nul = () } in

     

       25
        
       

     

       26
        
         (* JSON roundtrip *)

     

       27
        
         let json_encoded = Jsont_bytesrw.encode_string M.data_codec original in

     

       28
       +
         let json_decoded =

     

       29
       +
           Result.bind json_encoded (Jsont_bytesrw.decode_string M.data_codec)

     

       30
       +
         in

     

       31
        
         (match json_decoded with

     

       32
       +
         | Ok decoded when M.equal original decoded ->

     

       33
       +
             Printf.printf "JSON roundtrip: PASS\n"

     

       34
       +
         | Ok _ -> Printf.printf "JSON roundtrip: FAIL (data mismatch)\n"

     

       35
       +
         | Error e -> Printf.printf "JSON roundtrip: FAIL (%s)\n" e);

     

       36
        
       

     

       37
        
         (* YAML Block roundtrip *)

     

       38
       +
         let yaml_block_encoded =

     

       39
       +
           Yamlt.encode_string ~format:Yamlt.Block M.data_codec original

     

       40
       +
         in

     

       41
       +
         let yaml_block_decoded =

     

       42
       +
           Result.bind yaml_block_encoded (Yamlt.decode_string M.data_codec)

     

       43
       +
         in

     

       44
        
         (match yaml_block_decoded with

     

       45
       +
         | Ok decoded when M.equal original decoded ->

     

       46
       +
             Printf.printf "YAML Block roundtrip: PASS\n"

     

       47
       +
         | Ok _ -> Printf.printf "YAML Block roundtrip: FAIL (data mismatch)\n"

     

       48
       +
         | Error e -> Printf.printf "YAML Block roundtrip: FAIL (%s)\n" e);

     

       49
        
       

     

       50
        
         (* YAML Flow roundtrip *)

     

       51
       +
         let yaml_flow_encoded =

     

       52
       +
           Yamlt.encode_string ~format:Yamlt.Flow M.data_codec original

     

       53
       +
         in

     

       54
       +
         let yaml_flow_decoded =

     

       55
       +
           Result.bind yaml_flow_encoded (Yamlt.decode_string M.data_codec)

     

       56
       +
         in

     

       57
       +
         match yaml_flow_decoded with

     

       58
       +
         | Ok decoded when M.equal original decoded ->

     

       59
       +
             Printf.printf "YAML Flow roundtrip: PASS\n"

     

       60
       +
         | Ok _ -> Printf.printf "YAML Flow roundtrip: FAIL (data mismatch)\n"

     

       61
       +
         | Error e -> Printf.printf "YAML Flow roundtrip: FAIL (%s)\n" e

     

       62
        
       

     

       63
        
       (* Test: Roundtrip arrays *)

     

       64
        
       let test_array_roundtrip () =

     

       65
        
         let module M = struct

     

       66
       +
           type data = { items : int array; nested : float array array }

     

       67
        
       

     

       68
        
           let data_codec =

     

       69
        
             Jsont.Object.map ~kind:"Data" (fun items nested -> { items; nested })

     

       70
       +
             |> Jsont.Object.mem "items" (Jsont.array Jsont.int) ~enc:(fun d ->

     

       71
       +
                 d.items)

     

       72
       +
             |> Jsont.Object.mem "nested"

     

       73
       +
                  (Jsont.array (Jsont.array Jsont.number))

     

       74
       +
                  ~enc:(fun d -> d.nested)

     

       75
        
             |> Jsont.Object.finish

     

       76
        
       

     

       77
       +
           let equal d1 d2 = d1.items = d2.items && d1.nested = d2.nested

     

       0
        
       
     

       78
        
         end in

     

       79
       +
         let original =

     

       80
       +
           {

     

       81
       +
             M.items = [| 1; 2; 3; 4; 5 |];

     

       82
       +
             nested = [| [| 1.0; 2.0 |]; [| 3.0; 4.0 |] |];

     

       83
       +
           }

     

       84
       +
         in

     

       85
        
       

     

       86
        
         (* JSON roundtrip *)

     

       87
       +
         let json_result =

     

       88
       +
           Result.bind

     

       89
       +
             (Jsont_bytesrw.encode_string M.data_codec original)

     

       90
       +
             (Jsont_bytesrw.decode_string M.data_codec)

     

       91
       +
         in

     

       92
        
         (match json_result with

     

       93
       +
         | Ok decoded when M.equal original decoded ->

     

       94
       +
             Printf.printf "JSON array roundtrip: PASS\n"

     

       95
       +
         | Ok _ -> Printf.printf "JSON array roundtrip: FAIL (data mismatch)\n"

     

       96
       +
         | Error e -> Printf.printf "JSON array roundtrip: FAIL (%s)\n" e);

     

       97
        
       

     

       98
        
         (* YAML roundtrip *)

     

       99
       +
         let yaml_result =

     

       100
       +
           Result.bind

     

       101
       +
             (Yamlt.encode_string M.data_codec original)

     

       102
       +
             (Yamlt.decode_string M.data_codec)

     

       103
       +
         in

     

       104
       +
         match yaml_result with

     

       105
       +
         | Ok decoded when M.equal original decoded ->

     

       106
       +
             Printf.printf "YAML array roundtrip: PASS\n"

     

       107
       +
         | Ok _ -> Printf.printf "YAML array roundtrip: FAIL (data mismatch)\n"

     

       108
       +
         | Error e -> Printf.printf "YAML array roundtrip: FAIL (%s)\n" e

     

       109
        
       

     

       110
        
       (* Test: Roundtrip objects *)

     

       111
        
       let test_object_roundtrip () =

     

       112
        
         let module M = struct

     

       113
       +
           type person = { p_name : string; age : int; active : bool }

     

       114
       +
           type company = { c_name : string; employees : person array }

     

       115
        
       

     

       116
        
           let person_codec =

     

       117
       +
             Jsont.Object.map ~kind:"Person" (fun p_name age active ->

     

       118
       +
                 { p_name; age; active })

     

       119
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.p_name)

     

       120
        
             |> Jsont.Object.mem "age" Jsont.int ~enc:(fun p -> p.age)

     

       121
        
             |> Jsont.Object.mem "active" Jsont.bool ~enc:(fun p -> p.active)

     

       122
        
             |> Jsont.Object.finish

     

       123
        
       

     

       124
        
           let company_codec =

     

       125
       +
             Jsont.Object.map ~kind:"Company" (fun c_name employees ->

     

       126
       +
                 { c_name; employees })

     

       127
        
             |> Jsont.Object.mem "name" Jsont.string ~enc:(fun c -> c.c_name)

     

       128
       +
             |> Jsont.Object.mem "employees" (Jsont.array person_codec) ~enc:(fun c ->

     

       129
       +
                 c.employees)

     

       130
        
             |> Jsont.Object.finish

     

       131
        
       

     

       132
        
           let person_equal p1 p2 =

     

       133
        
             p1.p_name = p2.p_name && p1.age = p2.age && p1.active = p2.active

     

       134
        
       

     

       135
        
           let equal c1 c2 =

     

       136
       +
             c1.c_name = c2.c_name

     

       137
       +
             && Stdlib.Array.length c1.employees = Stdlib.Array.length c2.employees

     

       138
       +
             && Stdlib.Array.for_all2 person_equal c1.employees c2.employees

     

       139
        
         end in

     

       140
       +
         let original =

     

       141
       +
           {

     

       142
       +
             M.c_name = "Acme Corp";

     

       143
       +
             employees =

     

       144
       +
               [|

     

       145
       +
                 { p_name = "Alice"; age = 30; active = true };

     

       146
       +
                 { p_name = "Bob"; age = 25; active = false };

     

       147
       +
               |];

     

       148
       +
           }

     

       149
       +
         in

     

       150
        
       

     

       151
        
         (* JSON roundtrip *)

     

       152
       +
         let json_result =

     

       153
       +
           Result.bind

     

       154
       +
             (Jsont_bytesrw.encode_string M.company_codec original)

     

       155
       +
             (Jsont_bytesrw.decode_string M.company_codec)

     

       156
       +
         in

     

       157
        
         (match json_result with

     

       158
       +
         | Ok decoded when M.equal original decoded ->

     

       159
       +
             Printf.printf "JSON object roundtrip: PASS\n"

     

       160
       +
         | Ok _ -> Printf.printf "JSON object roundtrip: FAIL (data mismatch)\n"

     

       161
       +
         | Error e -> Printf.printf "JSON object roundtrip: FAIL (%s)\n" e);

     

       162
        
       

     

       163
        
         (* YAML roundtrip *)

     

       164
       +
         let yaml_result =

     

       165
       +
           Result.bind

     

       166
       +
             (Yamlt.encode_string M.company_codec original)

     

       167
       +
             (Yamlt.decode_string M.company_codec)

     

       168
       +
         in

     

       169
       +
         match yaml_result with

     

       170
       +
         | Ok decoded when M.equal original decoded ->

     

       171
       +
             Printf.printf "YAML object roundtrip: PASS\n"

     

       172
       +
         | Ok _ -> Printf.printf "YAML object roundtrip: FAIL (data mismatch)\n"

     

       173
       +
         | Error e -> Printf.printf "YAML object roundtrip: FAIL (%s)\n" e

     

       174
        
       

     

       175
        
       (* Test: Roundtrip with optionals *)

     

       176
        
       let test_optional_roundtrip () =

     

       177
        
         let module M = struct

     

       178
       +
           type data = {

     

       179
       +
             required : string;

     

       180
       +
             optional : int option;

     

       181
       +
             nullable : string option;

     

       182
       +
           }

     

       183
        
       

     

       184
        
           let data_codec =

     

       185
       +
             Jsont.Object.map ~kind:"Data" (fun required optional nullable ->

     

       186
       +
                 { required; optional; nullable })

     

       187
        
             |> Jsont.Object.mem "required" Jsont.string ~enc:(fun d -> d.required)

     

       188
        
             |> Jsont.Object.opt_mem "optional" Jsont.int ~enc:(fun d -> d.optional)

     

       189
       +
             |> Jsont.Object.mem "nullable" (Jsont.some Jsont.string) ~enc:(fun d ->

     

       190
       +
                 d.nullable)

     

       191
        
             |> Jsont.Object.finish

     

       192
        
       

     

       193
        
           let equal d1 d2 =

     

       194
       +
             d1.required = d2.required && d1.optional = d2.optional

     

       195
       +
             && d1.nullable = d2.nullable

     

       196
        
         end in

     

       0
        
       
     

       197
        
         let original = { M.required = "test"; optional = Some 42; nullable = None } in

     

       198
        
       

     

       199
        
         (* JSON roundtrip *)

     

       200
       +
         let json_result =

     

       201
       +
           Result.bind

     

       202
       +
             (Jsont_bytesrw.encode_string M.data_codec original)

     

       203
       +
             (Jsont_bytesrw.decode_string M.data_codec)

     

       204
       +
         in

     

       205
        
         (match json_result with

     

       206
       +
         | Ok decoded when M.equal original decoded ->

     

       207
       +
             Printf.printf "JSON optional roundtrip: PASS\n"

     

       208
       +
         | Ok _ -> Printf.printf "JSON optional roundtrip: FAIL (data mismatch)\n"

     

       209
       +
         | Error e -> Printf.printf "JSON optional roundtrip: FAIL (%s)\n" e);

     

       210
        
       

     

       211
        
         (* YAML roundtrip *)

     

       212
       +
         let yaml_result =

     

       213
       +
           Result.bind

     

       214
       +
             (Yamlt.encode_string M.data_codec original)

     

       215
       +
             (Yamlt.decode_string M.data_codec)

     

       216
       +
         in

     

       217
       +
         match yaml_result with

     

       218
       +
         | Ok decoded when M.equal original decoded ->

     

       219
       +
             Printf.printf "YAML optional roundtrip: PASS\n"

     

       220
       +
         | Ok _ -> Printf.printf "YAML optional roundtrip: FAIL (data mismatch)\n"

     

       221
       +
         | Error e -> Printf.printf "YAML optional roundtrip: FAIL (%s)\n" e

     

       222
        
       

     

       223
        
       let () =

     

       224
        
         let usage = "Usage: test_roundtrip <command>" in

     
···

       233
        
         | "array" -> test_array_roundtrip ()

     

       234
        
         | "object" -> test_object_roundtrip ()

     

       235
        
         | "optional" -> test_optional_roundtrip ()

     

       0
        
       
     

       236
        
         | _ ->

     

       237
        
             prerr_endline usage;

     

       238
        
             prerr_endline "Commands:";

+80 -93

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
        
       

     
···

       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 =

     
···

       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)

     
···

       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)

     
···

       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)

     
···

       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)

     
···

       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 () =

     
···

       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";

     

       0
        
       
     

       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";

     

       0
        
       
     

       0
        
       
     

       303
        
             prerr_endline "  encode <type> <value>    - Test encoding to JSON/YAML";

     

       304
        
             exit 1

···

       1
        
       (*---------------------------------------------------------------------------

     

       2
       +
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       +
         SPDX-License-Identifier: ISC

     

       4
       +
        ---------------------------------------------------------------------------*)

     

       5
        
       

     

       6
        
       (** Test scalar type resolution with Yamlt codec *)

     

       7
        
       

     
···

       121
        
         let result = Yamlt.decode_string number_codec yaml in

     

       122
        
         match result with

     

       123
        
         | Ok f ->

     

       124
       +
             if Float.is_nan f then Printf.printf "value: NaN\n"

     

       125
       +
             else if f = Float.infinity then Printf.printf "value: +Infinity\n"

     

       126
       +
             else if f = Float.neg_infinity then Printf.printf "value: -Infinity\n"

     

       127
       +
             else Printf.printf "value: %.17g\n" f

     

       128
       +
         | Error e -> Printf.printf "ERROR: %s\n" e

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       129
        
       

     

       130
        
       (* Test: Type mismatch errors *)

     

       131
        
       let test_type_mismatch file expected_type =

     

       132
        
         let yaml = read_file file in

     

       133
        
       

     

       134
        
         match expected_type with

     

       135
       +
         | "bool" -> (

     

       136
       +
             let codec =

     

       137
       +
               Jsont.Object.map ~kind:"BoolTest" (fun b -> b)

     

       138
       +
               |> Jsont.Object.mem "value" Jsont.bool ~enc:(fun b -> b)

     

       139
       +
               |> Jsont.Object.finish

     

       140
       +
             in

     

       141
       +
             let result = Yamlt.decode_string codec yaml in

     

       142
       +
             match result with

     

       143
       +
             | Ok _ -> Printf.printf "Unexpected success\n"

     

       144
       +
             | Error e -> Printf.printf "Expected error: %s\n" e)

     

       145
       +
         | "number" -> (

     

       146
       +
             let codec =

     

       147
       +
               Jsont.Object.map ~kind:"NumberTest" (fun n -> n)

     

       148
       +
               |> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)

     

       149
       +
               |> Jsont.Object.finish

     

       150
       +
             in

     

       151
       +
             let result = Yamlt.decode_string codec yaml in

     

       152
       +
             match result with

     

       153
       +
             | Ok _ -> Printf.printf "Unexpected success\n"

     

       154
       +
             | Error e -> Printf.printf "Expected error: %s\n" e)

     

       155
       +
         | "null" -> (

     

       156
       +
             let codec =

     

       157
       +
               Jsont.Object.map ~kind:"NullTest" (fun n -> n)

     

       158
       +
               |> Jsont.Object.mem "value" (Jsont.null ()) ~enc:(fun n -> n)

     

       159
       +
               |> Jsont.Object.finish

     

       160
       +
             in

     

       161
       +
             let result = Yamlt.decode_string codec yaml in

     

       162
       +
             match result with

     

       163
       +
             | Ok _ -> Printf.printf "Unexpected success\n"

     

       164
       +
             | Error e -> Printf.printf "Expected error: %s\n" e)

     

       165
       +
         | _ -> failwith "unknown type"

     

       166
        
       

     

       167
        
       (* Test: Decode with Jsont.json to see auto-resolution *)

     

       168
        
       let test_any_resolution file =

     
···

       186
        
       (* Test: Encoding to different formats *)

     

       187
        
       let test_encode_formats value_type value =

     

       188
        
         match value_type with

     

       189
       +
         | "bool" -> (

     

       190
        
             let codec =

     

       191
        
               Jsont.Object.map ~kind:"BoolTest" (fun b -> b)

     

       192
        
               |> Jsont.Object.mem "value" Jsont.bool ~enc:(fun b -> b)

     
···

       194
        
             in

     

       195
        
             let v = bool_of_string value in

     

       196
        
             (match Jsont_bytesrw.encode_string codec v with

     

       197
       +
             | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       198
       +
             | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       199
        
             (match Yamlt.encode_string ~format:Yamlt.Block codec v with

     

       200
       +
             | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       201
       +
             | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       202
       +
             match Yamlt.encode_string ~format:Yamlt.Flow codec v with

     

       203
       +
             | Ok s -> Printf.printf "YAML Flow: %s" s

     

       204
       +
             | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)

     

       205
       +
         | "number" -> (

     

       206
        
             let codec =

     

       207
        
               Jsont.Object.map ~kind:"NumberTest" (fun n -> n)

     

       208
        
               |> Jsont.Object.mem "value" Jsont.number ~enc:(fun n -> n)

     
···

       210
        
             in

     

       211
        
             let v = float_of_string value in

     

       212
        
             (match Jsont_bytesrw.encode_string codec v with

     

       213
       +
             | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       214
       +
             | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       215
        
             (match Yamlt.encode_string ~format:Yamlt.Block codec v with

     

       216
       +
             | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       217
       +
             | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       218
       +
             match Yamlt.encode_string ~format:Yamlt.Flow codec v with

     

       219
       +
             | Ok s -> Printf.printf "YAML Flow: %s" s

     

       220
       +
             | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)

     

       221
       +
         | "string" -> (

     

       222
        
             let codec =

     

       223
        
               Jsont.Object.map ~kind:"StringTest" (fun s -> s)

     

       224
        
               |> Jsont.Object.mem "value" Jsont.string ~enc:(fun s -> s)

     
···

       226
        
             in

     

       227
        
             let v = value in

     

       228
        
             (match Jsont_bytesrw.encode_string codec v with

     

       229
       +
             | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       230
       +
             | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       231
        
             (match Yamlt.encode_string ~format:Yamlt.Block codec v with

     

       232
       +
             | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       233
       +
             | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       234
       +
             match Yamlt.encode_string ~format:Yamlt.Flow codec v with

     

       235
       +
             | Ok s -> Printf.printf "YAML Flow: %s" s

     

       236
       +
             | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)

     

       237
       +
         | "null" -> (

     

       238
        
             let codec =

     

       239
        
               Jsont.Object.map ~kind:"NullTest" (fun n -> n)

     

       240
        
               |> Jsont.Object.mem "value" (Jsont.null ()) ~enc:(fun n -> n)

     
···

       242
        
             in

     

       243
        
             let v = () in

     

       244
        
             (match Jsont_bytesrw.encode_string codec v with

     

       245
       +
             | Ok s -> Printf.printf "JSON: %s\n" (String.trim s)

     

       246
       +
             | Error e -> Printf.printf "JSON ERROR: %s\n" e);

     

       247
        
             (match Yamlt.encode_string ~format:Yamlt.Block codec v with

     

       248
       +
             | Ok s -> Printf.printf "YAML Block:\n%s" s

     

       249
       +
             | Error e -> Printf.printf "YAML Block ERROR: %s\n" e);

     

       250
       +
             match Yamlt.encode_string ~format:Yamlt.Flow codec v with

     

       251
       +
             | Ok s -> Printf.printf "YAML Flow: %s" s

     

       252
       +
             | Error e -> Printf.printf "YAML Flow ERROR: %s\n" e)

     

       253
        
         | _ -> failwith "unknown type"

     

       254
        
       

     

       255
        
       let () =

     
···

       261
        
         end;

     

       262
        
       

     

       263
        
         match Sys.argv.(1) with

     

       264
       +
         | "null" when Array.length Sys.argv = 3 -> test_null_resolution Sys.argv.(2)

     

       265
       +
         | "bool" when Array.length Sys.argv = 3 -> test_bool_resolution Sys.argv.(2)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       266
        
         | "number" when Array.length Sys.argv = 3 ->

     

       267
        
             test_number_resolution Sys.argv.(2)

     

       0
        
       
     

       268
        
         | "string" when Array.length Sys.argv = 3 ->

     

       269
        
             test_string_resolution Sys.argv.(2)

     

       0
        
       
     

       270
        
         | "special-float" when Array.length Sys.argv = 3 ->

     

       271
        
             test_special_floats Sys.argv.(2)

     

       0
        
       
     

       272
        
         | "type-mismatch" when Array.length Sys.argv = 4 ->

     

       273
        
             test_type_mismatch Sys.argv.(2) Sys.argv.(3)

     

       274
       +
         | "any" when Array.length Sys.argv = 3 -> test_any_resolution Sys.argv.(2)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       275
        
         | "encode" when Array.length Sys.argv = 4 ->

     

       276
        
             test_encode_formats Sys.argv.(2) Sys.argv.(3)

     

       0
        
       
     

       277
        
         | _ ->

     

       278
        
             prerr_endline usage;

     

       279
        
             prerr_endline "Commands:";

     

       280
        
             prerr_endline "  null <file>              - Test null resolution";

     

       281
       +
             prerr_endline

     

       282
       +
               "  bool <file>              - Test bool vs string resolution";

     

       283
        
             prerr_endline "  number <file>            - Test number resolution";

     

       284
        
             prerr_endline "  string <file>            - Test string resolution";

     

       285
        
             prerr_endline "  special-float <file>     - Test .inf, .nan, etc.";

     

       286
       +
             prerr_endline

     

       287
       +
               "  type-mismatch <file> <type> - Test error on type mismatch";

     

       288
       +
             prerr_endline

     

       289
       +
               "  any <file>               - Test Jsont.any auto-resolution";

     

       290
        
             prerr_endline "  encode <type> <value>    - Test encoding to JSON/YAML";

     

       291
        
             exit 1

+17 -13

tests/bin/test_some_vs_option.ml

···

       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)

     

       0
        
       
     

       0
        
       
     

       6
        
           |> Jsont.Object.finish

     

       7
        
         in

     

       8
        
       

     
···

       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)

     

       0
        
       
     

       0
        
       
     

       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)

···

       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"

     

       6
       +
                (Jsont.some (Jsont.array Jsont.string))

     

       7
       +
                ~enc:(fun arr -> arr)

     

       8
        
           |> Jsont.Object.finish

     

       9
        
         in

     

       10
        
       

     
···

       12
        
       

     

       13
        
         Printf.printf "Test 1: Jsont.some (Jsont.array) - like opt_mem:\n";

     

       14
        
         (match Yamlt.decode_string codec1 yaml with

     

       15
       +
         | Ok arr -> (

     

       16
       +
             match arr with

     

       17
       +
             | None -> Printf.printf "Result: None\n"

     

       18
       +
             | Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))

     

       19
       +
         | Error e -> Printf.printf "Error: %s\n" e);

     

       20
        
       

     

       21
        
         (* Using Jsont.option *)

     

       22
        
         let codec2 =

     

       23
        
           Jsont.Object.map ~kind:"Test" (fun arr -> arr)

     

       24
       +
           |> Jsont.Object.mem "values"

     

       25
       +
                (Jsont.option (Jsont.array Jsont.string))

     

       26
       +
                ~enc:(fun arr -> arr)

     

       27
        
           |> Jsont.Object.finish

     

       28
        
         in

     

       29
        
       

     

       30
        
         Printf.printf "\nTest 2: Jsont.option (Jsont.array):\n";

     

       31
       +
         match Yamlt.decode_string codec2 yaml with

     

       32
       +
         | Ok arr -> (

     

       33
       +
             match arr with

     

       34
       +
             | None -> Printf.printf "Result: None\n"

     

       35
       +
             | Some a -> Printf.printf "Result: Some([%d items])\n" (Array.length a))

     

       36
       +
         | Error e -> Printf.printf "Error: %s\n" e

yamlt.opam

···

       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"

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       6
        
       depends: [

     

       7
        
         "dune" {>= "3.18"}

     

       8
        
         "ocaml" {>= "4.14.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
       +
       maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       7
       +
       authors: ["Anil Madhavapeddy"]

     

       8
       +
       license: "ISC"

     

       9
       +
       homepage: "https://tangled.org/@anil.recoil.org/ocaml-yamlt"

     

       10
       +
       bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-yamlt/issues"

     

       11
        
       depends: [

     

       12
        
         "dune" {>= "3.18"}

     

       13
        
         "ocaml" {>= "4.14.0"}