comparing e9c3053d61a5c9b49dc91d5227248ab13e8a3e79 and main on anil.recoil.org/ocaml-yamlrw

.gitignore

···

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

     

       7
       7
        
       third_party/

     

       8
       8
        
       

     

       9
       9
       +
       # YAML test suite (clone manually to tests/ for running test suite)

     

       10
       10
       +
       tests/yaml-test-suite/

     

       11
       11
       +
       

     

       9
       12
        
       # Editor and OS files

     

       10
       13
        
       .DS_Store

     

       11
       14
        
       *.swp

+12 -1

.tangled/workflows/build.yml

···

       26
       26
        
           - bzip2

     

       27
       27
        
           - gcc

     

       28
       28
        
           - ocaml

     

       29
       29
       +
           - pkg-config

     

       29
       30
        
       

     

       30
       31
        
       steps:

     

       31
       32
        
         - name: opam

     

       32
       33
        
           command: |

     

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

     

       35
       35
       +
         - name: repo

     

       36
       36
       +
           command: |

     

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

     

       34
       38
        
         - name: switch

     

       35
       39
        
           command: |

     

       36
       40
        
              opam install . --confirm-level=unsafe-yes --deps-only

     

       37
       41
        
         - name: build

     

       38
       42
        
           command: |

     

       39
       39
       -
              opam exec -- dune build

     

       43
       43
       +
              opam exec -- dune build yamlrw.install yamlrw-unix.install yamlrw-eio.install

     

       40
       44
        
         - name: switch-test

     

       41
       45
        
           command: |

     

       42
       46
        
              opam install . --confirm-level=unsafe-yes --deps-only --with-test

     
···

       47
       51
        
           command: |

     

       48
       52
        
              opam install -y odoc

     

       49
       53
        
              opam exec -- dune build @doc

     

       54
       54
       +
         - name: yaml-test-suite-setup

     

       55
       55
       +
           command: |

     

       56
       56
       +
              git clone --depth 1 -b data https://github.com/yaml/yaml-test-suite tests/yaml-test-suite

     

       57
       57
       +
         - name: yaml-test-suite

     

       58
       58
       +
           command: |

     

       59
       59
       +
              opam exec -- dune build @yaml-test-suite

     

       60
       60
       +
              opam exec -- dune build @yaml-test-suite-eio

CHANGES.md

···

       1
       1
       +
       v1.0.0 (dev)

     

       2
       2
       +
       ------

     

       3
       3
       +
       

     

       4
       4
       +

+36

README.md

···

       79
       79
        
       yamlcat input.yaml

     

       80
       80
        
       ```

     

       81
       81
        
       

     

       82
       82
       +
       ## Testing

     

       83
       83
       +
       

     

       84
       84
       +
       Yamlrw is tested against the official [YAML Test Suite](https://github.com/yaml/yaml-test-suite), a comprehensive collection of YAML test cases.

     

       85
       85
       +
       

     

       86
       86
       +
       ### Running the Full Test Suite

     

       87
       87
       +
       

     

       88
       88
       +
       To run the complete YAML test suite with HTML report generation:

     

       89
       89
       +
       

     

       90
       90
       +
       1. **Clone the test suite** (one-time setup):

     

       91
       91
       +
          ```bash

     

       92
       92
       +
          cd tests

     

       93
       93
       +
          git clone --depth 1 --branch data https://github.com/yaml/yaml-test-suite

     

       94
       94
       +
          cd ..

     

       95
       95
       +
          ```

     

       96
       96
       +
       

     

       97
       97
       +
       2. **Run the tests**:

     

       98
       98
       +
          ```bash

     

       99
       99
       +
          # Standard tests with HTML report

     

       100
       100
       +
          opam exec -- dune build @yaml-test-suite

     

       101
       101
       +
       

     

       102
       102
       +
          # Eio-based tests with HTML report

     

       103
       103
       +
          opam exec -- dune build @yaml-test-suite-eio

     

       104
       104
       +
          ```

     

       105
       105
       +
       

     

       106
       106
       +
       **View the results**:

     

       107
       107
       +
       - The HTML reports are generated in `_build/default/tests/yaml-test-results.html` and `_build/default/tests/yaml-test-results-eio.html`

     

       108
       108
       +
       - Open them in a browser to see detailed test results with filtering and search capabilities

     

       109
       109
       +
       

     

       110
       110
       +
       ### Running Unit Tests

     

       111
       111
       +
       

     

       112
       112
       +
       Run the standard unit tests:

     

       113
       113
       +
       

     

       114
       114
       +
       ```bash

     

       115
       115
       +
       opam exec -- dune runtest

     

       116
       116
       +
       ```

     

       117
       117
       +
       

     

       82
       118
        
       ## API Documentation

     

       83
       119
        
       

     

       84
       120
        
       Build the documentation with:

+120 -99

bin/yamlcat.ml

···

       16
       16
        
         | `Float f ->

     

       17
       17
        
             if Float.is_integer f && Float.abs f < 1e15 then

     

       18
       18
        
               Buffer.add_string buf (Printf.sprintf "%.0f" f)

     

       19
       19
       -
             else

     

       20
       20
       -
               Buffer.add_string buf (Printf.sprintf "%g" f)

     

       19
       19
       +
             else Buffer.add_string buf (Printf.sprintf "%g" f)

     

       21
       20
        
         | `String s -> Buffer.add_string buf (Printf.sprintf "%S" s)

     

       22
       21
        
         | `A items ->

     

       23
       22
        
             Buffer.add_char buf '[';

     

       24
       24
       -
             List.iteri (fun i item ->

     

       25
       25
       -
               if i > 0 then Buffer.add_string buf ", ";

     

       26
       26
       -
               json_to_string buf item

     

       27
       27
       -
             ) items;

     

       23
       23
       +
             List.iteri

     

       24
       24
       +
               (fun i item ->

     

       25
       25
       +
                 if i > 0 then Buffer.add_string buf ", ";

     

       26
       26
       +
                 json_to_string buf item)

     

       27
       27
       +
               items;

     

       28
       28
        
             Buffer.add_char buf ']'

     

       29
       29
        
         | `O pairs ->

     

       30
       30
        
             Buffer.add_char buf '{';

     

       31
       31
       -
             List.iteri (fun i (k, v) ->

     

       32
       32
       -
               if i > 0 then Buffer.add_string buf ", ";

     

       33
       33
       -
               Buffer.add_string buf (Printf.sprintf "%S: " k);

     

       34
       34
       -
               json_to_string buf v

     

       35
       35
       -
             ) pairs;

     

       31
       31
       +
             List.iteri

     

       32
       32
       +
               (fun i (k, v) ->

     

       33
       33
       +
                 if i > 0 then Buffer.add_string buf ", ";

     

       34
       34
       +
                 Buffer.add_string buf (Printf.sprintf "%S: " k);

     

       35
       35
       +
                 json_to_string buf v)

     

       36
       36
       +
               pairs;

     

       36
       37
        
             Buffer.add_char buf '}'

     

       37
       38
        
       

     

       38
       39
        
       let value_to_json v =

     
···

       49
       50
        
           | Yaml ->

     

       50
       51
        
               (* Convert through Value to apply tag-based type coercion *)

     

       51
       52
        
               let first = ref true in

     

       52
       52
       -
               List.iter (fun (doc : Yamlrw.document) ->

     

       53
       53
       -
                 if not !first then print_string "---\n";

     

       54
       54
       -
                 first := false;

     

       55
       55
       -
                 match doc.root with

     

       56
       56
       -
                 | None -> print_endline ""

     

       57
       57
       -
                 | Some yaml ->

     

       58
       58
       -
                     let value = Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml in

     

       59
       59
       -
                     print_string (Yamlrw.to_string value)

     

       60
       60
       -
               ) documents

     

       53
       53
       +
               List.iter

     

       54
       54
       +
                 (fun (doc : Yamlrw.document) ->

     

       55
       55
       +
                   if not !first then print_string "---\n";

     

       56
       56
       +
                   first := false;

     

       57
       57
       +
                   match doc.root with

     

       58
       58
       +
                   | None -> print_endline ""

     

       59
       59
       +
                   | Some yaml ->

     

       60
       60
       +
                       let value =

     

       61
       61
       +
                         Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml

     

       62
       62
       +
                       in

     

       63
       63
       +
                       print_string (Yamlrw.to_string value))

     

       64
       64
       +
                 documents

     

       61
       65
        
           | Flow ->

     

       62
       66
        
               (* Convert through Value to apply tag-based type coercion *)

     

       63
       67
        
               let first = ref true in

     

       64
       64
       -
               List.iter (fun (doc : Yamlrw.document) ->

     

       65
       65
       -
                 if not !first then print_string "---\n";

     

       66
       66
       -
                 first := false;

     

       67
       67
       -
                 match doc.root with

     

       68
       68
       -
                 | None -> print_endline ""

     

       69
       69
       -
                 | Some yaml ->

     

       70
       70
       -
                     let value = Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml in

     

       71
       71
       -
                     print_string (Yamlrw.to_string ~layout_style:`Flow value)

     

       72
       72
       -
               ) documents

     

       68
       68
       +
               List.iter

     

       69
       69
       +
                 (fun (doc : Yamlrw.document) ->

     

       70
       70
       +
                   if not !first then print_string "---\n";

     

       71
       71
       +
                   first := false;

     

       72
       72
       +
                   match doc.root with

     

       73
       73
       +
                   | None -> print_endline ""

     

       74
       74
       +
                   | Some yaml ->

     

       75
       75
       +
                       let value =

     

       76
       76
       +
                         Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml

     

       77
       77
       +
                       in

     

       78
       78
       +
                       print_string (Yamlrw.to_string ~layout_style:`Flow value))

     

       79
       79
       +
                 documents

     

       73
       80
        
           | Json ->

     

       74
       81
        
               let first = ref true in

     

       75
       75
       -
               List.iter (fun (doc : Yamlrw.document) ->

     

       76
       76
       -
                 match doc.root with

     

       77
       77
       -
                 | None -> ()

     

       78
       78
       -
                 | Some yaml ->

     

       79
       79
       -
                     if not !first then print_endline "---";

     

       80
       80
       -
                     first := false;

     

       81
       81
       -
                     let value = Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml in

     

       82
       82
       -
                     print_endline (value_to_json value)

     

       83
       83
       -
               ) documents

     

       82
       82
       +
               List.iter

     

       83
       83
       +
                 (fun (doc : Yamlrw.document) ->

     

       84
       84
       +
                   match doc.root with

     

       85
       85
       +
                   | None -> ()

     

       86
       86
       +
                   | Some yaml ->

     

       87
       87
       +
                       if not !first then print_endline "---";

     

       88
       88
       +
                       first := false;

     

       89
       89
       +
                       let value =

     

       90
       90
       +
                         Yamlrw.to_json ~resolve_aliases ~max_nodes ~max_depth yaml

     

       91
       91
       +
                       in

     

       92
       92
       +
                       print_endline (value_to_json value))

     

       93
       93
       +
                 documents

     

       84
       94
        
           | Debug ->

     

       85
       85
       -
               List.iteri (fun i (doc : Yamlrw.document) ->

     

       86
       86
       -
                 Format.printf "Document %d:@." (i + 1);

     

       87
       87
       -
                 (* Convert back to Document.t for printing *)

     

       88
       88
       -
                 let doc' : Yamlrw.Document.t = {

     

       89
       89
       -
                   Yamlrw.Document.version = doc.version;

     

       90
       90
       -
                   Yamlrw.Document.tags = doc.tags;

     

       91
       91
       -
                   Yamlrw.Document.root = (doc.root :> Yamlrw.Yaml.t option);

     

       92
       92
       -
                   Yamlrw.Document.implicit_start = doc.implicit_start;

     

       93
       93
       -
                   Yamlrw.Document.implicit_end = doc.implicit_end;

     

       94
       94
       -
                 } in

     

       95
       95
       -
                 Format.printf "%a@." Yamlrw.Document.pp doc'

     

       96
       96
       -
               ) documents

     

       97
       97
       -
         with

     

       98
       98
       -
         | Yamlrw.Yamlrw_error e ->

     

       99
       99
       -
             Printf.eprintf "Error: %s\n" (Yamlrw.Error.to_string e);

     

       100
       100
       -
             exit 1

     

       95
       95
       +
               List.iteri

     

       96
       96
       +
                 (fun i (doc : Yamlrw.document) ->

     

       97
       97
       +
                   Format.printf "Document %d:@." (i + 1);

     

       98
       98
       +
                   (* Convert back to Document.t for printing *)

     

       99
       99
       +
                   let doc' : Yamlrw.Document.t =

     

       100
       100
       +
                     {

     

       101
       101
       +
                       Yamlrw.Document.version = doc.version;

     

       102
       102
       +
                       Yamlrw.Document.tags = doc.tags;

     

       103
       103
       +
                       Yamlrw.Document.root = (doc.root :> Yamlrw.Yaml.t option);

     

       104
       104
       +
                       Yamlrw.Document.implicit_start = doc.implicit_start;

     

       105
       105
       +
                       Yamlrw.Document.implicit_end = doc.implicit_end;

     

       106
       106
       +
                     }

     

       107
       107
       +
                   in

     

       108
       108
       +
                   Format.printf "%a@." Yamlrw.Document.pp doc')

     

       109
       109
       +
                 documents

     

       110
       110
       +
         with Yamlrw.Yamlrw_error e ->

     

       111
       111
       +
           Printf.eprintf "Error: %s\n" (Yamlrw.Error.to_string e);

     

       112
       112
       +
           exit 1

     

       101
       113
        
       

     

       102
       114
        
       let process_file ~format ~resolve_aliases ~max_nodes ~max_depth filename =

     

       103
       115
        
         let content =

     

       104
       104
       -
           if filename = "-" then

     

       105
       105
       -
             In_channel.input_all In_channel.stdin

     

       106
       106
       -
           else

     

       107
       107
       -
             In_channel.with_open_text filename In_channel.input_all

     

       116
       116
       +
           if filename = "-" then In_channel.input_all In_channel.stdin

     

       117
       117
       +
           else In_channel.with_open_text filename In_channel.input_all

     

       108
       118
        
         in

     

       109
       119
        
         process_string ~format ~resolve_aliases ~max_nodes ~max_depth content

     

       110
       120
        
       

     

       111
       121
        
       let run format _all resolve_aliases max_nodes max_depth files =

     

       112
       112
       -
         let files = if files = [] then ["-"] else files in

     

       122
       122
       +
         let files = if files = [] then [ "-" ] else files in

     

       113
       123
        
         List.iter (process_file ~format ~resolve_aliases ~max_nodes ~max_depth) files;

     

       114
       124
        
         `Ok ()

     

       115
       125
        
       

     
···

       117
       127
        
       

     

       118
       128
        
       let format_arg =

     

       119
       129
        
         let doc = "Output format: yaml (default), json, flow, or debug." in

     

       120
       120
       -
         let formats = [

     

       121
       121
       -
           ("yaml", Yaml);

     

       122
       122
       -
           ("json", Json);

     

       123
       123
       -
           ("flow", Flow);

     

       124
       124
       -
           ("debug", Debug);

     

       125
       125
       -
         ] in

     

       126
       126
       -
         Arg.(value & opt (enum formats) Yaml & info ["format"; "f"] ~docv:"FORMAT" ~doc)

     

       130
       130
       +
         let formats =

     

       131
       131
       +
           [ ("yaml", Yaml); ("json", Json); ("flow", Flow); ("debug", Debug) ]

     

       132
       132
       +
         in

     

       133
       133
       +
         Arg.(

     

       134
       134
       +
           value & opt (enum formats) Yaml & info [ "format"; "f" ] ~docv:"FORMAT" ~doc)

     

       127
       135
        
       

     

       128
       136
        
       let json_arg =

     

       129
       137
        
         let doc = "Output as JSON (shorthand for --format=json)." in

     

       130
       130
       -
         Arg.(value & flag & info ["json"] ~doc)

     

       138
       138
       +
         Arg.(value & flag & info [ "json" ] ~doc)

     

       131
       139
        
       

     

       132
       140
        
       let flow_arg =

     

       133
       141
        
         let doc = "Output in flow style (shorthand for --format=flow)." in

     

       134
       134
       -
         Arg.(value & flag & info ["flow"] ~doc)

     

       142
       142
       +
         Arg.(value & flag & info [ "flow" ] ~doc)

     

       135
       143
        
       

     

       136
       144
        
       let debug_arg =

     

       137
       145
        
         let doc = "Output internal representation (shorthand for --format=debug)." in

     

       138
       138
       -
         Arg.(value & flag & info ["debug"] ~doc)

     

       146
       146
       +
         Arg.(value & flag & info [ "debug" ] ~doc)

     

       139
       147
        
       

     

       140
       148
        
       let all_arg =

     

       141
       149
        
         let doc = "Output all documents (for multi-document YAML)." in

     

       142
       142
       -
         Arg.(value & flag & info ["all"; "a"] ~doc)

     

       150
       150
       +
         Arg.(value & flag & info [ "all"; "a" ] ~doc)

     

       143
       151
        
       

     

       144
       152
        
       let no_resolve_aliases_arg =

     

       145
       153
        
         let doc = "Don't resolve aliases (keep them as references)." in

     

       146
       146
       -
         Arg.(value & flag & info ["no-resolve-aliases"] ~doc)

     

       154
       154
       +
         Arg.(value & flag & info [ "no-resolve-aliases" ] ~doc)

     

       147
       155
        
       

     

       148
       156
        
       let max_nodes_arg =

     

       149
       149
       -
         let doc = "Maximum number of nodes during alias expansion (default: 10000000). \

     

       150
       150
       -
                    Protection against billion laughs attack." in

     

       151
       151
       -
         Arg.(value & opt int Yamlrw.default_max_alias_nodes & info ["max-nodes"] ~docv:"N" ~doc)

     

       157
       157
       +
         let doc =

     

       158
       158
       +
           "Maximum number of nodes during alias expansion (default: 10000000). \

     

       159
       159
       +
            Protection against billion laughs attack."

     

       160
       160
       +
         in

     

       161
       161
       +
         Arg.(

     

       162
       162
       +
           value

     

       163
       163
       +
           & opt int Yamlrw.default_max_alias_nodes

     

       164
       164
       +
           & info [ "max-nodes" ] ~docv:"N" ~doc)

     

       152
       165
        
       

     

       153
       166
        
       let max_depth_arg =

     

       154
       154
       -
         let doc = "Maximum alias nesting depth (default: 100). \

     

       155
       155
       -
                    Protection against deeply nested alias chains." in

     

       156
       156
       -
         Arg.(value & opt int Yamlrw.default_max_alias_depth & info ["max-depth"] ~docv:"N" ~doc)

     

       167
       167
       +
         let doc =

     

       168
       168
       +
           "Maximum alias nesting depth (default: 100). Protection against deeply \

     

       169
       169
       +
            nested alias chains."

     

       170
       170
       +
         in

     

       171
       171
       +
         Arg.(

     

       172
       172
       +
           value

     

       173
       173
       +
           & opt int Yamlrw.default_max_alias_depth

     

       174
       174
       +
           & info [ "max-depth" ] ~docv:"N" ~doc)

     

       157
       175
        
       

     

       158
       176
        
       let files_arg =

     

       159
       177
        
         let doc = "YAML file(s) to process. Use '-' for stdin." in

     

       160
       178
        
         Arg.(value & pos_all file [] & info [] ~docv:"FILE" ~doc)

     

       161
       179
        
       

     

       162
       180
        
       let combined_format format json flow debug =

     

       163
       163
       -
         if json then Json

     

       164
       164
       -
         else if flow then Flow

     

       165
       165
       -
         else if debug then Debug

     

       166
       166
       -
         else format

     

       181
       181
       +
         if json then Json else if flow then Flow else if debug then Debug else format

     

       167
       182
        
       

     

       168
       183
        
       let term =

     

       169
       184
        
         let combine format json flow debug all no_resolve max_nodes max_depth files =

     
···

       171
       186
        
           let resolve_aliases = not no_resolve in

     

       172
       187
        
           run format all resolve_aliases max_nodes max_depth files

     

       173
       188
        
         in

     

       174
       174
       -
         Term.(ret (const combine $ format_arg $ json_arg $ flow_arg $ debug_arg $

     

       175
       175
       -
                    all_arg $ no_resolve_aliases_arg $ max_nodes_arg $ max_depth_arg $ files_arg))

     

       189
       189
       +
         Term.(

     

       190
       190
       +
           ret

     

       191
       191
       +
             (const combine $ format_arg $ json_arg $ flow_arg $ debug_arg $ all_arg

     

       192
       192
       +
            $ no_resolve_aliases_arg $ max_nodes_arg $ max_depth_arg $ files_arg))

     

       176
       193
        
       

     

       177
       194
        
       let info =

     

       178
       195
        
         let doc = "Parse and reprint YAML files" in

     

       179
       179
       -
         let man = [

     

       180
       180
       -
           `S Manpage.s_description;

     

       181
       181
       -
           `P "$(tname) parses YAML files and reprints them in various formats. \

     

       182
       182
       -
               It can be used to validate YAML, convert between styles, or convert to JSON.";

     

       183
       183
       -
           `S Manpage.s_examples;

     

       184
       184
       -
           `P "Parse and reprint a YAML file:";

     

       185
       185
       -
           `Pre "  $(tname) config.yaml";

     

       186
       186
       -
           `P "Convert YAML to JSON:";

     

       187
       187
       -
           `Pre "  $(tname) --json config.yaml";

     

       188
       188
       -
           `P "Process multi-document YAML:";

     

       189
       189
       -
           `Pre "  $(tname) --all multi.yaml";

     

       190
       190
       -
           `P "Limit alias expansion (protection against malicious YAML):";

     

       191
       191
       -
           `Pre "  $(tname) --max-nodes 1000 --max-depth 10 untrusted.yaml";

     

       192
       192
       -
           `S Manpage.s_bugs;

     

       193
       193
       -
           `P "Report bugs at https://github.com/avsm/ocaml-yaml/issues";

     

       194
       194
       -
         ] in

     

       196
       196
       +
         let man =

     

       197
       197
       +
           [

     

       198
       198
       +
             `S Manpage.s_description;

     

       199
       199
       +
             `P

     

       200
       200
       +
               "$(tname) parses YAML files and reprints them in various formats. It \

     

       201
       201
       +
                can be used to validate YAML, convert between styles, or convert to \

     

       202
       202
       +
                JSON.";

     

       203
       203
       +
             `S Manpage.s_examples;

     

       204
       204
       +
             `P "Parse and reprint a YAML file:";

     

       205
       205
       +
             `Pre "  $(tname) config.yaml";

     

       206
       206
       +
             `P "Convert YAML to JSON:";

     

       207
       207
       +
             `Pre "  $(tname) --json config.yaml";

     

       208
       208
       +
             `P "Process multi-document YAML:";

     

       209
       209
       +
             `Pre "  $(tname) --all multi.yaml";

     

       210
       210
       +
             `P "Limit alias expansion (protection against malicious YAML):";

     

       211
       211
       +
             `Pre "  $(tname) --max-nodes 1000 --max-depth 10 untrusted.yaml";

     

       212
       212
       +
             `S Manpage.s_bugs;

     

       213
       213
       +
             `P "Report bugs at https://github.com/avsm/ocaml-yaml/issues";

     

       214
       214
       +
           ]

     

       215
       215
       +
         in

     

       195
       216
        
         Cmd.info "yamlcat" ~version:"0.1.0" ~doc ~man

     

       196
       217
        
       

     

       197
       218
        
       let () = exit (Cmd.eval (Cmd.v info term))

dune

···

       1
       1
        
       ; Root dune file

     

       2
       2
        
       

     

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

     

       4
       4
       +
       

     

       4
       5
        
       (data_only_dirs third_party)

dune-project

···

       3
       3
        
       

     

       4
       4
        
       (generate_opam_files true)

     

       5
       5
        
       

     

       6
       6
       +
       (using directory-targets 0.1)

     

       7
       7
       +
       

     

       6
       8
        
       (license ISC)

     

       7
       9
        
       (authors "Anil Madhavapeddy")

     

       8
       10
        
       (homepage "https://tangled.org/@anil.recoil.org/ocaml-yamlrw")

     
···

       23
       25
        
         bytesrw

     

       24
       26
        
         cmdliner

     

       25
       27
        
         (odoc :with-doc)

     

       28
       28
       +
         (jsonm :with-test)

     

       26
       29
        
         (alcotest :with-test)))

     

       27
       30
        
       

     

       28
       31
        
       (package

     
···

       49
       52
        
         yamlrw

     

       50
       53
        
         bytesrw-eio

     

       51
       54
        
         (eio (>= 1.1))

     

       55
       55
       +
         (eio_main :with-test)

     

       52
       56
        
         (odoc :with-doc)))

+6 -12

lib/char_class.ml

···

       19
       19
        
       

     

       20
       20
        
       (** Hexadecimal digit *)

     

       21
       21
        
       let is_hex c =

     

       22
       22
       -
         (c >= '0' && c <= '9') ||

     

       23
       23
       -
         (c >= 'a' && c <= 'f') ||

     

       24
       24
       -
         (c >= 'A' && c <= 'F')

     

       22
       22
       +
         (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')

     

       25
       23
        
       

     

       26
       24
        
       (** Alphabetic character *)

     

       27
       27
       -
       let is_alpha c =

     

       28
       28
       -
         (c >= 'a' && c <= 'z') ||

     

       29
       29
       -
         (c >= 'A' && c <= 'Z')

     

       25
       25
       +
       let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')

     

       30
       26
        
       

     

       31
       27
        
       (** Alphanumeric character *)

     

       32
       28
        
       let is_alnum c = is_alpha c || is_digit c

     
···

       34
       30
        
       (** YAML indicator characters *)

     

       35
       31
        
       let is_indicator c =

     

       36
       32
        
         match c with

     

       37
       37
       -
         | '-' | '?' | ':' | ',' | '[' | ']' | '{' | '}'

     

       38
       38
       -
         | '#' | '&' | '*' | '!' | '|' | '>' | '\'' | '"'

     

       39
       39
       -
         | '%' | '@' | '`' -> true

     

       33
       33
       +
         | '-' | '?' | ':' | ',' | '[' | ']' | '{' | '}' | '#' | '&' | '*' | '!' | '|'

     

       34
       34
       +
         | '>' | '\'' | '"' | '%' | '@' | '`' ->

     

       35
       35
       +
             true

     

       40
       36
        
         | _ -> false

     

       41
       37
        
       

     

       42
       38
        
       (** Flow context indicator characters *)

     

       43
       39
        
       let is_flow_indicator c =

     

       44
       44
       -
         match c with

     

       45
       45
       -
         | ',' | '[' | ']' | '{' | '}' -> true

     

       46
       46
       -
         | _ -> false

     

       40
       40
       +
         match c with ',' | '[' | ']' | '{' | '}' -> true | _ -> false

+33

lib/char_class.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Character classification for YAML parsing *)

     

       7
       7
       +
       

     

       8
       8
       +
       val is_break : char -> bool

     

       9
       9
       +
       (** Line break characters (\n or \r) *)

     

       10
       10
       +
       

     

       11
       11
       +
       val is_blank : char -> bool

     

       12
       12
       +
       (** Blank (space or tab) *)

     

       13
       13
       +
       

     

       14
       14
       +
       val is_whitespace : char -> bool

     

       15
       15
       +
       (** Whitespace (break or blank) *)

     

       16
       16
       +
       

     

       17
       17
       +
       val is_digit : char -> bool

     

       18
       18
       +
       (** Decimal digit *)

     

       19
       19
       +
       

     

       20
       20
       +
       val is_hex : char -> bool

     

       21
       21
       +
       (** Hexadecimal digit *)

     

       22
       22
       +
       

     

       23
       23
       +
       val is_alpha : char -> bool

     

       24
       24
       +
       (** Alphabetic character *)

     

       25
       25
       +
       

     

       26
       26
       +
       val is_alnum : char -> bool

     

       27
       27
       +
       (** Alphanumeric character *)

     

       28
       28
       +
       

     

       29
       29
       +
       val is_indicator : char -> bool

     

       30
       30
       +
       (** YAML indicator characters *)

     

       31
       31
       +
       

     

       32
       32
       +
       val is_flow_indicator : char -> bool

     

       33
       33
       +
       (** Flow context indicator characters (comma and brackets) *)

+5 -19

lib/chomping.ml

···

       6
       6
        
       (** Block scalar chomping indicators *)

     

       7
       7
        
       

     

       8
       8
        
       type t =

     

       9
       9
       -
         | Strip (** Remove final line break and trailing empty lines *)

     

       9
       9
       +
         | Strip  (** Remove final line break and trailing empty lines *)

     

       10
       10
        
         | Clip  (** Keep final line break, remove trailing empty lines (default) *)

     

       11
       11
        
         | Keep  (** Keep final line break and trailing empty lines *)

     

       12
       12
        
       

     

       13
       13
       -
       let to_string = function

     

       14
       14
       -
         | Strip -> "strip"

     

       15
       15
       -
         | Clip -> "clip"

     

       16
       16
       -
         | Keep -> "keep"

     

       17
       17
       -
       

     

       18
       18
       -
       let pp fmt t =

     

       19
       19
       -
         Format.pp_print_string fmt (to_string t)

     

       20
       20
       -
       

     

       21
       21
       -
       let of_char = function

     

       22
       22
       -
         | '-' -> Some Strip

     

       23
       23
       -
         | '+' -> Some Keep

     

       24
       24
       -
         | _ -> None

     

       25
       25
       -
       

     

       26
       26
       -
       let to_char = function

     

       27
       27
       -
         | Strip -> Some '-'

     

       28
       28
       -
         | Clip -> None

     

       29
       29
       -
         | Keep -> Some '+'

     

       30
       30
       -
       

     

       13
       13
       +
       let to_string = function Strip -> "strip" | Clip -> "clip" | Keep -> "keep"

     

       14
       14
       +
       let pp fmt t = Format.pp_print_string fmt (to_string t)

     

       15
       15
       +
       let of_char = function '-' -> Some Strip | '+' -> Some Keep | _ -> None

     

       16
       16
       +
       let to_char = function Strip -> Some '-' | Clip -> None | Keep -> Some '+'

     

       31
       17
        
       let equal a b = a = b

+26

lib/chomping.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Block scalar chomping indicators *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t =

     

       9
       9
       +
         | Strip (** Remove final line break and trailing empty lines *)

     

       10
       10
       +
         | Clip  (** Keep final line break, remove trailing empty lines (default) *)

     

       11
       11
       +
         | Keep  (** Keep final line break and trailing empty lines *)

     

       12
       12
       +
       

     

       13
       13
       +
       val to_string : t -> string

     

       14
       14
       +
       (** Convert chomping mode to string *)

     

       15
       15
       +
       

     

       16
       16
       +
       val pp : Format.formatter -> t -> unit

     

       17
       17
       +
       (** Pretty-print a chomping mode *)

     

       18
       18
       +
       

     

       19
       19
       +
       val of_char : char -> t option

     

       20
       20
       +
       (** Parse chomping indicator from character *)

     

       21
       21
       +
       

     

       22
       22
       +
       val to_char : t -> char option

     

       23
       23
       +
       (** Convert chomping mode to indicator character (None for Clip) *)

     

       24
       24
       +
       

     

       25
       25
       +
       val equal : t -> t -> bool

     

       26
       26
       +
       (** Test equality of two chomping modes *)

+16 -20

lib/document.ml

···

       13
       13
        
         implicit_end : bool;

     

       14
       14
        
       }

     

       15
       15
        
       

     

       16
       16
       -
       let make

     

       17
       17
       -
           ?(version : (int * int) option)

     

       18
       18
       -
           ?(tags : (string * string) list = [])

     

       19
       19
       -
           ?(implicit_start = true)

     

       20
       20
       -
           ?(implicit_end = true)

     

       21
       21
       -
           root =

     

       16
       16
       +
       let make ?(version : (int * int) option) ?(tags : (string * string) list = [])

     

       17
       17
       +
           ?(implicit_start = true) ?(implicit_end = true) root =

     

       22
       18
        
         { version; tags; root; implicit_start; implicit_end }

     

       23
       19
        
       

     

       24
       20
        
       let version t = t.version

     
···

       26
       22
        
       let root t = t.root

     

       27
       23
        
       let implicit_start t = t.implicit_start

     

       28
       24
        
       let implicit_end t = t.implicit_end

     

       29
       29
       -
       

     

       30
       25
        
       let with_version version t = { t with version = Some version }

     

       31
       26
        
       let with_tags tags t = { t with tags }

     

       32
       27
        
       let with_root root t = { t with root = Some root }

     
···

       34
       29
        
       let pp fmt t =

     

       35
       30
        
         Format.fprintf fmt "@[<v 2>document(@,";

     

       36
       31
        
         (match t.version with

     

       37
       37
       -
          | Some (maj, min) -> Format.fprintf fmt "version=%d.%d,@ " maj min

     

       38
       38
       -
          | None -> ());

     

       32
       32
       +
         | Some (maj, min) -> Format.fprintf fmt "version=%d.%d,@ " maj min

     

       33
       33
       +
         | None -> ());

     

       39
       34
        
         if t.tags <> [] then begin

     

       40
       35
        
           Format.fprintf fmt "tags=[";

     

       41
       41
       -
           List.iteri (fun i (h, p) ->

     

       42
       42
       -
             if i > 0 then Format.fprintf fmt ", ";

     

       43
       43
       -
             Format.fprintf fmt "%s -> %s" h p

     

       44
       44
       -
           ) t.tags;

     

       36
       36
       +
           List.iteri

     

       37
       37
       +
             (fun i (h, p) ->

     

       38
       38
       +
               if i > 0 then Format.fprintf fmt ", ";

     

       39
       39
       +
               Format.fprintf fmt "%s -> %s" h p)

     

       40
       40
       +
             t.tags;

     

       45
       41
        
           Format.fprintf fmt "],@ "

     

       46
       42
        
         end;

     

       47
       43
        
         Format.fprintf fmt "implicit_start=%b,@ " t.implicit_start;

     

       48
       44
        
         Format.fprintf fmt "implicit_end=%b,@ " t.implicit_end;

     

       49
       45
        
         (match t.root with

     

       50
       50
       -
          | Some root -> Format.fprintf fmt "root=%a" Yaml.pp root

     

       51
       51
       -
          | None -> Format.fprintf fmt "root=<empty>");

     

       46
       46
       +
         | Some root -> Format.fprintf fmt "root=%a" Yaml.pp root

     

       47
       47
       +
         | None -> Format.fprintf fmt "root=<empty>");

     

       52
       48
        
         Format.fprintf fmt "@]@,)"

     

       53
       49
        
       

     

       54
       50
        
       let equal a b =

     

       55
       55
       -
         Option.equal (fun (a1, a2) (b1, b2) -> a1 = b1 && a2 = b2) a.version b.version &&

     

       56
       56
       -
         List.equal (fun (h1, p1) (h2, p2) -> h1 = h2 && p1 = p2) a.tags b.tags &&

     

       57
       57
       -
         Option.equal Yaml.equal a.root b.root &&

     

       58
       58
       -
         a.implicit_start = b.implicit_start &&

     

       59
       59
       -
         a.implicit_end = b.implicit_end

     

       51
       51
       +
         Option.equal ( = ) a.version b.version

     

       52
       52
       +
         && List.equal ( = ) a.tags b.tags

     

       53
       53
       +
         && Option.equal Yaml.equal a.root b.root

     

       54
       54
       +
         && a.implicit_start = b.implicit_start

     

       55
       55
       +
         && a.implicit_end = b.implicit_end

+41

lib/document.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML document with directives and content *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = {

     

       9
       9
       +
         version : (int * int) option;

     

       10
       10
       +
         tags : (string * string) list;

     

       11
       11
       +
         root : Yaml.t option;

     

       12
       12
       +
         implicit_start : bool;

     

       13
       13
       +
         implicit_end : bool;

     

       14
       14
       +
       }

     

       15
       15
       +
       

     

       16
       16
       +
       val make :

     

       17
       17
       +
         ?version:(int * int) ->

     

       18
       18
       +
         ?tags:(string * string) list ->

     

       19
       19
       +
         ?implicit_start:bool ->

     

       20
       20
       +
         ?implicit_end:bool ->

     

       21
       21
       +
         Yaml.t option -> t

     

       22
       22
       +
       (** Create a document *)

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Accessors} *)

     

       25
       25
       +
       

     

       26
       26
       +
       val version : t -> (int * int) option

     

       27
       27
       +
       val tags : t -> (string * string) list

     

       28
       28
       +
       val root : t -> Yaml.t option

     

       29
       29
       +
       val implicit_start : t -> bool

     

       30
       30
       +
       val implicit_end : t -> bool

     

       31
       31
       +
       

     

       32
       32
       +
       (** {2 Modifiers} *)

     

       33
       33
       +
       

     

       34
       34
       +
       val with_version : int * int -> t -> t

     

       35
       35
       +
       val with_tags : (string * string) list -> t -> t

     

       36
       36
       +
       val with_root : Yaml.t -> t -> t

     

       37
       37
       +
       

     

       38
       38
       +
       (** {2 Comparison} *)

     

       39
       39
       +
       

     

       40
       40
       +
       val pp : Format.formatter -> t -> unit

     

       41
       41
       +
       val equal : t -> t -> bool

+63 -107

lib/eio/yamlrw_eio.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Yamlrw Eio - Streaming YAML parsing and emitting with Eio

     

       7
       7
        
       

     

       8
       8
       -
           This module provides Eio-compatible streaming YAML parsing and emitting.

     

       9
       9
       -
           It uses bytesrw adapters to convert Eio sources/sinks to the standard

     

       10
       10
       -
           YAML scanner/parser/emitter, eliminating code duplication. *)

     

       8
       8
       +
           This module provides Eio-compatible streaming YAML parsing and emitting. It

     

       9
       9
       +
           uses bytesrw adapters to convert Eio sources/sinks to the standard YAML

     

       10
       10
       +
           scanner/parser/emitter, eliminating code duplication. *)

     

       11
       11
        
       

     

       12
       12
        
       open Yamlrw

     

       13
       13
        
       

     
···

       30
       30
        
           Scanner.of_input input

     

       31
       31
        
       

     

       32
       32
        
         (** Create a parser from an Eio flow *)

     

       33
       33
       -
         let parser_of_flow flow =

     

       34
       34
       -
           Parser.of_scanner (scanner_of_flow flow)

     

       33
       33
       +
         let parser_of_flow flow = Parser.of_scanner (scanner_of_flow flow)

     

       35
       34
        
       

     

       36
       35
        
         (** Parse a JSON-compatible value from an Eio flow.

     

       37
       36
        
       

     

       38
       37
        
             @param resolve_aliases Whether to expand aliases (default: true)

     

       39
       38
        
             @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       40
       39
        
             @param max_depth Maximum alias nesting depth (default: 100) *)

     

       41
       41
       -
         let value

     

       42
       42
       -
             ?(resolve_aliases = true)

     

       40
       40
       +
         let value ?(resolve_aliases = true)

     

       43
       41
        
             ?(max_nodes = Yaml.default_max_alias_nodes)

     

       44
       44
       -
             ?(max_depth = Yaml.default_max_alias_depth)

     

       45
       45
       -
             flow =

     

       42
       42
       +
             ?(max_depth = Yaml.default_max_alias_depth) flow =

     

       46
       43
        
           let parser = parser_of_flow flow in

     

       47
       47
       -
           Loader.value_of_parser

     

       48
       48
       -
             ~resolve_aliases ~max_nodes ~max_depth

     

       49
       49
       -
             (fun () -> Parser.next parser)

     

       44
       44
       +
           Loader.value_of_parser ~resolve_aliases ~max_nodes ~max_depth (fun () ->

     

       45
       45
       +
               Parser.next parser)

     

       50
       46
        
       

     

       51
       47
        
         (** Parse a full YAML value from an Eio flow.

     

       52
       48
        
       

     
···

       55
       51
        
             @param resolve_aliases Whether to expand aliases (default: false)

     

       56
       52
        
             @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       57
       53
        
             @param max_depth Maximum alias nesting depth (default: 100) *)

     

       58
       58
       -
         let yaml

     

       59
       59
       -
             ?(resolve_aliases = false)

     

       54
       54
       +
         let yaml ?(resolve_aliases = false)

     

       60
       55
        
             ?(max_nodes = Yaml.default_max_alias_nodes)

     

       61
       61
       -
             ?(max_depth = Yaml.default_max_alias_depth)

     

       62
       62
       -
             flow =

     

       56
       56
       +
             ?(max_depth = Yaml.default_max_alias_depth) flow =

     

       63
       57
        
           let parser = parser_of_flow flow in

     

       64
       64
       -
           Loader.yaml_of_parser

     

       65
       65
       -
             ~resolve_aliases ~max_nodes ~max_depth

     

       66
       66
       -
             (fun () -> Parser.next parser)

     

       58
       58
       +
           Loader.yaml_of_parser ~resolve_aliases ~max_nodes ~max_depth (fun () ->

     

       59
       59
       +
               Parser.next parser)

     

       67
       60
        
       

     

       68
       61
        
         (** Parse multiple YAML documents from an Eio flow. *)

     

       69
       62
        
         let documents flow =

     
···

       72
       65
        
       

     

       73
       66
        
         (** {2 Event-Based Streaming} *)

     

       74
       67
        
       

     

       68
       68
       +
         type event_reader = { parser : Parser.t }

     

       75
       69
        
         (** A streaming event reader backed by a flow *)

     

       76
       76
       -
         type event_reader = {

     

       77
       77
       -
           parser : Parser.t;

     

       78
       78
       -
         }

     

       79
       70
        
       

     

       80
       80
       -
         (** Create an event reader from an Eio flow.

     

       81
       81
       -
             This reads data incrementally as events are requested. *)

     

       82
       82
       -
         let event_reader flow =

     

       83
       83
       -
           { parser = parser_of_flow flow }

     

       71
       71
       +
         (** Create an event reader from an Eio flow. This reads data incrementally as

     

       72
       72
       +
             events are requested. *)

     

       73
       73
       +
         let event_reader flow = { parser = parser_of_flow flow }

     

       84
       74
        
       

     

       85
       85
       -
         (** Get the next event from an event reader.

     

       86
       86
       -
             Returns [None] when parsing is complete. *)

     

       87
       87
       -
         let next_event reader =

     

       88
       88
       -
           Parser.next reader.parser

     

       75
       75
       +
         (** Get the next event from an event reader. Returns [None] when parsing is

     

       76
       76
       +
             complete. *)

     

       77
       77
       +
         let next_event reader = Parser.next reader.parser

     

       89
       78
        
       

     

       90
       79
        
         (** Iterate over all events from a flow.

     

       91
       80
        
       

     
···

       127
       116
        
             @param encoding Output encoding (default: UTF-8)

     

       128
       117
        
             @param scalar_style Preferred scalar style (default: Any)

     

       129
       118
        
             @param layout_style Preferred layout style (default: Any) *)

     

       130
       130
       -
         let value

     

       131
       131
       -
             ?(encoding = `Utf8)

     

       132
       132
       -
             ?(scalar_style = `Any)

     

       133
       133
       -
             ?(layout_style = `Any)

     

       134
       134
       -
             flow

     

       135
       135
       -
             (v : value) =

     

       136
       136
       -
           let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       119
       119
       +
         let value ?(encoding = `Utf8) ?(scalar_style = `Any) ?(layout_style = `Any)

     

       120
       120
       +
             flow (v : value) =

     

       121
       121
       +
           let config =

     

       122
       122
       +
             { Emitter.default_config with encoding; scalar_style; layout_style }

     

       123
       123
       +
           in

     

       137
       124
        
           let writer = Bytesrw_eio.bytes_writer_of_flow flow in

     

       138
       125
        
           Serialize.value_to_writer ~config writer v

     

       139
       126
        
       

     
···

       142
       129
        
             @param encoding Output encoding (default: UTF-8)

     

       143
       130
        
             @param scalar_style Preferred scalar style (default: Any)

     

       144
       131
        
             @param layout_style Preferred layout style (default: Any) *)

     

       145
       145
       -
         let yaml

     

       146
       146
       -
             ?(encoding = `Utf8)

     

       147
       147
       -
             ?(scalar_style = `Any)

     

       148
       148
       -
             ?(layout_style = `Any)

     

       149
       149
       -
             flow

     

       150
       150
       -
             (v : yaml) =

     

       151
       151
       -
           let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       132
       132
       +
         let yaml ?(encoding = `Utf8) ?(scalar_style = `Any) ?(layout_style = `Any)

     

       133
       133
       +
             flow (v : yaml) =

     

       134
       134
       +
           let config =

     

       135
       135
       +
             { Emitter.default_config with encoding; scalar_style; layout_style }

     

       136
       136
       +
           in

     

       152
       137
        
           let writer = Bytesrw_eio.bytes_writer_of_flow flow in

     

       153
       138
        
           Serialize.yaml_to_writer ~config writer v

     

       154
       139
        
       

     
···

       158
       143
        
             @param scalar_style Preferred scalar style (default: Any)

     

       159
       144
        
             @param layout_style Preferred layout style (default: Any)

     

       160
       145
        
             @param resolve_aliases Whether to expand aliases (default: true) *)

     

       161
       161
       -
         let documents

     

       162
       162
       -
             ?(encoding = `Utf8)

     

       163
       163
       -
             ?(scalar_style = `Any)

     

       164
       164
       -
             ?(layout_style = `Any)

     

       165
       165
       -
             ?(resolve_aliases = true)

     

       166
       166
       -
             flow

     

       167
       167
       -
             docs =

     

       168
       168
       -
           let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       146
       146
       +
         let documents ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       147
       147
       +
             ?(layout_style = `Any) ?(resolve_aliases = true) flow docs =

     

       148
       148
       +
           let config =

     

       149
       149
       +
             { Emitter.default_config with encoding; scalar_style; layout_style }

     

       150
       150
       +
           in

     

       169
       151
        
           let writer = Bytesrw_eio.bytes_writer_of_flow flow in

     

       170
       152
        
           Serialize.documents_to_writer ~config ~resolve_aliases writer docs

     

       171
       153
        
       

     

       172
       154
        
         (** {2 Event-Based Streaming} *)

     

       173
       155
        
       

     

       156
       156
       +
         type event_writer = { emitter : Emitter.t }

     

       174
       157
        
         (** A streaming event writer that writes directly to a flow *)

     

       175
       175
       -
         type event_writer = {

     

       176
       176
       -
           emitter : Emitter.t;

     

       177
       177
       -
         }

     

       178
       158
        
       

     

       179
       179
       -
         (** Create an event writer that writes directly to a flow.

     

       180
       180
       -
             Events are written incrementally as they are emitted.

     

       159
       159
       +
         (** Create an event writer that writes directly to a flow. Events are written

     

       160
       160
       +
             incrementally as they are emitted.

     

       181
       161
        
       

     

       182
       162
        
             @param encoding Output encoding (default: UTF-8)

     

       183
       163
        
             @param scalar_style Preferred scalar style (default: Any)

     

       184
       164
        
             @param layout_style Preferred layout style (default: Any) *)

     

       185
       185
       -
         let event_writer

     

       186
       186
       -
             ?(encoding = `Utf8)

     

       187
       187
       -
             ?(scalar_style = `Any)

     

       188
       188
       -
             ?(layout_style = `Any)

     

       189
       189
       -
             flow =

     

       190
       190
       -
           let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       165
       165
       +
         let event_writer ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       166
       166
       +
             ?(layout_style = `Any) flow =

     

       167
       167
       +
           let config =

     

       168
       168
       +
             { Emitter.default_config with encoding; scalar_style; layout_style }

     

       169
       169
       +
           in

     

       191
       170
        
           let writer = Bytesrw_eio.bytes_writer_of_flow flow in

     

       192
       171
        
           { emitter = Emitter.of_writer ~config writer }

     

       193
       172
        
       

     

       194
       173
        
         (** Emit a single event to the writer. *)

     

       195
       195
       -
         let emit ew ev =

     

       196
       196
       -
           Emitter.emit ew.emitter ev

     

       174
       174
       +
         let emit ew ev = Emitter.emit ew.emitter ev

     

       197
       175
        
       

     

       198
       176
        
         (** Flush the writer by sending end-of-data. *)

     

       199
       199
       -
         let flush ew =

     

       200
       200
       -
           Emitter.flush ew.emitter

     

       177
       177
       +
         let flush ew = Emitter.flush ew.emitter

     

       201
       178
        
       

     

       202
       179
        
         (** Emit events from a list to a flow. *)

     

       203
       180
        
         let emit_all flow events =

     
···

       209
       186
        
       (** {1 Convenience Functions} *)

     

       210
       187
        
       

     

       211
       188
        
       (** Read a value from a file path *)

     

       212
       212
       -
       let of_file

     

       213
       213
       -
           ?(resolve_aliases = true)

     

       189
       189
       +
       let of_file ?(resolve_aliases = true)

     

       214
       190
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       215
       215
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       216
       216
       -
           ~fs

     

       217
       217
       -
           path =

     

       191
       191
       +
           ?(max_depth = Yaml.default_max_alias_depth) ~fs path =

     

       218
       192
        
         Eio.Path.with_open_in Eio.Path.(fs / path) @@ fun flow ->

     

       219
       193
        
         Read.value ~resolve_aliases ~max_nodes ~max_depth flow

     

       220
       194
        
       

     

       221
       195
        
       (** Read full YAML from a file path *)

     

       222
       222
       -
       let yaml_of_file

     

       223
       223
       -
           ?(resolve_aliases = false)

     

       196
       196
       +
       let yaml_of_file ?(resolve_aliases = false)

     

       224
       197
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       225
       225
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       226
       226
       -
           ~fs

     

       227
       227
       -
           path =

     

       198
       198
       +
           ?(max_depth = Yaml.default_max_alias_depth) ~fs path =

     

       228
       199
        
         Eio.Path.with_open_in Eio.Path.(fs / path) @@ fun flow ->

     

       229
       200
        
         Read.yaml ~resolve_aliases ~max_nodes ~max_depth flow

     

       230
       201
        
       

     

       231
       202
        
       (** Read documents from a file path *)

     

       232
       203
        
       let documents_of_file ~fs path =

     

       233
       233
       -
         Eio.Path.with_open_in Eio.Path.(fs / path) @@ fun flow ->

     

       234
       234
       -
         Read.documents flow

     

       204
       204
       +
         Eio.Path.with_open_in Eio.Path.(fs / path) @@ fun flow -> Read.documents flow

     

       235
       205
        
       

     

       236
       206
        
       (** Write a value to a file path *)

     

       237
       237
       -
       let to_file

     

       238
       238
       -
           ?(encoding = `Utf8)

     

       239
       239
       -
           ?(scalar_style = `Any)

     

       240
       240
       -
           ?(layout_style = `Any)

     

       241
       241
       -
           ~fs

     

       242
       242
       -
           path

     

       243
       243
       -
           v =

     

       244
       244
       -
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) @@ fun flow ->

     

       245
       245
       -
         Write.value ~encoding ~scalar_style ~layout_style flow v

     

       207
       207
       +
       let to_file ?(encoding = `Utf8) ?(scalar_style = `Any) ?(layout_style = `Any)

     

       208
       208
       +
           ~fs path v =

     

       209
       209
       +
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path)

     

       210
       210
       +
         @@ fun flow -> Write.value ~encoding ~scalar_style ~layout_style flow v

     

       246
       211
        
       

     

       247
       212
        
       (** Write full YAML to a file path *)

     

       248
       248
       -
       let yaml_to_file

     

       249
       249
       -
           ?(encoding = `Utf8)

     

       250
       250
       -
           ?(scalar_style = `Any)

     

       251
       251
       -
           ?(layout_style = `Any)

     

       252
       252
       -
           ~fs

     

       253
       253
       -
           path

     

       254
       254
       -
           v =

     

       255
       255
       -
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) @@ fun flow ->

     

       256
       256
       -
         Write.yaml ~encoding ~scalar_style ~layout_style flow v

     

       213
       213
       +
       let yaml_to_file ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       214
       214
       +
           ?(layout_style = `Any) ~fs path v =

     

       215
       215
       +
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path)

     

       216
       216
       +
         @@ fun flow -> Write.yaml ~encoding ~scalar_style ~layout_style flow v

     

       257
       217
        
       

     

       258
       218
        
       (** Write documents to a file path *)

     

       259
       259
       -
       let documents_to_file

     

       260
       260
       -
           ?(encoding = `Utf8)

     

       261
       261
       -
           ?(scalar_style = `Any)

     

       262
       262
       -
           ?(layout_style = `Any)

     

       263
       263
       -
           ?(resolve_aliases = true)

     

       264
       264
       -
           ~fs

     

       265
       265
       -
           path

     

       266
       266
       -
           docs =

     

       267
       267
       -
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) @@ fun flow ->

     

       268
       268
       -
         Write.documents ~encoding ~scalar_style ~layout_style ~resolve_aliases flow docs

     

       219
       219
       +
       let documents_to_file ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       220
       220
       +
           ?(layout_style = `Any) ?(resolve_aliases = true) ~fs path docs =

     

       221
       221
       +
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) Eio.Path.(fs / path)

     

       222
       222
       +
         @@ fun flow ->

     

       223
       223
       +
         Write.documents ~encoding ~scalar_style ~layout_style ~resolve_aliases flow

     

       224
       224
       +
           docs

+66 -52

lib/eio/yamlrw_eio.mli

···

       5
       5
        
       

     

       6
       6
        
       (** Yamlrw Eio - Streaming YAML parsing and emitting with Eio

     

       7
       7
        
       

     

       8
       8
       -
           This library provides Eio-based streaming support for YAML parsing

     

       9
       9
       -
           and emitting. It uses bytesrw adapters that read/write directly to

     

       10
       10
       -
           Eio flows, with bytesrw handling internal buffering.

     

       8
       8
       +
           This library provides Eio-based streaming support for YAML parsing and

     

       9
       9
       +
           emitting. It uses bytesrw adapters that read/write directly to Eio flows,

     

       10
       10
       +
           with bytesrw handling internal buffering.

     

       11
       11
        
       

     

       12
       12
        
           {2 Quick Start}

     

       13
       13
        
       

     
···

       24
       24
        
             Eio_main.run @@ fun env ->

     

       25
       25
        
             let fs = Eio.Stdenv.fs env in

     

       26
       26
        
             Eio.Path.with_open_out Eio.Path.(fs / "output.yaml") @@ fun flow ->

     

       27
       27
       -
             Yaml_eio.Write.value flow (`O [("name", `String "test")])

     

       27
       27
       +
             Yaml_eio.Write.value flow (`O [ ("name", `String "test") ])

     

       28
       28
        
           ]}

     

       29
       29
        
       

     

       30
       30
        
           Stream events incrementally:

     
···

       32
       32
        
             Eio_main.run @@ fun env ->

     

       33
       33
        
             let fs = Eio.Stdenv.fs env in

     

       34
       34
        
             Eio.Path.with_open_in Eio.Path.(fs / "data.yaml") @@ fun flow ->

     

       35
       35
       -
             Yaml_eio.Read.iter_events (fun event span ->

     

       36
       36
       -
               Format.printf "Event at %a@." Yamlrw.Span.pp span

     

       37
       37
       -
             ) flow

     

       35
       35
       +
             Yaml_eio.Read.iter_events

     

       36
       36
       +
               (fun event span -> Format.printf "Event at %a@." Yamlrw.Span.pp span)

     

       37
       37
       +
               flow

     

       38
       38
        
           ]}

     

       39
       39
        
       

     

       40
       40
        
           {2 Streaming Architecture}

     

       41
       41
        
       

     

       42
       42
        
           This library uses bytesrw for direct I/O with Eio flows:

     

       43
       43
        
       

     

       44
       44
       -
           - {b Reading}: Data is read directly from the flow as the

     

       45
       45
       -
             parser requests it. Bytesrw handles internal buffering.

     

       44
       44
       +
           - {b Reading}: Data is read directly from the flow as the parser requests

     

       45
       45
       +
             it. Bytesrw handles internal buffering.

     

       46
       46
        
       

     

       47
       47
       -
           - {b Writing}: Output is written directly to the flow.

     

       48
       48
       -
             Bytesrw handles chunking and buffering. *)

     

       47
       47
       +
           - {b Writing}: Output is written directly to the flow. Bytesrw handles

     

       48
       48
       +
             chunking and buffering. *)

     

       49
       49
        
       

     

       50
       50
        
       (** {1 Types} *)

     

       51
       51
        
       

     
···

       66
       66
        
       module Read : sig

     

       67
       67
        
         (** Parse YAML from Eio flows.

     

       68
       68
        
       

     

       69
       69
       -
             All functions read data incrementally from the underlying flow,

     

       70
       70
       -
             without loading the entire file into memory first. *)

     

       69
       69
       +
             All functions read data incrementally from the underlying flow, without

     

       70
       70
       +
             loading the entire file into memory first. *)

     

       71
       71
        
       

     

       72
       72
        
         (** {2 High-Level Parsing} *)

     

       73
       73
        
       

     
···

       75
       75
        
           ?resolve_aliases:bool ->

     

       76
       76
        
           ?max_nodes:int ->

     

       77
       77
        
           ?max_depth:int ->

     

       78
       78
       -
           _ Eio.Flow.source -> value

     

       78
       78
       +
           _ Eio.Flow.source ->

     

       79
       79
       +
           value

     

       79
       80
        
         (** Parse a JSON-compatible value from an Eio flow.

     

       80
       81
        
       

     

       81
       82
        
             @param resolve_aliases Whether to expand aliases (default: true)

     
···

       86
       87
        
           ?resolve_aliases:bool ->

     

       87
       88
        
           ?max_nodes:int ->

     

       88
       89
        
           ?max_depth:int ->

     

       89
       89
       -
           _ Eio.Flow.source -> yaml

     

       90
       90
       +
           _ Eio.Flow.source ->

     

       91
       91
       +
           yaml

     

       90
       92
        
         (** Parse a full YAML value from an Eio flow.

     

       91
       93
        
       

     

       92
       94
        
             By default, aliases are NOT resolved, preserving the document structure.

     
···

       101
       103
        
         (** {2 Event-Based Streaming} *)

     

       102
       104
        
       

     

       103
       105
        
         type event_reader

     

       104
       104
       -
         (** A streaming event reader backed by a flow.

     

       105
       105
       -
             Events are parsed incrementally as requested. *)

     

       106
       106
       +
         (** A streaming event reader backed by a flow. Events are parsed incrementally

     

       107
       107
       +
             as requested. *)

     

       106
       108
        
       

     

       107
       109
        
         val event_reader : _ Eio.Flow.source -> event_reader

     

       108
       110
        
         (** Create an event reader from an Eio flow. *)

     

       109
       111
        
       

     

       110
       112
        
         val next_event : event_reader -> Yamlrw.Event.spanned option

     

       111
       111
       -
         (** Get the next event from an event reader.

     

       112
       112
       -
             Returns [None] when parsing is complete. *)

     

       113
       113
       +
         (** Get the next event from an event reader. Returns [None] when parsing is

     

       114
       114
       +
             complete. *)

     

       113
       115
        
       

     

       114
       116
        
         val iter_events :

     

       115
       115
       -
           (event -> Yamlrw.Span.t -> unit) ->

     

       116
       116
       -
           _ Eio.Flow.source -> unit

     

       117
       117
       +
           (event -> Yamlrw.Span.t -> unit) -> _ Eio.Flow.source -> unit

     

       117
       118
        
         (** Iterate over all events from a flow. *)

     

       118
       119
        
       

     

       119
       119
       -
         val fold_events :

     

       120
       120
       -
           ('a -> event -> 'a) -> 'a ->

     

       121
       121
       -
           _ Eio.Flow.source -> 'a

     

       120
       120
       +
         val fold_events : ('a -> event -> 'a) -> 'a -> _ Eio.Flow.source -> 'a

     

       122
       121
        
         (** Fold over all events from a flow. *)

     

       123
       122
        
       

     

       124
       124
       -
         val iter_documents :

     

       125
       125
       -
           (document -> unit) ->

     

       126
       126
       -
           _ Eio.Flow.source -> unit

     

       123
       123
       +
         val iter_documents : (document -> unit) -> _ Eio.Flow.source -> unit

     

       127
       124
        
         (** Iterate over documents from a flow, calling [f] for each document. *)

     

       128
       125
        
       

     

       129
       129
       -
         val fold_documents :

     

       130
       130
       -
           ('a -> document -> 'a) -> 'a ->

     

       131
       131
       -
           _ Eio.Flow.source -> 'a

     

       126
       126
       +
         val fold_documents : ('a -> document -> 'a) -> 'a -> _ Eio.Flow.source -> 'a

     

       132
       127
        
         (** Fold over documents from a flow. *)

     

       133
       128
        
       end

     

       134
       129
        
       

     
···

       145
       140
        
           ?encoding:Yamlrw.Encoding.t ->

     

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

     

       147
       142
        
           ?layout_style:Yamlrw.Layout_style.t ->

     

       148
       148
       -
           _ Eio.Flow.sink -> value -> unit

     

       143
       143
       +
           _ Eio.Flow.sink ->

     

       144
       144
       +
           value ->

     

       145
       145
       +
           unit

     

       149
       146
        
         (** Write a JSON-compatible value to an Eio flow.

     

       150
       147
        
       

     

       151
       148
        
             @param encoding Output encoding (default: UTF-8)

     
···

       156
       153
        
           ?encoding:Yamlrw.Encoding.t ->

     

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

     

       158
       155
        
           ?layout_style:Yamlrw.Layout_style.t ->

     

       159
       159
       -
           _ Eio.Flow.sink -> yaml -> unit

     

       156
       156
       +
           _ Eio.Flow.sink ->

     

       157
       157
       +
           yaml ->

     

       158
       158
       +
           unit

     

       160
       159
        
         (** Write a full YAML value to an Eio flow.

     

       161
       160
        
       

     

       162
       161
        
             @param encoding Output encoding (default: UTF-8)

     
···

       168
       167
        
           ?scalar_style:Yamlrw.Scalar_style.t ->

     

       169
       168
        
           ?layout_style:Yamlrw.Layout_style.t ->

     

       170
       169
        
           ?resolve_aliases:bool ->

     

       171
       171
       -
           _ Eio.Flow.sink -> document list -> unit

     

       170
       170
       +
           _ Eio.Flow.sink ->

     

       171
       171
       +
           document list ->

     

       172
       172
       +
           unit

     

       172
       173
        
         (** Write multiple YAML documents to an Eio flow.

     

       173
       174
        
       

     

       174
       175
        
             @param encoding Output encoding (default: UTF-8)

     
···

       179
       180
        
         (** {2 Event-Based Streaming} *)

     

       180
       181
        
       

     

       181
       182
        
         type event_writer

     

       182
       182
       -
         (** A streaming event writer backed by a flow.

     

       183
       183
       -
             Events are written incrementally to the underlying flow. *)

     

       183
       183
       +
         (** A streaming event writer backed by a flow. Events are written

     

       184
       184
       +
             incrementally to the underlying flow. *)

     

       184
       185
        
       

     

       185
       186
        
         val event_writer :

     

       186
       187
        
           ?encoding:Yamlrw.Encoding.t ->

     

       187
       188
        
           ?scalar_style:Yamlrw.Scalar_style.t ->

     

       188
       189
        
           ?layout_style:Yamlrw.Layout_style.t ->

     

       189
       189
       -
           _ Eio.Flow.sink -> event_writer

     

       190
       190
       -
         (** Create an event writer that writes directly to a flow.

     

       191
       191
       -
             Events are written incrementally as they are emitted.

     

       190
       190
       +
           _ Eio.Flow.sink ->

     

       191
       191
       +
           event_writer

     

       192
       192
       +
         (** Create an event writer that writes directly to a flow. Events are written

     

       193
       193
       +
             incrementally as they are emitted.

     

       192
       194
        
       

     

       193
       195
        
             @param encoding Output encoding (default: UTF-8)

     

       194
       196
        
             @param scalar_style Preferred scalar style (default: Any)

     
···

       211
       213
        
         ?max_nodes:int ->

     

       212
       214
        
         ?max_depth:int ->

     

       213
       215
        
         fs:_ Eio.Path.t ->

     

       214
       214
       -
         string -> value

     

       216
       216
       +
         string ->

     

       217
       217
       +
         value

     

       215
       218
        
       (** Read a value from a file path.

     

       216
       219
        
       

     

       217
       217
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       220
       220
       +
           @param fs

     

       221
       221
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       218
       222
        
       

     

       219
       223
        
       val yaml_of_file :

     

       220
       224
        
         ?resolve_aliases:bool ->

     

       221
       225
        
         ?max_nodes:int ->

     

       222
       226
        
         ?max_depth:int ->

     

       223
       227
        
         fs:_ Eio.Path.t ->

     

       224
       224
       -
         string -> yaml

     

       228
       228
       +
         string ->

     

       229
       229
       +
         yaml

     

       225
       230
        
       (** Read full YAML from a file path.

     

       226
       231
        
       

     

       227
       227
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       232
       232
       +
           @param fs

     

       233
       233
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       228
       234
        
       

     

       229
       229
       -
       val documents_of_file :

     

       230
       230
       -
         fs:_ Eio.Path.t ->

     

       231
       231
       -
         string -> document list

     

       235
       235
       +
       val documents_of_file : fs:_ Eio.Path.t -> string -> document list

     

       232
       236
        
       (** Read documents from a file path.

     

       233
       237
        
       

     

       234
       234
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       238
       238
       +
           @param fs

     

       239
       239
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       235
       240
        
       

     

       236
       241
        
       val to_file :

     

       237
       242
        
         ?encoding:Yamlrw.Encoding.t ->

     

       238
       243
        
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       239
       244
        
         ?layout_style:Yamlrw.Layout_style.t ->

     

       240
       245
        
         fs:_ Eio.Path.t ->

     

       241
       241
       -
         string -> value -> unit

     

       246
       246
       +
         string ->

     

       247
       247
       +
         value ->

     

       248
       248
       +
         unit

     

       242
       249
        
       (** Write a value to a file path.

     

       243
       250
        
       

     

       244
       244
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       251
       251
       +
           @param fs

     

       252
       252
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       245
       253
        
       

     

       246
       254
        
       val yaml_to_file :

     

       247
       255
        
         ?encoding:Yamlrw.Encoding.t ->

     

       248
       256
        
         ?scalar_style:Yamlrw.Scalar_style.t ->

     

       249
       257
        
         ?layout_style:Yamlrw.Layout_style.t ->

     

       250
       258
        
         fs:_ Eio.Path.t ->

     

       251
       251
       -
         string -> yaml -> unit

     

       259
       259
       +
         string ->

     

       260
       260
       +
         yaml ->

     

       261
       261
       +
         unit

     

       252
       262
        
       (** Write full YAML to a file path.

     

       253
       263
        
       

     

       254
       254
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       264
       264
       +
           @param fs

     

       265
       265
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       255
       266
        
       

     

       256
       267
        
       val documents_to_file :

     

       257
       268
        
         ?encoding:Yamlrw.Encoding.t ->

     
···

       259
       270
        
         ?layout_style:Yamlrw.Layout_style.t ->

     

       260
       271
        
         ?resolve_aliases:bool ->

     

       261
       272
        
         fs:_ Eio.Path.t ->

     

       262
       262
       -
         string -> document list -> unit

     

       273
       273
       +
         string ->

     

       274
       274
       +
         document list ->

     

       275
       275
       +
         unit

     

       263
       276
        
       (** Write documents to a file path.

     

       264
       277
        
       

     

       265
       265
       -
           @param fs The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

     

       278
       278
       +
           @param fs

     

       279
       279
       +
             The filesystem path (e.g., [Eio.Stdenv.fs env] or [Eio.Stdenv.cwd env]) *)

+210 -199

lib/emitter.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Emitter - converts YAML data structures to string output

     

       7
       7
        
       

     

       8
       8
       -
           The emitter can write to either a Buffer (default) or directly to a

     

       9
       9
       -
           bytesrw Bytes.Writer for streaming output. *)

     

       8
       8
       +
           The emitter can write to either a Buffer (default) or directly to a bytesrw

     

       9
       9
       +
           Bytes.Writer for streaming output. *)

     

       10
       10
        
       

     

       11
       11
        
       type config = {

     

       12
       12
        
         encoding : Encoding.t;

     
···

       17
       17
        
         canonical : bool;

     

       18
       18
        
       }

     

       19
       19
        
       

     

       20
       20
       -
       let default_config = {

     

       21
       21
       -
         encoding = `Utf8;

     

       22
       22
       -
         scalar_style = `Any;

     

       23
       23
       -
         layout_style = `Any;

     

       24
       24
       -
         indent = 2;

     

       25
       25
       -
         width = 80;

     

       26
       26
       -
         canonical = false;

     

       27
       27
       -
       }

     

       20
       20
       +
       let default_config =

     

       21
       21
       +
         {

     

       22
       22
       +
           encoding = `Utf8;

     

       23
       23
       +
           scalar_style = `Any;

     

       24
       24
       +
           layout_style = `Any;

     

       25
       25
       +
           indent = 2;

     

       26
       26
       +
           width = 80;

     

       27
       27
       +
           canonical = false;

     

       28
       28
       +
         }

     

       28
       29
        
       

     

       29
       30
        
       type state =

     

       30
       31
        
         | Initial

     

       31
       32
        
         | Stream_started

     

       32
       33
        
         | Document_started

     

       33
       33
       -
         | In_block_sequence of int  (* indent level *)

     

       34
       34
       +
         | In_block_sequence of int (* indent level *)

     

       34
       35
        
         | In_block_mapping_key of int

     

       35
       36
        
         | In_block_mapping_value of int

     

       36
       36
       -
         | In_block_mapping_first_key of int  (* first key after "- ", no indent needed *)

     

       37
       37
       +
         | In_block_mapping_first_key of

     

       38
       38
       +
             int (* first key after "- ", no indent needed *)

     

       37
       39
        
         | In_flow_sequence

     

       38
       40
        
         | In_flow_mapping_key

     

       39
       41
        
         | In_flow_mapping_value

     
···

       41
       43
        
         | Stream_ended

     

       42
       44
        
       

     

       43
       45
        
       (** Output sink - either a Buffer or a bytesrw Writer *)

     

       44
       44
       -
       type sink =

     

       45
       45
       -
         | Buffer_sink of Buffer.t

     

       46
       46
       -
         | Writer_sink of Bytesrw.Bytes.Writer.t

     

       46
       46
       +
       type sink = Buffer_sink of Buffer.t | Writer_sink of Bytesrw.Bytes.Writer.t

     

       47
       47
        
       

     

       48
       48
        
       type t = {

     

       49
       49
        
         config : config;

     
···

       55
       55
        
         mutable need_separator : bool;

     

       56
       56
        
       }

     

       57
       57
        
       

     

       58
       58
       -
       let create ?(config = default_config) () = {

     

       59
       59
       -
         config;

     

       60
       60
       -
         sink = Buffer_sink (Buffer.create 1024);

     

       61
       61
       -
         state = Initial;

     

       62
       62
       -
         states = [];

     

       63
       63
       -
         indent = 0;

     

       64
       64
       -
         flow_level = 0;

     

       65
       65
       -
         need_separator = false;

     

       66
       66
       -
       }

     

       58
       58
       +
       let create ?(config = default_config) () =

     

       59
       59
       +
         {

     

       60
       60
       +
           config;

     

       61
       61
       +
           sink = Buffer_sink (Buffer.create 1024);

     

       62
       62
       +
           state = Initial;

     

       63
       63
       +
           states = [];

     

       64
       64
       +
           indent = 0;

     

       65
       65
       +
           flow_level = 0;

     

       66
       66
       +
           need_separator = false;

     

       67
       67
       +
         }

     

       67
       68
        
       

     

       68
       69
        
       (** Create an emitter that writes directly to a Bytes.Writer *)

     

       69
       69
       -
       let of_writer ?(config = default_config) writer = {

     

       70
       70
       -
         config;

     

       71
       71
       -
         sink = Writer_sink writer;

     

       72
       72
       -
         state = Initial;

     

       73
       73
       -
         states = [];

     

       74
       74
       -
         indent = 0;

     

       75
       75
       -
         flow_level = 0;

     

       76
       76
       -
         need_separator = false;

     

       77
       77
       -
       }

     

       70
       70
       +
       let of_writer ?(config = default_config) writer =

     

       71
       71
       +
         {

     

       72
       72
       +
           config;

     

       73
       73
       +
           sink = Writer_sink writer;

     

       74
       74
       +
           state = Initial;

     

       75
       75
       +
           states = [];

     

       76
       76
       +
           indent = 0;

     

       77
       77
       +
           flow_level = 0;

     

       78
       78
       +
           need_separator = false;

     

       79
       79
       +
         }

     

       78
       80
        
       

     

       79
       81
        
       let contents t =

     

       80
       82
        
         match t.sink with

     

       81
       83
        
         | Buffer_sink buf -> Buffer.contents buf

     

       82
       82
       -
         | Writer_sink _ -> ""  (* No accumulated content for writer sink *)

     

       84
       84
       +
         | Writer_sink _ -> "" (* No accumulated content for writer sink *)

     

       83
       85
        
       

     

       84
       86
        
       let reset t =

     

       85
       87
        
         (match t.sink with

     

       86
       86
       -
          | Buffer_sink buf -> Buffer.clear buf

     

       87
       87
       -
          | Writer_sink _ -> ());

     

       88
       88
       +
         | Buffer_sink buf -> Buffer.clear buf

     

       89
       89
       +
         | Writer_sink _ -> ());

     

       88
       90
        
         t.state <- Initial;

     

       89
       91
        
         t.states <- [];

     

       90
       92
        
         t.indent <- 0;

     
···

       107
       109
        
       

     

       108
       110
        
       let write_indent t =

     

       109
       111
        
         if t.indent <= 8 then

     

       110
       110
       -
           for _ = 1 to t.indent do write_char t ' ' done

     

       111
       111
       -
         else

     

       112
       112
       -
           write t (String.make t.indent ' ')

     

       112
       112
       +
           for _ = 1 to t.indent do

     

       113
       113
       +
             write_char t ' '

     

       114
       114
       +
           done

     

       115
       115
       +
         else write t (String.make t.indent ' ')

     

       113
       116
        
       

     

       114
       114
       -
       let write_newline t =

     

       115
       115
       -
         write_char t '\n'

     

       117
       117
       +
       let write_newline t = write_char t '\n'

     

       116
       118
        
       

     

       117
       119
        
       let push_state t s =

     

       118
       120
        
         t.states <- t.state :: t.states;

     
···

       123
       125
        
         | s :: rest ->

     

       124
       126
        
             t.state <- s;

     

       125
       127
        
             t.states <- rest

     

       126
       126
       -
         | [] ->

     

       127
       127
       -
             t.state <- Stream_ended

     

       128
       128
       +
         | [] -> t.state <- Stream_ended

     

       128
       129
        
       

     

       129
       129
       -
       (** Escape a string for double-quoted output.

     

       130
       130
       -
           Uses a buffer to batch writes instead of character-by-character. *)

     

       130
       130
       +
       (** Escape a string for double-quoted output. Uses a buffer to batch writes

     

       131
       131
       +
           instead of character-by-character. *)

     

       131
       132
        
       let escape_double_quoted value =

     

       132
       133
        
         let len = String.length value in

     

       133
       134
        
         (* Check if any escaping is needed *)

     
···

       140
       141
        
         done;

     

       141
       142
        
         if not !needs_escape then value

     

       142
       143
        
         else begin

     

       143
       143
       -
           let buf = Buffer.create (len + len / 4) in

     

       144
       144
       +
           let buf = Buffer.create (len + (len / 4)) in

     

       144
       145
        
           for i = 0 to len - 1 do

     

       145
       146
        
             match value.[i] with

     

       146
       147
        
             | '"' -> Buffer.add_string buf "\\\""

     
···

       148
       149
        
             | '\n' -> Buffer.add_string buf "\\n"

     

       149
       150
        
             | '\r' -> Buffer.add_string buf "\\r"

     

       150
       151
        
             | '\t' -> Buffer.add_string buf "\\t"

     

       151
       151
       -
             | c when c < ' ' -> Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c))

     

       152
       152
       +
             | c when c < ' ' ->

     

       153
       153
       +
                 Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c))

     

       152
       154
        
             | c -> Buffer.add_char buf c

     

       153
       155
        
           done;

     

       154
       156
        
           Buffer.contents buf

     
···

       159
       161
        
         if not (String.contains value '\'') then value

     

       160
       162
        
         else begin

     

       161
       163
        
           let len = String.length value in

     

       162
       162
       -
           let buf = Buffer.create (len + len / 8) in

     

       164
       164
       +
           let buf = Buffer.create (len + (len / 8)) in

     

       163
       165
        
           for i = 0 to len - 1 do

     

       164
       166
        
             let c = value.[i] in

     

       165
       165
       -
             if c = '\'' then Buffer.add_string buf "''"

     

       166
       166
       -
             else Buffer.add_char buf c

     

       167
       167
       +
             if c = '\'' then Buffer.add_string buf "''" else Buffer.add_char buf c

     

       167
       168
        
           done;

     

       168
       169
        
           Buffer.contents buf

     

       169
       170
        
         end

     

       170
       171
        
       

     

       171
       172
        
       (** Write scalar with appropriate quoting *)

     

       172
       173
        
       let write_scalar t ?(style = `Any) value =

     

       173
       173
       -
         match (match style with `Any -> Quoting.choose_style value | s -> s) with

     

       174
       174
       -
         | `Plain | `Any ->

     

       175
       175
       -
             write t value

     

       174
       174
       +
         match match style with `Any -> Quoting.choose_style value | s -> s with

     

       175
       175
       +
         | `Plain | `Any -> write t value

     

       176
       176
        
         | `Single_quoted ->

     

       177
       177
        
             write_char t '\'';

     

       178
       178
        
             write t (escape_single_quoted value);

     
···

       184
       184
        
         | `Literal ->

     

       185
       185
        
             write t "|";

     

       186
       186
        
             write_newline t;

     

       187
       187
       -
             String.split_on_char '\n' value |> List.iter (fun line ->

     

       188
       188
       -
               write_indent t;

     

       189
       189
       -
               write t line;

     

       190
       190
       -
               write_newline t

     

       191
       191
       -
             )

     

       187
       187
       +
             String.split_on_char '\n' value

     

       188
       188
       +
             |> List.iter (fun line ->

     

       189
       189
       +
                 write_indent t;

     

       190
       190
       +
                 write t line;

     

       191
       191
       +
                 write_newline t)

     

       192
       192
        
         | `Folded ->

     

       193
       193
        
             write t ">";

     

       194
       194
        
             write_newline t;

     

       195
       195
       -
             String.split_on_char '\n' value |> List.iter (fun line ->

     

       196
       196
       -
               write_indent t;

     

       197
       197
       -
               write t line;

     

       198
       198
       -
               write_newline t

     

       199
       199
       -
             )

     

       195
       195
       +
             String.split_on_char '\n' value

     

       196
       196
       +
             |> List.iter (fun line ->

     

       197
       197
       +
                 write_indent t;

     

       198
       198
       +
                 write t line;

     

       199
       199
       +
                 write_newline t)

     

       200
       200
        
       

     

       201
       201
        
       (** Write anchor if present *)

     

       202
       202
        
       let write_anchor t anchor =

     
···

       221
       221
        
       

     

       222
       222
        
       let emit t (ev : Event.t) =

     

       223
       223
        
         match ev with

     

       224
       224
       -
         | Event.Stream_start _ ->

     

       225
       225
       -
             t.state <- Stream_started

     

       226
       226
       -
       

     

       227
       227
       -
         | Event.Stream_end ->

     

       228
       228
       -
             t.state <- Stream_ended

     

       229
       229
       -
       

     

       224
       224
       +
         | Event.Stream_start _ -> t.state <- Stream_started

     

       225
       225
       +
         | Event.Stream_end -> t.state <- Stream_ended

     

       230
       226
        
         | Event.Document_start { version; implicit } ->

     

       231
       227
        
             if not implicit then begin

     

       232
       228
        
               (match version with

     

       233
       233
       -
                | Some (maj, min) ->

     

       234
       234
       -
                    write t (Printf.sprintf "%%YAML %d.%d\n" maj min)

     

       235
       235
       -
                | None -> ());

     

       229
       229
       +
               | Some (maj, min) -> write t (Printf.sprintf "%%YAML %d.%d\n" maj min)

     

       230
       230
       +
               | None -> ());

     

       236
       231
        
               write t "---";

     

       237
       232
        
               write_newline t

     

       238
       233
        
             end;

     

       239
       234
        
             t.state <- Document_started

     

       240
       240
       -
       

     

       241
       235
        
         | Event.Document_end { implicit } ->

     

       242
       236
        
             if not implicit then begin

     

       243
       237
        
               write t "...";

     

       244
       238
        
               write_newline t

     

       245
       239
        
             end;

     

       246
       240
        
             t.state <- Document_ended

     

       247
       247
       -
       

     

       248
       241
        
         | Event.Alias { anchor } ->

     

       249
       242
        
             if t.flow_level > 0 then begin

     

       250
       243
        
               if t.need_separator then write t ", ";

     

       251
       244
        
               t.need_separator <- true;

     

       252
       245
        
               write_char t '*';

     

       253
       246
        
               write t anchor

     

       254
       254
       -
             end else begin

     

       255
       255
       -
               (match t.state with

     

       256
       256
       -
                | In_block_sequence _ ->

     

       257
       257
       -
                    write_indent t;

     

       258
       258
       -
                    write t "- *";

     

       259
       259
       -
                    write t anchor;

     

       260
       260
       -
                    write_newline t

     

       261
       261
       -
                | In_block_mapping_key _ ->

     

       262
       262
       -
                    write_indent t;

     

       263
       263
       -
                    write_char t '*';

     

       264
       264
       -
                    write t anchor;

     

       265
       265
       -
                    write t ": ";

     

       266
       266
       -
                    t.state <- In_block_mapping_value t.indent

     

       267
       267
       -
                | In_block_mapping_value indent ->

     

       268
       268
       -
                    write_char t '*';

     

       269
       269
       -
                    write t anchor;

     

       270
       270
       -
                    write_newline t;

     

       271
       271
       -
                    t.state <- In_block_mapping_key indent

     

       272
       272
       -
                | _ ->

     

       273
       273
       -
                    write_char t '*';

     

       274
       274
       -
                    write t anchor;

     

       275
       275
       -
                    write_newline t)

     

       247
       247
       +
             end

     

       248
       248
       +
             else begin

     

       249
       249
       +
               match t.state with

     

       250
       250
       +
               | In_block_sequence _ ->

     

       251
       251
       +
                   write_indent t;

     

       252
       252
       +
                   write t "- *";

     

       253
       253
       +
                   write t anchor;

     

       254
       254
       +
                   write_newline t

     

       255
       255
       +
               | In_block_mapping_key _ ->

     

       256
       256
       +
                   write_indent t;

     

       257
       257
       +
                   write_char t '*';

     

       258
       258
       +
                   write t anchor;

     

       259
       259
       +
                   write t ": ";

     

       260
       260
       +
                   t.state <- In_block_mapping_value t.indent

     

       261
       261
       +
               | In_block_mapping_value indent ->

     

       262
       262
       +
                   write_char t '*';

     

       263
       263
       +
                   write t anchor;

     

       264
       264
       +
                   write_newline t;

     

       265
       265
       +
                   t.state <- In_block_mapping_key indent

     

       266
       266
       +
               | _ ->

     

       267
       267
       +
                   write_char t '*';

     

       268
       268
       +
                   write t anchor;

     

       269
       269
       +
                   write_newline t

     

       276
       270
        
             end

     

       277
       277
       -
       

     

       278
       271
        
         | Event.Scalar { anchor; tag; value; plain_implicit; style; _ } ->

     

       279
       272
        
             if t.flow_level > 0 then begin

     

       280
       280
       -
               (match t.state with

     

       281
       281
       -
                | In_flow_mapping_key ->

     

       282
       282
       -
                    if t.need_separator then write t ", ";

     

       283
       283
       -
                    write_anchor t anchor;

     

       284
       284
       -
                    write_tag t ~implicit:plain_implicit tag;

     

       285
       285
       -
                    write_scalar t ~style value;

     

       286
       286
       -
                    write t ": ";

     

       287
       287
       -
                    t.need_separator <- false;

     

       288
       288
       -
                    t.state <- In_flow_mapping_value

     

       289
       289
       -
                | In_flow_mapping_value ->

     

       290
       290
       -
                    write_anchor t anchor;

     

       291
       291
       -
                    write_tag t ~implicit:plain_implicit tag;

     

       292
       292
       -
                    write_scalar t ~style value;

     

       293
       293
       -
                    t.need_separator <- true;

     

       294
       294
       -
                    t.state <- In_flow_mapping_key

     

       295
       295
       -
                | _ ->

     

       296
       296
       -
                    if t.need_separator then write t ", ";

     

       297
       297
       -
                    t.need_separator <- true;

     

       298
       298
       -
                    write_anchor t anchor;

     

       299
       299
       -
                    write_tag t ~implicit:plain_implicit tag;

     

       300
       300
       -
                    write_scalar t ~style value)

     

       301
       301
       -
             end else begin

     

       273
       273
       +
               match t.state with

     

       274
       274
       +
               | In_flow_mapping_key ->

     

       275
       275
       +
                   if t.need_separator then write t ", ";

     

       276
       276
       +
                   write_anchor t anchor;

     

       277
       277
       +
                   write_tag t ~implicit:plain_implicit tag;

     

       278
       278
       +
                   write_scalar t ~style value;

     

       279
       279
       +
                   write t ": ";

     

       280
       280
       +
                   t.need_separator <- false;

     

       281
       281
       +
                   t.state <- In_flow_mapping_value

     

       282
       282
       +
               | In_flow_mapping_value ->

     

       283
       283
       +
                   if t.need_separator then begin

     

       284
       284
       +
                     (* We just finished a nested structure (array/mapping),

     

       285
       285
       +
                         so this scalar is the next key, not a value *)

     

       286
       286
       +
                     write t ", ";

     

       287
       287
       +
                     write_anchor t anchor;

     

       288
       288
       +
                     write_tag t ~implicit:plain_implicit tag;

     

       289
       289
       +
                     write_scalar t ~style value;

     

       290
       290
       +
                     write t ": ";

     

       291
       291
       +
                     t.need_separator <- false;

     

       292
       292
       +
                     t.state <- In_flow_mapping_value

     

       293
       293
       +
                   end

     

       294
       294
       +
                   else begin

     

       295
       295
       +
                     (* Normal value scalar *)

     

       296
       296
       +
                     write_anchor t anchor;

     

       297
       297
       +
                     write_tag t ~implicit:plain_implicit tag;

     

       298
       298
       +
                     write_scalar t ~style value;

     

       299
       299
       +
                     t.need_separator <- true;

     

       300
       300
       +
                     t.state <- In_flow_mapping_key

     

       301
       301
       +
                   end

     

       302
       302
       +
               | _ ->

     

       303
       303
       +
                   if t.need_separator then write t ", ";

     

       304
       304
       +
                   t.need_separator <- true;

     

       305
       305
       +
                   write_anchor t anchor;

     

       306
       306
       +
                   write_tag t ~implicit:plain_implicit tag;

     

       307
       307
       +
                   write_scalar t ~style value

     

       308
       308
       +
             end

     

       309
       309
       +
             else begin

     

       302
       310
        
               match t.state with

     

       303
       311
        
               | In_block_sequence _ ->

     

       304
       312
        
                   write_indent t;

     
···

       334
       342
        
                   write_scalar t ~style value;

     

       335
       343
        
                   write_newline t

     

       336
       344
        
             end

     

       337
       337
       -
       

     

       338
       345
        
         | Event.Sequence_start { anchor; tag; implicit; style } ->

     

       339
       346
        
             let use_flow = style = `Flow || t.flow_level > 0 in

     

       340
       347
        
             if t.flow_level > 0 then begin

     

       341
       341
       -
               (match t.state with

     

       342
       342
       -
                | In_flow_mapping_key ->

     

       343
       343
       -
                    if t.need_separator then write t ", ";

     

       344
       344
       -
                    write_anchor t anchor;

     

       345
       345
       -
                    write_tag t ~implicit tag;

     

       346
       346
       -
                    write_char t '[';

     

       347
       347
       -
                    t.flow_level <- t.flow_level + 1;

     

       348
       348
       -
                    t.need_separator <- false;

     

       349
       349
       -
                    push_state t In_flow_mapping_value;  (* After ] we'll be in value position but sequence handles it *)

     

       350
       350
       -
                    t.state <- In_flow_sequence

     

       351
       351
       -
                | In_flow_mapping_value ->

     

       352
       352
       -
                    write_anchor t anchor;

     

       353
       353
       -
                    write_tag t ~implicit tag;

     

       354
       354
       -
                    write_char t '[';

     

       355
       355
       -
                    t.flow_level <- t.flow_level + 1;

     

       356
       356
       -
                    t.need_separator <- false;

     

       357
       357
       -
                    push_state t In_flow_mapping_key;

     

       358
       358
       -
                    t.state <- In_flow_sequence

     

       359
       359
       -
                | _ ->

     

       360
       360
       -
                    if t.need_separator then write t ", ";

     

       361
       361
       -
                    write_anchor t anchor;

     

       362
       362
       -
                    write_tag t ~implicit tag;

     

       363
       363
       -
                    write_char t '[';

     

       364
       364
       -
                    t.flow_level <- t.flow_level + 1;

     

       365
       365
       -
                    t.need_separator <- false;

     

       366
       366
       -
                    push_state t In_flow_sequence)

     

       367
       367
       -
             end else begin

     

       348
       348
       +
               match t.state with

     

       349
       349
       +
               | In_flow_mapping_key ->

     

       350
       350
       +
                   if t.need_separator then write t ", ";

     

       351
       351
       +
                   write_anchor t anchor;

     

       352
       352
       +
                   write_tag t ~implicit tag;

     

       353
       353
       +
                   write_char t '[';

     

       354
       354
       +
                   t.flow_level <- t.flow_level + 1;

     

       355
       355
       +
                   t.need_separator <- false;

     

       356
       356
       +
                   push_state t In_flow_mapping_value;

     

       357
       357
       +
                   (* After ] we'll be in value position but sequence handles it *)

     

       358
       358
       +
                   t.state <- In_flow_sequence

     

       359
       359
       +
               | In_flow_mapping_value ->

     

       360
       360
       +
                   write_anchor t anchor;

     

       361
       361
       +
                   write_tag t ~implicit tag;

     

       362
       362
       +
                   write_char t '[';

     

       363
       363
       +
                   t.flow_level <- t.flow_level + 1;

     

       364
       364
       +
                   t.need_separator <- false;

     

       365
       365
       +
                   push_state t In_flow_mapping_key;

     

       366
       366
       +
                   t.state <- In_flow_sequence

     

       367
       367
       +
               | _ ->

     

       368
       368
       +
                   if t.need_separator then write t ", ";

     

       369
       369
       +
                   write_anchor t anchor;

     

       370
       370
       +
                   write_tag t ~implicit tag;

     

       371
       371
       +
                   write_char t '[';

     

       372
       372
       +
                   t.flow_level <- t.flow_level + 1;

     

       373
       373
       +
                   t.need_separator <- false;

     

       374
       374
       +
                   push_state t In_flow_sequence

     

       375
       375
       +
             end

     

       376
       376
       +
             else begin

     

       368
       377
        
               match t.state with

     

       369
       378
        
               | In_block_sequence _ ->

     

       370
       379
        
                   write_indent t;

     
···

       376
       385
        
                     t.flow_level <- t.flow_level + 1;

     

       377
       386
        
                     t.need_separator <- false;

     

       378
       387
        
                     push_state t In_flow_sequence

     

       379
       379
       -
                   end else begin

     

       388
       388
       +
                   end

     

       389
       389
       +
                   else begin

     

       380
       390
        
                     write_newline t;

     

       381
       391
        
                     push_state t (In_block_sequence t.indent);

     

       382
       392
        
                     t.indent <- t.indent + t.config.indent

     
···

       410
       420
        
                     (* Save key state to return to after flow sequence *)

     

       411
       421
        
                     t.state <- In_block_mapping_key indent;

     

       412
       422
        
                     push_state t In_flow_sequence

     

       413
       413
       -
                   end else begin

     

       423
       423
       +
                   end

     

       424
       424
       +
                   else begin

     

       414
       425
        
                     write_newline t;

     

       415
       426
        
                     (* Save key state to return to after nested sequence *)

     

       416
       427
        
                     t.state <- In_block_mapping_key indent;

     
···

       425
       436
        
                     t.flow_level <- t.flow_level + 1;

     

       426
       437
        
                     t.need_separator <- false;

     

       427
       438
        
                     push_state t In_flow_sequence

     

       428
       428
       -
                   end else begin

     

       439
       439
       +
                   end

     

       440
       440
       +
                   else begin

     

       429
       441
        
                     push_state t (In_block_sequence t.indent);

     

       430
       442
        
                     t.state <- In_block_sequence t.indent

     

       431
       443
        
                   end

     

       432
       444
        
             end

     

       433
       433
       -
       

     

       434
       445
        
         | Event.Sequence_end ->

     

       435
       446
        
             if t.flow_level > 0 then begin

     

       436
       447
        
               write_char t ']';

     
···

       438
       449
        
               t.need_separator <- true;

     

       439
       450
        
               pop_state t;

     

       440
       451
        
               (* Write newline if returning to block context *)

     

       441
       441
       -
               (match t.state with

     

       442
       442
       -
                | In_block_mapping_key _ | In_block_sequence _ -> write_newline t

     

       443
       443
       -
                | _ -> ())

     

       444
       444
       -
             end else begin

     

       452
       452
       +
               match t.state with

     

       453
       453
       +
               | In_block_mapping_key _ | In_block_sequence _ -> write_newline t

     

       454
       454
       +
               | _ -> ()

     

       455
       455
       +
             end

     

       456
       456
       +
             else begin

     

       445
       457
        
               t.indent <- t.indent - t.config.indent;

     

       446
       458
        
               pop_state t

     

       447
       459
        
             end

     

       448
       448
       -
       

     

       449
       460
        
         | Event.Mapping_start { anchor; tag; implicit; style } ->

     

       450
       461
        
             let use_flow = style = `Flow || t.flow_level > 0 in

     

       451
       462
        
             if t.flow_level > 0 then begin

     

       452
       452
       -
               (match t.state with

     

       453
       453
       -
                | In_flow_mapping_key ->

     

       454
       454
       -
                    if t.need_separator then write t ", ";

     

       455
       455
       -
                    write_anchor t anchor;

     

       456
       456
       -
                    write_tag t ~implicit tag;

     

       457
       457
       -
                    write_char t '{';

     

       458
       458
       -
                    t.flow_level <- t.flow_level + 1;

     

       459
       459
       -
                    t.need_separator <- false;

     

       460
       460
       -
                    push_state t In_flow_mapping_value;

     

       461
       461
       -
                    t.state <- In_flow_mapping_key

     

       462
       462
       -
                | In_flow_mapping_value ->

     

       463
       463
       -
                    write_anchor t anchor;

     

       464
       464
       -
                    write_tag t ~implicit tag;

     

       465
       465
       -
                    write_char t '{';

     

       466
       466
       -
                    t.flow_level <- t.flow_level + 1;

     

       467
       467
       -
                    t.need_separator <- false;

     

       468
       468
       -
                    push_state t In_flow_mapping_key;

     

       469
       469
       -
                    t.state <- In_flow_mapping_key

     

       470
       470
       -
                | _ ->

     

       471
       471
       -
                    if t.need_separator then write t ", ";

     

       472
       472
       -
                    write_anchor t anchor;

     

       473
       473
       -
                    write_tag t ~implicit tag;

     

       474
       474
       -
                    write_char t '{';

     

       475
       475
       -
                    t.flow_level <- t.flow_level + 1;

     

       476
       476
       -
                    t.need_separator <- false;

     

       477
       477
       -
                    push_state t In_flow_mapping_key)

     

       478
       478
       -
             end else begin

     

       463
       463
       +
               match t.state with

     

       464
       464
       +
               | In_flow_mapping_key ->

     

       465
       465
       +
                   if t.need_separator then write t ", ";

     

       466
       466
       +
                   write_anchor t anchor;

     

       467
       467
       +
                   write_tag t ~implicit tag;

     

       468
       468
       +
                   write_char t '{';

     

       469
       469
       +
                   t.flow_level <- t.flow_level + 1;

     

       470
       470
       +
                   t.need_separator <- false;

     

       471
       471
       +
                   push_state t In_flow_mapping_value;

     

       472
       472
       +
                   t.state <- In_flow_mapping_key

     

       473
       473
       +
               | In_flow_mapping_value ->

     

       474
       474
       +
                   write_anchor t anchor;

     

       475
       475
       +
                   write_tag t ~implicit tag;

     

       476
       476
       +
                   write_char t '{';

     

       477
       477
       +
                   t.flow_level <- t.flow_level + 1;

     

       478
       478
       +
                   t.need_separator <- false;

     

       479
       479
       +
                   push_state t In_flow_mapping_key;

     

       480
       480
       +
                   t.state <- In_flow_mapping_key

     

       481
       481
       +
               | _ ->

     

       482
       482
       +
                   if t.need_separator then write t ", ";

     

       483
       483
       +
                   write_anchor t anchor;

     

       484
       484
       +
                   write_tag t ~implicit tag;

     

       485
       485
       +
                   write_char t '{';

     

       486
       486
       +
                   t.flow_level <- t.flow_level + 1;

     

       487
       487
       +
                   t.need_separator <- false;

     

       488
       488
       +
                   push_state t In_flow_mapping_key

     

       489
       489
       +
             end

     

       490
       490
       +
             else begin

     

       479
       491
        
               match t.state with

     

       480
       492
        
               | In_block_sequence _ ->

     

       481
       493
        
                   write_indent t;

     
···

       487
       499
        
                     t.flow_level <- t.flow_level + 1;

     

       488
       500
        
                     t.need_separator <- false;

     

       489
       501
        
                     push_state t In_flow_mapping_key

     

       490
       490
       -
                   end else begin

     

       502
       502
       +
                   end

     

       503
       503
       +
                   else begin

     

       491
       504
        
                     (* Don't write newline - first key goes on same line as "- " *)

     

       492
       505
        
                     push_state t (In_block_sequence t.indent);

     

       493
       506
        
                     t.indent <- t.indent + t.config.indent;

     
···

       522
       535
        
                     (* Save key state to return to after flow mapping *)

     

       523
       536
        
                     t.state <- In_block_mapping_key indent;

     

       524
       537
        
                     push_state t In_flow_mapping_key

     

       525
       525
       -
                   end else begin

     

       538
       538
       +
                   end

     

       539
       539
       +
                   else begin

     

       526
       540
        
                     write_newline t;

     

       527
       541
        
                     (* Save key state to return to after nested mapping *)

     

       528
       542
        
                     t.state <- In_block_mapping_key indent;

     
···

       537
       551
        
                     t.flow_level <- t.flow_level + 1;

     

       538
       552
        
                     t.need_separator <- false;

     

       539
       553
        
                     push_state t In_flow_mapping_key

     

       540
       540
       -
                   end else begin

     

       554
       554
       +
                   end

     

       555
       555
       +
                   else begin

     

       541
       556
        
                     push_state t (In_block_mapping_key t.indent);

     

       542
       557
        
                     t.state <- In_block_mapping_key t.indent

     

       543
       558
        
                   end

     

       544
       559
        
             end

     

       545
       545
       -
       

     

       546
       560
        
         | Event.Mapping_end ->

     

       547
       561
        
             if t.flow_level > 0 then begin

     

       548
       562
        
               write_char t '}';

     
···

       550
       564
        
               t.need_separator <- true;

     

       551
       565
        
               pop_state t;

     

       552
       566
        
               (* Write newline if returning to block context *)

     

       553
       553
       -
               (match t.state with

     

       554
       554
       -
                | In_block_mapping_key _ | In_block_sequence _ -> write_newline t

     

       555
       555
       -
                | _ -> ())

     

       556
       556
       -
             end else begin

     

       567
       567
       +
               match t.state with

     

       568
       568
       +
               | In_block_mapping_key _ | In_block_sequence _ -> write_newline t

     

       569
       569
       +
               | _ -> ()

     

       570
       570
       +
             end

     

       571
       571
       +
             else begin

     

       557
       572
        
               t.indent <- t.indent - t.config.indent;

     

       558
       573
        
               pop_state t

     

       559
       574
        
             end

     

       560
       575
        
       

     

       561
       561
       -
       (** Access to the underlying buffer for advanced use.

     

       562
       562
       -
           Returns None if emitter is writing to a Writer instead of Buffer. *)

     

       576
       576
       +
       (** Access to the underlying buffer for advanced use. Returns None if emitter is

     

       577
       577
       +
           writing to a Writer instead of Buffer. *)

     

       563
       578
        
       let buffer t =

     

       564
       564
       -
         match t.sink with

     

       565
       565
       -
         | Buffer_sink buf -> Some buf

     

       566
       566
       -
         | Writer_sink _ -> None

     

       579
       579
       +
         match t.sink with Buffer_sink buf -> Some buf | Writer_sink _ -> None

     

       567
       580
        
       

     

       568
       581
        
       (** Get config *)

     

       569
       582
        
       let config t = t.config

     

       570
       583
        
       

     

       571
       584
        
       (** Check if emitter is writing to a Writer *)

     

       572
       585
        
       let is_streaming t =

     

       573
       573
       -
         match t.sink with

     

       574
       574
       -
         | Writer_sink _ -> true

     

       575
       575
       -
         | Buffer_sink _ -> false

     

       586
       586
       +
         match t.sink with Writer_sink _ -> true | Buffer_sink _ -> false

     

       576
       587
        
       

     

       577
       588
        
       (** Flush the writer sink (no-op for buffer sink) *)

     

       578
       589
        
       let flush t =

+62

lib/emitter.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Emitter - converts YAML data structures to string output

     

       7
       7
       +
       

     

       8
       8
       +
           The emitter can write to either a Buffer (default) or directly to a

     

       9
       9
       +
           bytesrw Bytes.Writer for streaming output. *)

     

       10
       10
       +
       

     

       11
       11
       +
       (** {1 Configuration} *)

     

       12
       12
       +
       

     

       13
       13
       +
       type config = {

     

       14
       14
       +
         encoding : Encoding.t;

     

       15
       15
       +
         scalar_style : Scalar_style.t;

     

       16
       16
       +
         layout_style : Layout_style.t;

     

       17
       17
       +
         indent : int;

     

       18
       18
       +
         width : int;

     

       19
       19
       +
         canonical : bool;

     

       20
       20
       +
       }

     

       21
       21
       +
       

     

       22
       22
       +
       val default_config : config

     

       23
       23
       +
       (** Default emitter configuration *)

     

       24
       24
       +
       

     

       25
       25
       +
       (** {1 Emitter Type} *)

     

       26
       26
       +
       

     

       27
       27
       +
       type t

     

       28
       28
       +
       

     

       29
       29
       +
       (** {1 Constructors} *)

     

       30
       30
       +
       

     

       31
       31
       +
       val create : ?config:config -> unit -> t

     

       32
       32
       +
       (** Create an emitter that writes to an internal buffer *)

     

       33
       33
       +
       

     

       34
       34
       +
       val of_writer : ?config:config -> Bytesrw.Bytes.Writer.t -> t

     

       35
       35
       +
       (** Create an emitter that writes directly to a Bytes.Writer *)

     

       36
       36
       +
       

     

       37
       37
       +
       (** {1 Output} *)

     

       38
       38
       +
       

     

       39
       39
       +
       val contents : t -> string

     

       40
       40
       +
       (** Get accumulated output. Returns empty string for writer-based emitters. *)

     

       41
       41
       +
       

     

       42
       42
       +
       val reset : t -> unit

     

       43
       43
       +
       (** Reset emitter state and clear buffer *)

     

       44
       44
       +
       

     

       45
       45
       +
       val buffer : t -> Buffer.t option

     

       46
       46
       +
       (** Access underlying buffer (None for writer-based emitters) *)

     

       47
       47
       +
       

     

       48
       48
       +
       val flush : t -> unit

     

       49
       49
       +
       (** Flush writer sink (no-op for buffer-based emitters) *)

     

       50
       50
       +
       

     

       51
       51
       +
       (** {1 Event Emission} *)

     

       52
       52
       +
       

     

       53
       53
       +
       val emit : t -> Event.t -> unit

     

       54
       54
       +
       (** Emit a single event *)

     

       55
       55
       +
       

     

       56
       56
       +
       (** {1 Accessors} *)

     

       57
       57
       +
       

     

       58
       58
       +
       val config : t -> config

     

       59
       59
       +
       (** Get emitter configuration *)

     

       60
       60
       +
       

     

       61
       61
       +
       val is_streaming : t -> bool

     

       62
       62
       +
       (** Check if emitter is writing to a Writer (vs buffer) *)

+12 -20

lib/encoding.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Character encoding detection and handling *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = [

     

       9
       9
       -
         | `Utf8

     

       10
       10
       -
         | `Utf16be

     

       11
       11
       -
         | `Utf16le

     

       12
       12
       -
         | `Utf32be

     

       13
       13
       -
         | `Utf32le

     

       14
       14
       -
       ]

     

       8
       8
       +
       type t = [ `Utf8 | `Utf16be | `Utf16le | `Utf32be | `Utf32le ]

     

       15
       9
        
       

     

       16
       10
        
       let to_string = function

     

       17
       11
        
         | `Utf8 -> "UTF-8"

     
···

       20
       14
        
         | `Utf32be -> "UTF-32BE"

     

       21
       15
        
         | `Utf32le -> "UTF-32LE"

     

       22
       16
        
       

     

       23
       23
       -
       let pp fmt t =

     

       24
       24
       -
         Format.pp_print_string fmt (to_string t)

     

       17
       17
       +
       let pp fmt t = Format.pp_print_string fmt (to_string t)

     

       25
       18
        
       

     

       26
       26
       -
       (** Detect encoding from BOM or first bytes.

     

       27
       27
       -
           Returns (encoding, bom_length) *)

     

       19
       19
       +
       (** Detect encoding from BOM or first bytes. Returns (encoding, bom_length) *)

     

       28
       20
        
       let detect s =

     

       29
       21
        
         let len = String.length s in

     

       30
       22
        
         if len = 0 then (`Utf8, 0)

     
···

       35
       27
        
           let b3 = if len > 3 then Char.code s.[3] else 0 in

     

       36
       28
        
           match (b0, b1, b2, b3) with

     

       37
       29
        
           (* BOM patterns *)

     

       38
       38
       -
           | (0xEF, 0xBB, 0xBF, _) -> (`Utf8, 3)

     

       39
       39
       -
           | (0xFE, 0xFF, _, _) -> (`Utf16be, 2)

     

       40
       40
       -
           | (0xFF, 0xFE, 0x00, 0x00) -> (`Utf32le, 4)

     

       41
       41
       -
           | (0xFF, 0xFE, _, _) -> (`Utf16le, 2)

     

       42
       42
       -
           | (0x00, 0x00, 0xFE, 0xFF) -> (`Utf32be, 4)

     

       30
       30
       +
           | 0xEF, 0xBB, 0xBF, _ -> (`Utf8, 3)

     

       31
       31
       +
           | 0xFE, 0xFF, _, _ -> (`Utf16be, 2)

     

       32
       32
       +
           | 0xFF, 0xFE, 0x00, 0x00 -> (`Utf32le, 4)

     

       33
       33
       +
           | 0xFF, 0xFE, _, _ -> (`Utf16le, 2)

     

       34
       34
       +
           | 0x00, 0x00, 0xFE, 0xFF -> (`Utf32be, 4)

     

       43
       35
        
           (* Content pattern detection (no BOM) *)

     

       44
       44
       -
           | (0x00, 0x00, 0x00, b3) when b3 <> 0x00 -> (`Utf32be, 0)

     

       45
       45
       -
           | (b0, 0x00, 0x00, 0x00) when b0 <> 0x00 -> (`Utf32le, 0)

     

       46
       46
       -
           | (0x00, b1, _, _) when b1 <> 0x00 -> (`Utf16be, 0)

     

       47
       47
       -
           | (b0, 0x00, _, _) when b0 <> 0x00 -> (`Utf16le, 0)

     

       36
       36
       +
           | 0x00, 0x00, 0x00, b3 when b3 <> 0x00 -> (`Utf32be, 0)

     

       37
       37
       +
           | b0, 0x00, 0x00, 0x00 when b0 <> 0x00 -> (`Utf32le, 0)

     

       38
       38
       +
           | 0x00, b1, _, _ when b1 <> 0x00 -> (`Utf16be, 0)

     

       39
       39
       +
           | b0, 0x00, _, _ when b0 <> 0x00 -> (`Utf16le, 0)

     

       48
       40
        
           | _ -> (`Utf8, 0)

     

       49
       41
        
       

     

       50
       42
        
       let equal a b = a = b

+27

lib/encoding.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Character encoding detection and handling *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = [

     

       9
       9
       +
         | `Utf8

     

       10
       10
       +
         | `Utf16be

     

       11
       11
       +
         | `Utf16le

     

       12
       12
       +
         | `Utf32be

     

       13
       13
       +
         | `Utf32le

     

       14
       14
       +
       ]

     

       15
       15
       +
       

     

       16
       16
       +
       val to_string : t -> string

     

       17
       17
       +
       (** Convert encoding to string representation *)

     

       18
       18
       +
       

     

       19
       19
       +
       val pp : Format.formatter -> t -> unit

     

       20
       20
       +
       (** Pretty-print an encoding *)

     

       21
       21
       +
       

     

       22
       22
       +
       val detect : string -> t * int

     

       23
       23
       +
       (** Detect encoding from BOM or first bytes.

     

       24
       24
       +
           Returns (encoding, bom_length) *)

     

       25
       25
       +
       

     

       26
       26
       +
       val equal : t -> t -> bool

     

       27
       27
       +
       (** Test equality of two encodings *)

+135 -105

lib/error.ml

···

       7
       7
        
       

     

       8
       8
        
           Comprehensive error reporting for YAML parsing and emission.

     

       9
       9
        
       

     

       10
       10
       -
           This module provides detailed error types that correspond to various

     

       11
       11
       -
           failure modes in YAML processing, as specified in the

     

       10
       10
       +
           This module provides detailed error types that correspond to various failure

     

       11
       11
       +
           modes in YAML processing, as specified in the

     

       12
       12
        
           {{:https://yaml.org/spec/1.2.2/}YAML 1.2.2 specification}.

     

       13
       13
        
       

     

       14
       14
        
           Each error includes:

     
···

       17
       17
        
           - A context stack showing where the error occurred

     

       18
       18
        
           - Optional source text for error display

     

       19
       19
        
       

     

       20
       20
       -
           See also {{:https://yaml.org/spec/1.2.2/#31-processes}Section 3.1 (Processes)}

     

       21
       21
       -
           for background on the YAML processing model. *)

     

       20
       20
       +
           See also

     

       21
       21
       +
           {{:https://yaml.org/spec/1.2.2/#31-processes}Section 3.1 (Processes)} for

     

       22
       22
       +
           background on the YAML processing model. *)

     

       22
       23
        
       

     

       23
       24
        
       (** {2 Error Classification}

     

       24
       25
        
       

     
···

       31
       32
        
         (* Scanner errors - see {{:https://yaml.org/spec/1.2.2/#51-character-set}Section 5.1} *)

     

       32
       33
        
         | Unexpected_character of char

     

       33
       34
        
             (** Invalid character in input. See

     

       34
       34
       -
                 {{:https://yaml.org/spec/1.2.2/#51-character-set}Section 5.1 (Character Set)}. *)

     

       35
       35
       -
         | Unexpected_eof

     

       36
       36
       -
             (** Premature end of input. *)

     

       35
       35
       +
                 {{:https://yaml.org/spec/1.2.2/#51-character-set}Section 5.1

     

       36
       36
       +
                  (Character Set)}. *)

     

       37
       37
       +
         | Unexpected_eof  (** Premature end of input. *)

     

       37
       38
        
         | Invalid_escape_sequence of string

     

       38
       39
        
             (** Invalid escape in double-quoted string. See

     

       39
       39
       -
                 {{:https://yaml.org/spec/1.2.2/#57-escaped-characters}Section 5.7 (Escaped Characters)}. *)

     

       40
       40
       +
                 {{:https://yaml.org/spec/1.2.2/#57-escaped-characters}Section 5.7

     

       41
       41
       +
                  (Escaped Characters)}. *)

     

       40
       42
        
         | Invalid_unicode_escape of string

     

       41
       43
        
             (** Invalid Unicode escape sequence (\uXXXX or \UXXXXXXXX). *)

     

       42
       44
        
         | Invalid_hex_escape of string

     

       43
       45
        
             (** Invalid hexadecimal escape sequence (\xXX). *)

     

       44
       46
        
         | Invalid_tag of string

     

       45
       47
        
             (** Malformed tag syntax. See

     

       46
       46
       -
                 {{:https://yaml.org/spec/1.2.2/#681-node-tags}Section 6.8.1 (Node Tags)}. *)

     

       48
       48
       +
                 {{:https://yaml.org/spec/1.2.2/#681-node-tags}Section 6.8.1 (Node

     

       49
       49
       +
                  Tags)}. *)

     

       47
       50
        
         | Invalid_anchor of string

     

       48
       51
        
             (** Malformed anchor name. See

     

       49
       49
       -
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       52
       52
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       53
       53
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       50
       54
        
         | Invalid_alias of string

     

       51
       55
        
             (** Malformed alias reference. See

     

       52
       52
       -
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       56
       56
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       57
       57
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       53
       58
        
         | Invalid_comment

     

       54
       59
        
             (** Comment not properly separated from content. See

     

       55
       55
       -
                 {{:https://yaml.org/spec/1.2.2/#62-comments}Section 6.2 (Comments)}. *)

     

       60
       60
       +
                 {{:https://yaml.org/spec/1.2.2/#62-comments}Section 6.2 (Comments)}.

     

       61
       61
       +
             *)

     

       56
       62
        
         | Unclosed_single_quote

     

       57
       63
        
             (** Unterminated single-quoted scalar. See

     

       58
       58
       -
                 {{:https://yaml.org/spec/1.2.2/#72-single-quoted-style}Section 7.2 (Single-Quoted Style)}. *)

     

       64
       64
       +
                 {{:https://yaml.org/spec/1.2.2/#72-single-quoted-style}Section 7.2

     

       65
       65
       +
                  (Single-Quoted Style)}. *)

     

       59
       66
        
         | Unclosed_double_quote

     

       60
       67
        
             (** Unterminated double-quoted scalar. See

     

       61
       61
       -
                 {{:https://yaml.org/spec/1.2.2/#73-double-quoted-style}Section 7.3 (Double-Quoted Style)}. *)

     

       68
       68
       +
                 {{:https://yaml.org/spec/1.2.2/#73-double-quoted-style}Section 7.3

     

       69
       69
       +
                  (Double-Quoted Style)}. *)

     

       62
       70
        
         | Unclosed_flow_sequence

     

       63
       71
        
             (** Missing closing bracket \] for flow sequence. See

     

       64
       64
       -
                 {{:https://yaml.org/spec/1.2.2/#742-flow-sequences}Section 7.4.2 (Flow Sequences)}. *)

     

       72
       72
       +
                 {{:https://yaml.org/spec/1.2.2/#742-flow-sequences}Section 7.4.2 (Flow

     

       73
       73
       +
                  Sequences)}. *)

     

       65
       74
        
         | Unclosed_flow_mapping

     

       66
       75
        
             (** Missing closing brace \} for flow mapping. See

     

       67
       67
       -
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow Mappings)}. *)

     

       76
       76
       +
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow

     

       77
       77
       +
                  Mappings)}. *)

     

       68
       78
        
         | Invalid_indentation of int * int

     

       69
       79
        
             (** Incorrect indentation level (expected, got). See

     

       70
       70
       -
                 {{:https://yaml.org/spec/1.2.2/#61-indentation-spaces}Section 6.1 (Indentation Spaces)}. *)

     

       80
       80
       +
                 {{:https://yaml.org/spec/1.2.2/#61-indentation-spaces}Section 6.1

     

       81
       81
       +
                  (Indentation Spaces)}. *)

     

       71
       82
        
         | Invalid_flow_indentation

     

       72
       83
        
             (** Content in flow collection must be indented. See

     

       73
       73
       -
                 {{:https://yaml.org/spec/1.2.2/#74-flow-styles}Section 7.4 (Flow Styles)}. *)

     

       84
       84
       +
                 {{:https://yaml.org/spec/1.2.2/#74-flow-styles}Section 7.4 (Flow

     

       85
       85
       +
                  Styles)}. *)

     

       74
       86
        
         | Tab_in_indentation

     

       75
       87
        
             (** Tab character used for indentation (only spaces allowed). See

     

       76
       76
       -
                 {{:https://yaml.org/spec/1.2.2/#61-indentation-spaces}Section 6.1 (Indentation Spaces)}. *)

     

       88
       88
       +
                 {{:https://yaml.org/spec/1.2.2/#61-indentation-spaces}Section 6.1

     

       89
       89
       +
                  (Indentation Spaces)}. *)

     

       77
       90
        
         | Invalid_block_scalar_header of string

     

       78
       91
        
             (** Malformed block scalar header (| or >). See

     

       79
       79
       -
                 {{:https://yaml.org/spec/1.2.2/#81-block-scalar-styles}Section 8.1 (Block Scalar Styles)}. *)

     

       92
       92
       +
                 {{:https://yaml.org/spec/1.2.2/#81-block-scalar-styles}Section 8.1

     

       93
       93
       +
                  (Block Scalar Styles)}. *)

     

       80
       94
        
         | Invalid_quoted_scalar_indentation of string

     

       81
       95
        
             (** Incorrect indentation in quoted scalar. *)

     

       82
       96
        
         | Invalid_directive of string

     

       83
       97
        
             (** Malformed directive. See

     

       84
       84
       -
                 {{:https://yaml.org/spec/1.2.2/#68-directives}Section 6.8 (Directives)}. *)

     

       98
       98
       +
                 {{:https://yaml.org/spec/1.2.2/#68-directives}Section 6.8

     

       99
       99
       +
                  (Directives)}. *)

     

       85
       100
        
         | Invalid_yaml_version of string

     

       86
       101
        
             (** Unsupported YAML version in %YAML directive. See

     

       87
       87
       -
                 {{:https://yaml.org/spec/1.2.2/#681-yaml-directives}Section 6.8.1 (YAML Directives)}. *)

     

       102
       102
       +
                 {{:https://yaml.org/spec/1.2.2/#681-yaml-directives}Section 6.8.1

     

       103
       103
       +
                  (YAML Directives)}. *)

     

       88
       104
        
         | Invalid_tag_directive of string

     

       89
       105
        
             (** Malformed %TAG directive. See

     

       90
       90
       -
                 {{:https://yaml.org/spec/1.2.2/#682-tag-directives}Section 6.8.2 (TAG Directives)}. *)

     

       106
       106
       +
                 {{:https://yaml.org/spec/1.2.2/#682-tag-directives}Section 6.8.2 (TAG

     

       107
       107
       +
                  Directives)}. *)

     

       91
       108
        
         | Reserved_directive of string

     

       92
       109
        
             (** Reserved directive name. See

     

       93
       93
       -
                 {{:https://yaml.org/spec/1.2.2/#683-reserved-directives}Section 6.8.3 (Reserved Directives)}. *)

     

       110
       110
       +
                 {{:https://yaml.org/spec/1.2.2/#683-reserved-directives}Section 6.8.3

     

       111
       111
       +
                  (Reserved Directives)}. *)

     

       94
       112
        
         | Illegal_flow_key_line

     

       95
       113
        
             (** Key and colon must be on same line in flow context. See

     

       96
       96
       -
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow Mappings)}. *)

     

       114
       114
       +
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow

     

       115
       115
       +
                  Mappings)}. *)

     

       97
       116
        
         | Block_sequence_disallowed

     

       98
       117
        
             (** Block sequence entries not allowed in this context. See

     

       99
       99
       -
                 {{:https://yaml.org/spec/1.2.2/#82-block-collection-styles}Section 8.2 (Block Collection Styles)}. *)

     

       100
       100
       -
       

     

       118
       118
       +
                 {{:https://yaml.org/spec/1.2.2/#82-block-collection-styles}Section 8.2

     

       119
       119
       +
                  (Block Collection Styles)}. *)

     

       101
       120
        
         (* Parser errors - see {{:https://yaml.org/spec/1.2.2/#3-processing-yaml-information}Section 3 (Processing)} *)

     

       102
       102
       -
         | Unexpected_token of string

     

       103
       103
       -
             (** Unexpected token in event stream. *)

     

       121
       121
       +
         | Unexpected_token of string  (** Unexpected token in event stream. *)

     

       104
       122
        
         | Expected_document_start

     

       105
       123
        
             (** Expected document start marker (---). See

     

       106
       106
       -
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2 (Document Markers)}. *)

     

       124
       124
       +
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2

     

       125
       125
       +
                  (Document Markers)}. *)

     

       107
       126
        
         | Expected_document_end

     

       108
       127
        
             (** Expected document end marker (...). See

     

       109
       109
       -
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2 (Document Markers)}. *)

     

       128
       128
       +
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2

     

       129
       129
       +
                  (Document Markers)}. *)

     

       110
       130
        
         | Expected_block_entry

     

       111
       131
        
             (** Expected block sequence entry marker (-). See

     

       112
       112
       -
                 {{:https://yaml.org/spec/1.2.2/#821-block-sequences}Section 8.2.1 (Block Sequences)}. *)

     

       132
       132
       +
                 {{:https://yaml.org/spec/1.2.2/#821-block-sequences}Section 8.2.1

     

       133
       133
       +
                  (Block Sequences)}. *)

     

       113
       134
        
         | Expected_key

     

       114
       135
        
             (** Expected mapping key. See

     

       115
       115
       -
                 {{:https://yaml.org/spec/1.2.2/#822-block-mappings}Section 8.2.2 (Block Mappings)}. *)

     

       136
       136
       +
                 {{:https://yaml.org/spec/1.2.2/#822-block-mappings}Section 8.2.2

     

       137
       137
       +
                  (Block Mappings)}. *)

     

       116
       138
        
         | Expected_value

     

       117
       139
        
             (** Expected mapping value after colon. See

     

       118
       118
       -
                 {{:https://yaml.org/spec/1.2.2/#822-block-mappings}Section 8.2.2 (Block Mappings)}. *)

     

       119
       119
       -
         | Expected_node

     

       120
       120
       -
             (** Expected a YAML node. *)

     

       121
       121
       -
         | Expected_scalar

     

       122
       122
       -
             (** Expected a scalar value. *)

     

       140
       140
       +
                 {{:https://yaml.org/spec/1.2.2/#822-block-mappings}Section 8.2.2

     

       141
       141
       +
                  (Block Mappings)}. *)

     

       142
       142
       +
         | Expected_node  (** Expected a YAML node. *)

     

       143
       143
       +
         | Expected_scalar  (** Expected a scalar value. *)

     

       123
       144
        
         | Expected_sequence_end

     

       124
       145
        
             (** Expected closing bracket \] for flow sequence. See

     

       125
       125
       -
                 {{:https://yaml.org/spec/1.2.2/#742-flow-sequences}Section 7.4.2 (Flow Sequences)}. *)

     

       146
       146
       +
                 {{:https://yaml.org/spec/1.2.2/#742-flow-sequences}Section 7.4.2 (Flow

     

       147
       147
       +
                  Sequences)}. *)

     

       126
       148
        
         | Expected_mapping_end

     

       127
       149
        
             (** Expected closing brace \} for flow mapping. See

     

       128
       128
       -
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow Mappings)}. *)

     

       150
       150
       +
                 {{:https://yaml.org/spec/1.2.2/#743-flow-mappings}Section 7.4.3 (Flow

     

       151
       151
       +
                  Mappings)}. *)

     

       129
       152
        
         | Duplicate_anchor of string

     

       130
       153
        
             (** Anchor name defined multiple times. See

     

       131
       131
       -
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       154
       154
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       155
       155
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       132
       156
        
         | Undefined_alias of string

     

       133
       157
        
             (** Alias references non-existent anchor. See

     

       134
       134
       -
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       158
       158
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       159
       159
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       135
       160
        
         | Alias_cycle of string

     

       136
       161
        
             (** Circular reference in alias chain. See

     

       137
       137
       -
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       162
       162
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       163
       163
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       138
       164
        
         | Multiple_documents

     

       139
       165
        
             (** Multiple documents found when single document expected. See

     

       140
       140
       -
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2 (Document Markers)}. *)

     

       166
       166
       +
                 {{:https://yaml.org/spec/1.2.2/#912-document-markers}Section 9.1.2

     

       167
       167
       +
                  (Document Markers)}. *)

     

       141
       168
        
         | Mapping_key_too_long

     

       142
       169
        
             (** Mapping key exceeds maximum length (1024 characters). *)

     

       143
       143
       -
       

     

       144
       170
        
         (* Loader errors - see {{:https://yaml.org/spec/1.2.2/#31-processes}Section 3.1 (Processes)} *)

     

       145
       171
        
         | Invalid_scalar_conversion of string * string

     

       146
       146
       -
             (** Cannot convert scalar value to target type (value, target type).

     

       147
       147
       -
                 See {{:https://yaml.org/spec/1.2.2/#103-core-schema}Section 10.3 (Core Schema)}. *)

     

       172
       172
       +
             (** Cannot convert scalar value to target type (value, target type). See

     

       173
       173
       +
                 {{:https://yaml.org/spec/1.2.2/#103-core-schema}Section 10.3 (Core

     

       174
       174
       +
                  Schema)}. *)

     

       148
       175
        
         | Type_mismatch of string * string

     

       149
       176
        
             (** Value has wrong type for operation (expected, got). *)

     

       150
       177
        
         | Unresolved_alias of string

     

       151
       151
       -
             (** Alias encountered during conversion but not resolved.

     

       152
       152
       -
                 See {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2 (Anchors and Aliases)}. *)

     

       153
       153
       -
         | Key_not_found of string

     

       154
       154
       -
             (** Mapping key not found. *)

     

       178
       178
       +
             (** Alias encountered during conversion but not resolved. See

     

       179
       179
       +
                 {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section

     

       180
       180
       +
                  3.2.2.2 (Anchors and Aliases)}. *)

     

       181
       181
       +
         | Key_not_found of string  (** Mapping key not found. *)

     

       155
       182
        
         | Alias_expansion_node_limit of int

     

       156
       156
       -
             (** Alias expansion exceeded maximum node count (protection against billion laughs attack).

     

       157
       157
       -
                 See {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1 (Processes)}.

     

       183
       183
       +
             (** Alias expansion exceeded maximum node count (protection against

     

       184
       184
       +
                 billion laughs attack). See

     

       185
       185
       +
                 {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1

     

       186
       186
       +
                  (Processes)}.

     

       158
       187
        
       

     

       159
       159
       -
                 The "billion laughs attack" (also known as an XML bomb) is a denial-of-service

     

       160
       160
       -
                 attack where a small YAML document expands to enormous size through recursive

     

       161
       161
       -
                 alias expansion. This limit prevents such attacks. *)

     

       188
       188
       +
                 The "billion laughs attack" (also known as an XML bomb) is a

     

       189
       189
       +
                 denial-of-service attack where a small YAML document expands to

     

       190
       190
       +
                 enormous size through recursive alias expansion. This limit prevents

     

       191
       191
       +
                 such attacks. *)

     

       162
       192
        
         | Alias_expansion_depth_limit of int

     

       163
       163
       -
             (** Alias expansion exceeded maximum nesting depth (protection against deeply nested aliases).

     

       164
       164
       -
                 See {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1 (Processes)}. *)

     

       165
       165
       -
       

     

       193
       193
       +
             (** Alias expansion exceeded maximum nesting depth (protection against

     

       194
       194
       +
                 deeply nested aliases). See

     

       195
       195
       +
                 {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1

     

       196
       196
       +
                  (Processes)}. *)

     

       166
       197
        
         (* Emitter errors *)

     

       167
       198
        
         | Invalid_encoding of string

     

       168
       199
        
             (** Invalid character encoding specified. See

     

       169
       169
       -
                 {{:https://yaml.org/spec/1.2.2/#51-character-set}Section 5.1 (Character Set)}. *)

     

       200
       200
       +
                 {{:https://yaml.org/spec/1.2.2/#51-character-set}Section 5.1

     

       201
       201
       +
                  (Character Set)}. *)

     

       170
       202
        
         | Scalar_contains_invalid_chars of string

     

       171
       203
        
             (** Scalar contains characters invalid for chosen style. *)

     

       172
       172
       -
         | Anchor_not_set

     

       173
       173
       -
             (** Attempted to emit alias before anchor was defined. *)

     

       204
       204
       +
         | Anchor_not_set  (** Attempted to emit alias before anchor was defined. *)

     

       174
       205
        
         | Invalid_state of string

     

       175
       206
        
             (** Emitter in invalid state for requested operation. *)

     

       176
       176
       -
       

     

       177
       207
        
         (* Generic *)

     

       178
       178
       -
         | Custom of string

     

       179
       179
       -
             (** Custom error message. *)

     

       208
       208
       +
         | Custom of string  (** Custom error message. *)

     

       180
       209
        
       

     

       181
       181
       -
       (** {2 Error Value}

     

       182
       182
       -
       

     

       183
       183
       -
           Full error information including classification, location, and context. *)

     

       184
       210
        
       type t = {

     

       185
       185
       -
         kind : kind;

     

       186
       186
       -
             (** The specific error classification. *)

     

       211
       211
       +
         kind : kind;  (** The specific error classification. *)

     

       187
       212
        
         span : Span.t option;

     

       188
       213
        
             (** Source location where the error occurred (if available). *)

     

       189
       214
        
         context : string list;

     
···

       191
       216
        
         source : string option;

     

       192
       217
        
             (** Source text for displaying the error in context. *)

     

       193
       218
        
       }

     

       219
       219
       +
       (** {2 Error Value}

     

       194
       220
        
       

     

       221
       221
       +
           Full error information including classification, location, and context. *)

     

       222
       222
       +
       

     

       223
       223
       +
       exception Yamlrw_error of t

     

       195
       224
        
       (** {2 Exception}

     

       196
       225
        
       

     

       197
       226
        
           The main exception type raised by all yamlrw operations.

     

       198
       227
        
       

     

       199
       199
       -
           All parsing, loading, and emitting errors are reported by raising

     

       200
       200
       -
           this exception with detailed error information. *)

     

       201
       201
       -
       exception Yamlrw_error of t

     

       228
       228
       +
           All parsing, loading, and emitting errors are reported by raising this

     

       229
       229
       +
           exception with detailed error information. *)

     

       202
       230
        
       

     

       203
       231
        
       let () =

     

       204
       232
        
         Printexc.register_printer (function

     

       205
       233
        
           | Yamlrw_error e ->

     

       206
       206
       -
               let loc = match e.span with

     

       234
       234
       +
               let loc =

     

       235
       235
       +
                 match e.span with

     

       207
       236
        
                 | None -> ""

     

       208
       237
        
                 | Some span -> " at " ^ Span.to_string span

     

       209
       238
        
               in

     

       210
       210
       -
               Some (Printf.sprintf "Yamlrw_error: %s%s"

     

       211
       211
       -
                 (match e.kind with Custom s -> s | _ -> "error") loc)

     

       239
       239
       +
               Some

     

       240
       240
       +
                 (Printf.sprintf "Yamlrw_error: %s%s"

     

       241
       241
       +
                    (match e.kind with Custom s -> s | _ -> "error")

     

       242
       242
       +
                    loc)

     

       212
       243
        
           | _ -> None)

     

       213
       244
        
       

     

       214
       245
        
       (** {2 Error Construction} *)

     
···

       219
       250
        
           @param context Context stack (defaults to empty)

     

       220
       251
        
           @param source Source text

     

       221
       252
        
           @param kind Error classification *)

     

       222
       222
       -
       let make ?span ?(context=[]) ?source kind =

     

       223
       223
       -
         { kind; span; context; source }

     

       253
       253
       +
       let make ?span ?(context = []) ?source kind = { kind; span; context; source }

     

       224
       254
        
       

     

       225
       255
        
       (** [raise ?span ?context ?source kind] constructs and raises an error.

     

       226
       256
        
       

     
···

       248
       278
        
           @param span Source span

     

       249
       279
        
           @param kind Error classification

     

       250
       280
        
           @raise Yamlrw_error *)

     

       251
       251
       -
       let raise_span span kind =

     

       252
       252
       -
         raise ~span kind

     

       281
       281
       +
       let raise_span span kind = raise ~span kind

     

       253
       282
        
       

     

       254
       254
       -
       (** [with_context ctx f] executes [f ()] and adds [ctx] to any raised error's context.

     

       283
       283
       +
       (** [with_context ctx f] executes [f ()] and adds [ctx] to any raised error's

     

       284
       284
       +
           context.

     

       255
       285
        
       

     

       256
       286
        
           This is useful for tracking the processing path through nested structures.

     

       257
       287
        
       

     

       258
       288
        
           @param ctx Context description (e.g., "parsing mapping key")

     

       259
       289
        
           @param f Function to execute *)

     

       260
       290
        
       let with_context ctx f =

     

       261
       261
       -
         try f () with

     

       262
       262
       -
         | Yamlrw_error e ->

     

       263
       263
       -
             Stdlib.raise (Yamlrw_error { e with context = ctx :: e.context })

     

       291
       291
       +
         try f ()

     

       292
       292
       +
         with Yamlrw_error e ->

     

       293
       293
       +
           Stdlib.raise (Yamlrw_error { e with context = ctx :: e.context })

     

       264
       294
        
       

     

       265
       295
        
       (** {2 Error Formatting} *)

     

       266
       296
        
       

     
···

       274
       304
        
         | Invalid_tag s -> Printf.sprintf "invalid tag: %s" s

     

       275
       305
        
         | Invalid_anchor s -> Printf.sprintf "invalid anchor: %s" s

     

       276
       306
        
         | Invalid_alias s -> Printf.sprintf "invalid alias: %s" s

     

       277
       277
       -
         | Invalid_comment -> "comments must be separated from other tokens by whitespace"

     

       307
       307
       +
         | Invalid_comment ->

     

       308
       308
       +
             "comments must be separated from other tokens by whitespace"

     

       278
       309
        
         | Unclosed_single_quote -> "unclosed single quote"

     

       279
       310
        
         | Unclosed_double_quote -> "unclosed double quote"

     

       280
       311
        
         | Unclosed_flow_sequence -> "unclosed flow sequence '['"

     
···

       285
       316
        
         | Tab_in_indentation -> "tab character in indentation"

     

       286
       317
        
         | Invalid_block_scalar_header s ->

     

       287
       318
        
             Printf.sprintf "invalid block scalar header: %s" s

     

       288
       288
       -
         | Invalid_quoted_scalar_indentation s ->

     

       289
       289
       -
             Printf.sprintf "%s" s

     

       319
       319
       +
         | Invalid_quoted_scalar_indentation s -> Printf.sprintf "%s" s

     

       290
       320
        
         | Invalid_directive s -> Printf.sprintf "invalid directive: %s" s

     

       291
       321
        
         | Invalid_yaml_version s -> Printf.sprintf "invalid YAML version: %s" s

     

       292
       322
        
         | Invalid_tag_directive s -> Printf.sprintf "invalid TAG directive: %s" s

     

       293
       323
        
         | Reserved_directive s -> Printf.sprintf "reserved directive: %s" s

     

       294
       294
       -
         | Illegal_flow_key_line -> "key and ':' must be on the same line in flow context"

     

       295
       295
       -
         | Block_sequence_disallowed -> "block sequence entries are not allowed in this context"

     

       324
       324
       +
         | Illegal_flow_key_line ->

     

       325
       325
       +
             "key and ':' must be on the same line in flow context"

     

       326
       326
       +
         | Block_sequence_disallowed ->

     

       327
       327
       +
             "block sequence entries are not allowed in this context"

     

       296
       328
        
         | Unexpected_token s -> Printf.sprintf "unexpected token: %s" s

     

       297
       329
        
         | Expected_document_start -> "expected document start '---'"

     

       298
       330
        
         | Expected_document_end -> "expected document end '...'"

     
···

       329
       361
        
       

     

       330
       362
        
           Includes error kind, source location (if available), and context stack. *)

     

       331
       363
        
       let to_string t =

     

       332
       332
       -
         let loc = match t.span with

     

       333
       333
       -
           | None -> ""

     

       334
       334
       -
           | Some span -> " at " ^ Span.to_string span

     

       364
       364
       +
         let loc =

     

       365
       365
       +
           match t.span with None -> "" | Some span -> " at " ^ Span.to_string span

     

       335
       366
        
         in

     

       336
       336
       -
         let ctx = match t.context with

     

       367
       367
       +
         let ctx =

     

       368
       368
       +
           match t.context with

     

       337
       369
        
           | [] -> ""

     

       338
       370
        
           | ctxs -> " (in " ^ String.concat " > " (List.rev ctxs) ^ ")"

     

       339
       371
        
         in

     

       340
       372
        
         kind_to_string t.kind ^ loc ^ ctx

     

       341
       373
        
       

     

       342
       374
        
       (** [pp fmt t] pretty-prints an error to a formatter. *)

     

       343
       343
       -
       let pp fmt t =

     

       344
       344
       -
         Format.fprintf fmt "Yamlrw error: %s" (to_string t)

     

       375
       375
       +
       let pp fmt t = Format.fprintf fmt "Yamlrw error: %s" (to_string t)

     

       345
       376
        
       

     

       346
       377
        
       (** [pp_with_source ~source fmt t] pretty-prints an error with source context.

     

       347
       378
        
       

     

       348
       348
       -
           Shows the error message followed by the relevant source line with

     

       349
       349
       -
           a caret (^) pointing to the error location.

     

       379
       379
       +
           Shows the error message followed by the relevant source line with a caret

     

       380
       380
       +
           (^) pointing to the error location.

     

       350
       381
        
       

     

       351
       382
        
           @param source The source text

     

       352
       383
        
           @param fmt Output formatter

     

       353
       384
        
           @param t The error to display *)

     

       354
       385
        
       let pp_with_source ~source fmt t =

     

       355
       355
       -
       let extract_line source line_num =

     

       356
       356
       -
         let lines = String.split_on_char '\n' source in

     

       357
       357
       -
         if line_num >= 1 && line_num <= List.length lines then

     

       358
       358
       -
           Some (List.nth lines (line_num - 1))

     

       359
       359
       -
         else

     

       360
       360
       -
           None

     

       386
       386
       +
         let extract_line source line_num =

     

       387
       387
       +
           let lines = String.split_on_char '\n' source in

     

       388
       388
       +
           if line_num >= 1 && line_num <= List.length lines then

     

       389
       389
       +
             Some (List.nth lines (line_num - 1))

     

       390
       390
       +
           else None

     

       361
       391
        
         in

     

       362
       392
        
       

     

       363
       393
        
         pp fmt t;

     

       364
       394
        
         match t.span with

     

       365
       395
        
         | None -> ()

     

       366
       366
       -
         | Some span ->

     

       396
       396
       +
         | Some span -> (

     

       367
       397
        
             match extract_line source span.start.line with

     

       368
       398
        
             | None -> ()

     

       369
       399
        
             | Some line ->

     

       370
       400
        
                 Format.fprintf fmt "\n  %d | %s\n" span.start.line line;

     

       371
       401
        
                 let padding = String.make (span.start.column - 1) ' ' in

     

       372
       372
       -
                 Format.fprintf fmt "    | %s^" padding

     

       402
       402
       +
                 Format.fprintf fmt "    | %s^" padding)

+120

lib/error.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** {1 Error Handling}

     

       7
       7
       +
       

     

       8
       8
       +
           Comprehensive error reporting for YAML parsing and emission.

     

       9
       9
       +
       

     

       10
       10
       +
           This module provides detailed error types that correspond to various

     

       11
       11
       +
           failure modes in YAML processing, as specified in the

     

       12
       12
       +
           {{:https://yaml.org/spec/1.2.2/}YAML 1.2.2 specification}. *)

     

       13
       13
       +
       

     

       14
       14
       +
       (** {2 Error Classification} *)

     

       15
       15
       +
       

     

       16
       16
       +
       type kind =

     

       17
       17
       +
         (* Scanner errors *)

     

       18
       18
       +
         | Unexpected_character of char

     

       19
       19
       +
         | Unexpected_eof

     

       20
       20
       +
         | Invalid_escape_sequence of string

     

       21
       21
       +
         | Invalid_unicode_escape of string

     

       22
       22
       +
         | Invalid_hex_escape of string

     

       23
       23
       +
         | Invalid_tag of string

     

       24
       24
       +
         | Invalid_anchor of string

     

       25
       25
       +
         | Invalid_alias of string

     

       26
       26
       +
         | Invalid_comment

     

       27
       27
       +
         | Unclosed_single_quote

     

       28
       28
       +
         | Unclosed_double_quote

     

       29
       29
       +
         | Unclosed_flow_sequence

     

       30
       30
       +
         | Unclosed_flow_mapping

     

       31
       31
       +
         | Invalid_indentation of int * int

     

       32
       32
       +
         | Invalid_flow_indentation

     

       33
       33
       +
         | Tab_in_indentation

     

       34
       34
       +
         | Invalid_block_scalar_header of string

     

       35
       35
       +
         | Invalid_quoted_scalar_indentation of string

     

       36
       36
       +
         | Invalid_directive of string

     

       37
       37
       +
         | Invalid_yaml_version of string

     

       38
       38
       +
         | Invalid_tag_directive of string

     

       39
       39
       +
         | Reserved_directive of string

     

       40
       40
       +
         | Illegal_flow_key_line

     

       41
       41
       +
         | Block_sequence_disallowed

     

       42
       42
       +
       

     

       43
       43
       +
         (* Parser errors *)

     

       44
       44
       +
         | Unexpected_token of string

     

       45
       45
       +
         | Expected_document_start

     

       46
       46
       +
         | Expected_document_end

     

       47
       47
       +
         | Expected_block_entry

     

       48
       48
       +
         | Expected_key

     

       49
       49
       +
         | Expected_value

     

       50
       50
       +
         | Expected_node

     

       51
       51
       +
         | Expected_scalar

     

       52
       52
       +
         | Expected_sequence_end

     

       53
       53
       +
         | Expected_mapping_end

     

       54
       54
       +
         | Duplicate_anchor of string

     

       55
       55
       +
         | Undefined_alias of string

     

       56
       56
       +
         | Alias_cycle of string

     

       57
       57
       +
         | Multiple_documents

     

       58
       58
       +
         | Mapping_key_too_long

     

       59
       59
       +
       

     

       60
       60
       +
         (* Loader errors *)

     

       61
       61
       +
         | Invalid_scalar_conversion of string * string

     

       62
       62
       +
         | Type_mismatch of string * string

     

       63
       63
       +
         | Unresolved_alias of string

     

       64
       64
       +
         | Key_not_found of string

     

       65
       65
       +
         | Alias_expansion_node_limit of int

     

       66
       66
       +
         | Alias_expansion_depth_limit of int

     

       67
       67
       +
       

     

       68
       68
       +
         (* Emitter errors *)

     

       69
       69
       +
         | Invalid_encoding of string

     

       70
       70
       +
         | Scalar_contains_invalid_chars of string

     

       71
       71
       +
         | Anchor_not_set

     

       72
       72
       +
         | Invalid_state of string

     

       73
       73
       +
       

     

       74
       74
       +
         (* Generic *)

     

       75
       75
       +
         | Custom of string

     

       76
       76
       +
       

     

       77
       77
       +
       (** {2 Error Value} *)

     

       78
       78
       +
       

     

       79
       79
       +
       type t = {

     

       80
       80
       +
         kind : kind;

     

       81
       81
       +
         span : Span.t option;

     

       82
       82
       +
         context : string list;

     

       83
       83
       +
         source : string option;

     

       84
       84
       +
       }

     

       85
       85
       +
       

     

       86
       86
       +
       (** {2 Exception} *)

     

       87
       87
       +
       

     

       88
       88
       +
       exception Yamlrw_error of t

     

       89
       89
       +
       (** The main exception type raised by all yamlrw operations. *)

     

       90
       90
       +
       

     

       91
       91
       +
       (** {2 Error Construction} *)

     

       92
       92
       +
       

     

       93
       93
       +
       val make : ?span:Span.t -> ?context:string list -> ?source:string -> kind -> t

     

       94
       94
       +
       (** Construct an error value. *)

     

       95
       95
       +
       

     

       96
       96
       +
       val raise : ?span:Span.t -> ?context:string list -> ?source:string -> kind -> 'a

     

       97
       97
       +
       (** Construct and raise an error. *)

     

       98
       98
       +
       

     

       99
       99
       +
       val raise_at : Position.t -> kind -> 'a

     

       100
       100
       +
       (** Raise an error at a specific position. *)

     

       101
       101
       +
       

     

       102
       102
       +
       val raise_span : Span.t -> kind -> 'a

     

       103
       103
       +
       (** Raise an error at a specific span. *)

     

       104
       104
       +
       

     

       105
       105
       +
       val with_context : string -> (unit -> 'a) -> 'a

     

       106
       106
       +
       (** Execute a function and add context to any raised error. *)

     

       107
       107
       +
       

     

       108
       108
       +
       (** {2 Error Formatting} *)

     

       109
       109
       +
       

     

       110
       110
       +
       val kind_to_string : kind -> string

     

       111
       111
       +
       (** Convert an error kind to a human-readable string. *)

     

       112
       112
       +
       

     

       113
       113
       +
       val to_string : t -> string

     

       114
       114
       +
       (** Convert an error to a human-readable string. *)

     

       115
       115
       +
       

     

       116
       116
       +
       val pp : Format.formatter -> t -> unit

     

       117
       117
       +
       (** Pretty-print an error. *)

     

       118
       118
       +
       

     

       119
       119
       +
       val pp_with_source : source:string -> Format.formatter -> t -> unit

     

       120
       120
       +
       (** Pretty-print an error with source context. *)

+17 -30

lib/event.ml

···

       8
       8
        
       type t =

     

       9
       9
        
         | Stream_start of { encoding : Encoding.t }

     

       10
       10
        
         | Stream_end

     

       11
       11
       -
         | Document_start of {

     

       12
       12
       -
             version : (int * int) option;

     

       13
       13
       -
             implicit : bool;

     

       14
       14
       -
           }

     

       11
       11
       +
         | Document_start of { version : (int * int) option; implicit : bool }

     

       15
       12
        
         | Document_end of { implicit : bool }

     

       16
       13
        
         | Alias of { anchor : string }

     

       17
       14
        
         | Scalar of {

     
···

       37
       34
        
           }

     

       38
       35
        
         | Mapping_end

     

       39
       36
        
       

     

       40
       40
       -
       type spanned = {

     

       41
       41
       -
         event : t;

     

       42
       42
       -
         span : Span.t;

     

       43
       43
       -
       }

     

       37
       37
       +
       type spanned = { event : t; span : Span.t }

     

       38
       38
       +
       

     

       39
       39
       +
       let pp_opt_str = Option.value ~default:"none"

     

       44
       40
        
       

     

       45
       41
        
       let pp fmt = function

     

       46
       42
        
         | Stream_start { encoding } ->

     

       47
       43
        
             Format.fprintf fmt "stream-start(%a)" Encoding.pp encoding

     

       48
       48
       -
         | Stream_end ->

     

       49
       49
       -
             Format.fprintf fmt "stream-end"

     

       44
       44
       +
         | Stream_end -> Format.fprintf fmt "stream-end"

     

       50
       45
        
         | Document_start { version; implicit } ->

     

       51
       51
       -
             Format.fprintf fmt "document-start(version=%s, implicit=%b)"

     

       52
       52
       -
               (match version with None -> "none" | Some (maj, min) -> Printf.sprintf "%d.%d" maj min)

     

       46
       46
       +
             let version_str =

     

       47
       47
       +
               match version with

     

       48
       48
       +
               | None -> "none"

     

       49
       49
       +
               | Some (maj, min) -> Printf.sprintf "%d.%d" maj min

     

       50
       50
       +
             in

     

       51
       51
       +
             Format.fprintf fmt "document-start(version=%s, implicit=%b)" version_str

     

       53
       52
        
               implicit

     

       54
       53
        
         | Document_end { implicit } ->

     

       55
       54
        
             Format.fprintf fmt "document-end(implicit=%b)" implicit

     

       56
       56
       -
         | Alias { anchor } ->

     

       57
       57
       -
             Format.fprintf fmt "alias(%s)" anchor

     

       55
       55
       +
         | Alias { anchor } -> Format.fprintf fmt "alias(%s)" anchor

     

       58
       56
        
         | Scalar { anchor; tag; value; style; _ } ->

     

       59
       57
        
             Format.fprintf fmt "scalar(anchor=%s, tag=%s, style=%a, value=%S)"

     

       60
       60
       -
               (Option.value anchor ~default:"none")

     

       61
       61
       -
               (Option.value tag ~default:"none")

     

       62
       62
       -
               Scalar_style.pp style

     

       63
       63
       -
               value

     

       58
       58
       +
               (pp_opt_str anchor) (pp_opt_str tag) Scalar_style.pp style value

     

       64
       59
        
         | Sequence_start { anchor; tag; implicit; style } ->

     

       65
       60
        
             Format.fprintf fmt "sequence-start(anchor=%s, tag=%s, implicit=%b, style=%a)"

     

       66
       66
       -
               (Option.value anchor ~default:"none")

     

       67
       67
       -
               (Option.value tag ~default:"none")

     

       68
       68
       -
               implicit

     

       69
       69
       -
               Layout_style.pp style

     

       70
       70
       -
         | Sequence_end ->

     

       71
       71
       -
             Format.fprintf fmt "sequence-end"

     

       61
       61
       +
               (pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style

     

       62
       62
       +
         | Sequence_end -> Format.fprintf fmt "sequence-end"

     

       72
       63
        
         | Mapping_start { anchor; tag; implicit; style } ->

     

       73
       64
        
             Format.fprintf fmt "mapping-start(anchor=%s, tag=%s, implicit=%b, style=%a)"

     

       74
       74
       -
               (Option.value anchor ~default:"none")

     

       75
       75
       -
               (Option.value tag ~default:"none")

     

       76
       76
       -
               implicit

     

       77
       77
       -
               Layout_style.pp style

     

       78
       78
       -
         | Mapping_end ->

     

       79
       79
       -
             Format.fprintf fmt "mapping-end"

     

       65
       65
       +
               (pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style

     

       66
       66
       +
         | Mapping_end -> Format.fprintf fmt "mapping-end"

     

       80
       67
        
       

     

       81
       68
        
       let pp_spanned fmt { event; span } =

     

       82
       69
        
         Format.fprintf fmt "%a at %a" pp event Span.pp span

+49

lib/event.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML parser events *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t =

     

       9
       9
       +
         | Stream_start of { encoding : Encoding.t }

     

       10
       10
       +
         | Stream_end

     

       11
       11
       +
         | Document_start of {

     

       12
       12
       +
             version : (int * int) option;

     

       13
       13
       +
             implicit : bool;

     

       14
       14
       +
           }

     

       15
       15
       +
         | Document_end of { implicit : bool }

     

       16
       16
       +
         | Alias of { anchor : string }

     

       17
       17
       +
         | Scalar of {

     

       18
       18
       +
             anchor : string option;

     

       19
       19
       +
             tag : string option;

     

       20
       20
       +
             value : string;

     

       21
       21
       +
             plain_implicit : bool;

     

       22
       22
       +
             quoted_implicit : bool;

     

       23
       23
       +
             style : Scalar_style.t;

     

       24
       24
       +
           }

     

       25
       25
       +
         | Sequence_start of {

     

       26
       26
       +
             anchor : string option;

     

       27
       27
       +
             tag : string option;

     

       28
       28
       +
             implicit : bool;

     

       29
       29
       +
             style : Layout_style.t;

     

       30
       30
       +
           }

     

       31
       31
       +
         | Sequence_end

     

       32
       32
       +
         | Mapping_start of {

     

       33
       33
       +
             anchor : string option;

     

       34
       34
       +
             tag : string option;

     

       35
       35
       +
             implicit : bool;

     

       36
       36
       +
             style : Layout_style.t;

     

       37
       37
       +
           }

     

       38
       38
       +
         | Mapping_end

     

       39
       39
       +
       

     

       40
       40
       +
       type spanned = {

     

       41
       41
       +
         event : t;

     

       42
       42
       +
         span : Span.t;

     

       43
       43
       +
       }

     

       44
       44
       +
       

     

       45
       45
       +
       val pp : Format.formatter -> t -> unit

     

       46
       46
       +
       (** Pretty-print an event *)

     

       47
       47
       +
       

     

       48
       48
       +
       val pp_spanned : Format.formatter -> spanned -> unit

     

       49
       49
       +
       (** Pretty-print a spanned event *)

+50 -71

lib/input.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Character input source with lookahead, based on Bytes.Reader.t

     

       7
       7
        
       

     

       8
       8
       -
           This module wraps a bytesrw [Bytes.Reader.t] to provide character-by-character

     

       9
       9
       -
           access with lookahead for the YAML scanner. Uses bytesrw's sniff and push_back

     

       10
       10
       -
           for efficient lookahead without excessive copying.

     

       8
       8
       +
           This module wraps a bytesrw [Bytes.Reader.t] to provide

     

       9
       9
       +
           character-by-character access with lookahead for the YAML scanner. Uses

     

       10
       10
       +
           bytesrw's sniff and push_back for efficient lookahead without excessive

     

       11
       11
       +
           copying.

     

       11
       12
        
       

     

       12
       13
        
           The same input type works with any reader source: strings, files, channels,

     

       13
       14
        
           or streaming sources like Eio. *)

     

       14
       15
        
       

     

       15
       16
        
       open Bytesrw

     

       16
       17
        
       

     

       17
       17
       -
       (** Re-export character classification *)

     

       18
       18
        
       include Char_class

     

       19
       19
       +
       (** Re-export character classification *)

     

       19
       20
        
       

     

       20
       21
        
       type t = {

     

       21
       22
        
         reader : Bytes.Reader.t;

     

       22
       22
       -
         mutable current_slice : Bytes.Slice.t option;  (** Current slice being consumed *)

     

       23
       23
       -
         mutable slice_pos : int;                        (** Position within current slice *)

     

       24
       24
       -
         mutable position : Position.t;                  (** Line/column tracking *)

     

       23
       23
       +
         mutable current_slice : Bytes.Slice.t option;

     

       24
       24
       +
             (** Current slice being consumed *)

     

       25
       25
       +
         mutable slice_pos : int;  (** Position within current slice *)

     

       26
       26
       +
         mutable position : Position.t;  (** Line/column tracking *)

     

       25
       27
        
       }

     

       26
       28
        
       

     

       27
       29
        
       (** Ensure we have a current slice. Returns true if data available. *)

     
···

       33
       35
        
             if Bytes.Slice.is_eod slice then begin

     

       34
       36
        
               t.current_slice <- None;

     

       35
       37
        
               false

     

       36
       36
       -
             end else begin

     

       38
       38
       +
             end

     

       39
       39
       +
             else begin

     

       37
       40
        
               t.current_slice <- Some slice;

     

       38
       41
        
               t.slice_pos <- 0;

     

       39
       42
        
               true

     
···

       50
       53
        
       

     

       51
       54
        
       (** Create input from a Bytes.Reader.t *)

     

       52
       55
        
       let of_reader ?(initial_position = Position.initial) reader =

     

       53
       53
       -
         let t = {

     

       54
       54
       -
           reader;

     

       55
       55
       -
           current_slice = None;

     

       56
       56
       -
           slice_pos = 0;

     

       57
       57
       -
           position = initial_position;

     

       58
       58
       -
         } in

     

       56
       56
       +
         let t =

     

       57
       57
       +
           { reader; current_slice = None; slice_pos = 0; position = initial_position }

     

       58
       58
       +
         in

     

       59
       59
        
         (* Use sniff for BOM detection - this is exactly what sniff is for *)

     

       60
       60
        
         let sample = Bytes.Reader.sniff 4 t.reader in

     

       61
       61
        
         let bom_len =

     

       62
       62
       -
           if String.length sample >= 3 &&

     

       63
       63
       -
              sample.[0] = '\xEF' &&

     

       64
       64
       -
              sample.[1] = '\xBB' &&

     

       65
       65
       -
              sample.[2] = '\xBF'

     

       66
       66
       -
           then 3  (* UTF-8 BOM *)

     

       62
       62
       +
           if

     

       63
       63
       +
             String.length sample >= 3

     

       64
       64
       +
             && sample.[0] = '\xEF'

     

       65
       65
       +
             && sample.[1] = '\xBB'

     

       66
       66
       +
             && sample.[2] = '\xBF'

     

       67
       67
       +
           then 3 (* UTF-8 BOM *)

     

       67
       68
        
           else 0

     

       68
       69
        
         in

     

       69
       70
        
         (* Skip BOM if present *)

     

       70
       70
       -
         if bom_len > 0 then

     

       71
       71
       -
           Bytes.Reader.skip bom_len t.reader;

     

       71
       71
       +
         if bom_len > 0 then Bytes.Reader.skip bom_len t.reader;

     

       72
       72
        
         t

     

       73
       73
        
       

     

       74
       74
        
       (** Create input from a string *)

     
···

       77
       77
        
         of_reader reader

     

       78
       78
        
       

     

       79
       79
        
       let position t = t.position

     

       80
       80
       -
       

     

       81
       81
       -
       let is_eof t =

     

       82
       82
       -
         not (ensure_slice t)

     

       83
       83
       -
       

     

       84
       84
       -
       let peek t =

     

       85
       85
       -
         if ensure_slice t then

     

       86
       86
       -
           peek_current t

     

       87
       87
       -
         else

     

       88
       88
       -
           None

     

       80
       80
       +
       let is_eof t = not (ensure_slice t)

     

       81
       81
       +
       let peek t = if ensure_slice t then peek_current t else None

     

       89
       82
        
       

     

       90
       83
        
       let peek_exn t =

     

       91
       84
        
         match peek t with

     
···

       112
       105
        
                 let sample_offset = n - slice_remaining in

     

       113
       106
        
                 if sample_offset < String.length sample then

     

       114
       107
        
                   Some sample.[sample_offset]

     

       115
       115
       -
                 else

     

       116
       116
       -
                   None

     

       108
       108
       +
                 else None

     

       117
       109
        
               end

     

       118
       118
       -
           | None ->

     

       119
       119
       -
               if n < String.length sample then

     

       120
       120
       -
                 Some sample.[n]

     

       121
       121
       -
               else

     

       122
       122
       -
                 None

     

       110
       110
       +
           | None -> if n < String.length sample then Some sample.[n] else None

     

       123
       111
        
         end

     

       124
       112
        
       

     

       125
       113
        
       (** Peek at up to n characters as a string *)

     
···

       139
       127
        
                 let needed_from_reader = n - slice_remaining in

     

       140
       128
        
                 let sample = Bytes.Reader.sniff needed_from_reader t.reader in

     

       141
       129
        
                 let buf = Buffer.create n in

     

       142
       142
       -
                 Buffer.add_subbytes buf slice_bytes (slice_first + t.slice_pos) slice_remaining;

     

       130
       130
       +
                 Buffer.add_subbytes buf slice_bytes

     

       131
       131
       +
                   (slice_first + t.slice_pos)

     

       132
       132
       +
                   slice_remaining;

     

       143
       133
        
                 Buffer.add_string buf sample;

     

       144
       134
        
                 Buffer.contents buf

     

       145
       135
        
               end

     

       146
       146
       -
           | None ->

     

       147
       147
       -
               if ensure_slice t then

     

       148
       148
       -
                 peek_string t n

     

       149
       149
       -
               else

     

       150
       150
       -
                 ""

     

       136
       136
       +
           | None -> if ensure_slice t then peek_string t n else ""

     

       151
       137
        
         end

     

       152
       138
        
       

     

       153
       139
        
       (** Consume next character *)

     
···

       161
       147
        
               t.slice_pos <- t.slice_pos + 1;

     

       162
       148
        
               t.position <- Position.advance_char c t.position;

     

       163
       149
        
               (* Check if we've exhausted this slice *)

     

       164
       164
       -
               if t.slice_pos >= Bytes.Slice.length slice then

     

       165
       165
       -
                 t.current_slice <- None;

     

       150
       150
       +
               if t.slice_pos >= Bytes.Slice.length slice then t.current_slice <- None;

     

       166
       151
        
               Some c

     

       167
       152
        
           | None -> None

     

       168
       168
       -
         end else

     

       169
       169
       -
           None

     

       153
       153
       +
         end

     

       154
       154
       +
         else None

     

       170
       155
        
       

     

       171
       156
        
       let next_exn t =

     

       172
       157
        
         match next t with

     
···

       181
       166
        
       let skip_while t pred =

     

       182
       167
        
         let rec loop () =

     

       183
       168
        
           match peek t with

     

       184
       184
       -
           | Some c when pred c -> ignore (next t); loop ()

     

       169
       169
       +
           | Some c when pred c ->

     

       170
       170
       +
               ignore (next t);

     

       171
       171
       +
               loop ()

     

       185
       172
        
           | _ -> ()

     

       186
       173
        
         in

     

       187
       174
        
         loop ()

     

       188
       175
        
       

     

       189
       176
        
       (** Check if next char satisfies predicate *)

     

       190
       190
       -
       let next_is pred t =

     

       191
       191
       -
         match peek t with

     

       192
       192
       -
         | None -> false

     

       193
       193
       -
         | Some c -> pred c

     

       177
       177
       +
       let next_is pred t = match peek t with None -> false | Some c -> pred c

     

       194
       178
        
       

     

       195
       179
        
       let next_is_break t = next_is is_break t

     

       196
       180
        
       let next_is_blank t = next_is is_blank t

     
···

       209
       193
        
           if len < 3 then false

     

       210
       194
        
           else

     

       211
       195
        
             let prefix = String.sub s 0 3 in

     

       212
       212
       -
             (prefix = "---" || prefix = "...") &&

     

       213
       213
       -
             (len = 3 || is_whitespace s.[3])

     

       196
       196
       +
             (prefix = "---" || prefix = "...") && (len = 3 || is_whitespace s.[3])

     

       214
       197
        
         end

     

       215
       198
        
       

     

       216
       199
        
       (** Consume line break, handling \r\n as single break *)

     

       217
       200
        
       let consume_break t =

     

       218
       201
        
         match peek t with

     

       219
       219
       -
         | Some '\r' ->

     

       202
       202
       +
         | Some '\r' -> (

     

       220
       203
        
             ignore (next t);

     

       221
       221
       -
             (match peek t with

     

       222
       222
       -
              | Some '\n' -> ignore (next t)

     

       223
       223
       -
              | _ -> ())

     

       224
       224
       -
         | Some '\n' ->

     

       225
       225
       -
             ignore (next t)

     

       204
       204
       +
             match peek t with Some '\n' -> ignore (next t) | _ -> ())

     

       205
       205
       +
         | Some '\n' -> ignore (next t)

     

       226
       206
        
         | _ -> ()

     

       227
       207
        
       

     

       228
       208
        
       (** Get remaining content from current position *)

     
···

       230
       210
        
         let buf = Buffer.create 256 in

     

       231
       211
        
         (* Add current slice remainder *)

     

       232
       212
        
         (match t.current_slice with

     

       233
       233
       -
          | Some slice ->

     

       234
       234
       -
              let bytes = Bytes.Slice.bytes slice in

     

       235
       235
       -
              let first = Bytes.Slice.first slice in

     

       236
       236
       -
              let remaining = Bytes.Slice.length slice - t.slice_pos in

     

       237
       237
       -
              if remaining > 0 then

     

       238
       238
       -
                Buffer.add_subbytes buf bytes (first + t.slice_pos) remaining

     

       239
       239
       -
          | None -> ());

     

       213
       213
       +
         | Some slice ->

     

       214
       214
       +
             let bytes = Bytes.Slice.bytes slice in

     

       215
       215
       +
             let first = Bytes.Slice.first slice in

     

       216
       216
       +
             let remaining = Bytes.Slice.length slice - t.slice_pos in

     

       217
       217
       +
             if remaining > 0 then

     

       218
       218
       +
               Buffer.add_subbytes buf bytes (first + t.slice_pos) remaining

     

       219
       219
       +
         | None -> ());

     

       240
       220
        
         (* Add remaining from reader *)

     

       241
       221
        
         Bytes.Reader.add_to_buffer buf t.reader;

     

       242
       222
        
         Buffer.contents buf

     
···

       253
       233
        
             Some (Stdlib.Bytes.get bytes (first + t.slice_pos - 1))

     

       254
       234
        
         | _ -> None

     

       255
       235
        
       

     

       256
       256
       -
       (** Get a sample of the source for encoding detection.

     

       257
       257
       -
           Uses sniff to peek without consuming. *)

     

       236
       236
       +
       (** Get a sample of the source for encoding detection. Uses sniff to peek

     

       237
       237
       +
           without consuming. *)

     

       258
       238
        
       let source t =

     

       259
       239
        
         (* First check current slice *)

     

       260
       240
        
         match t.current_slice with

     
···

       268
       248
        
             Bytes.Reader.sniff 4 t.reader

     

       269
       249
        
       

     

       270
       250
        
       (** Get the byte position in the underlying stream *)

     

       271
       271
       -
       let byte_pos t =

     

       272
       272
       -
         Bytes.Reader.pos t.reader

     

       251
       251
       +
       let byte_pos t = Bytes.Reader.pos t.reader

+97

lib/input.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Character input source with lookahead, based on Bytes.Reader.t

     

       7
       7
       +
       

     

       8
       8
       +
           This module wraps a bytesrw [Bytes.Reader.t] to provide character-by-character

     

       9
       9
       +
           access with lookahead for the YAML scanner. *)

     

       10
       10
       +
       

     

       11
       11
       +
       (** {2 Re-exported Character Classification} *)

     

       12
       12
       +
       

     

       13
       13
       +
       include module type of Char_class

     

       14
       14
       +
       

     

       15
       15
       +
       (** {2 Input Type} *)

     

       16
       16
       +
       

     

       17
       17
       +
       type t

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Constructors} *)

     

       20
       20
       +
       

     

       21
       21
       +
       val of_reader : ?initial_position:Position.t -> Bytesrw.Bytes.Reader.t -> t

     

       22
       22
       +
       (** Create input from a Bytes.Reader.t *)

     

       23
       23
       +
       

     

       24
       24
       +
       val of_string : string -> t

     

       25
       25
       +
       (** Create input from a string *)

     

       26
       26
       +
       

     

       27
       27
       +
       (** {2 Position and State} *)

     

       28
       28
       +
       

     

       29
       29
       +
       val position : t -> Position.t

     

       30
       30
       +
       (** Get current position *)

     

       31
       31
       +
       

     

       32
       32
       +
       val is_eof : t -> bool

     

       33
       33
       +
       (** Check if at end of input *)

     

       34
       34
       +
       

     

       35
       35
       +
       val mark : t -> Position.t

     

       36
       36
       +
       (** Mark current position for span creation *)

     

       37
       37
       +
       

     

       38
       38
       +
       (** {2 Lookahead} *)

     

       39
       39
       +
       

     

       40
       40
       +
       val peek : t -> char option

     

       41
       41
       +
       (** Peek at current character without advancing *)

     

       42
       42
       +
       

     

       43
       43
       +
       val peek_exn : t -> char

     

       44
       44
       +
       (** Peek at current character, raising on EOF *)

     

       45
       45
       +
       

     

       46
       46
       +
       val peek_nth : t -> int -> char option

     

       47
       47
       +
       (** Peek at nth character (0-indexed from current position) *)

     

       48
       48
       +
       

     

       49
       49
       +
       val peek_string : t -> int -> string

     

       50
       50
       +
       (** Peek at up to n characters as a string *)

     

       51
       51
       +
       

     

       52
       52
       +
       val peek_back : t -> char option

     

       53
       53
       +
       (** Get the character before the current position *)

     

       54
       54
       +
       

     

       55
       55
       +
       (** {2 Consumption} *)

     

       56
       56
       +
       

     

       57
       57
       +
       val next : t -> char option

     

       58
       58
       +
       (** Consume and return next character *)

     

       59
       59
       +
       

     

       60
       60
       +
       val next_exn : t -> char

     

       61
       61
       +
       (** Consume and return next character, raising on EOF *)

     

       62
       62
       +
       

     

       63
       63
       +
       val skip : t -> int -> unit

     

       64
       64
       +
       (** Skip n characters *)

     

       65
       65
       +
       

     

       66
       66
       +
       val skip_while : t -> (char -> bool) -> unit

     

       67
       67
       +
       (** Skip characters while predicate holds *)

     

       68
       68
       +
       

     

       69
       69
       +
       val consume_break : t -> unit

     

       70
       70
       +
       (** Consume line break, handling \r\n as single break *)

     

       71
       71
       +
       

     

       72
       72
       +
       (** {2 Predicates} *)

     

       73
       73
       +
       

     

       74
       74
       +
       val next_is : (char -> bool) -> t -> bool

     

       75
       75
       +
       (** Check if next char satisfies predicate *)

     

       76
       76
       +
       

     

       77
       77
       +
       val next_is_break : t -> bool

     

       78
       78
       +
       val next_is_blank : t -> bool

     

       79
       79
       +
       val next_is_whitespace : t -> bool

     

       80
       80
       +
       val next_is_digit : t -> bool

     

       81
       81
       +
       val next_is_hex : t -> bool

     

       82
       82
       +
       val next_is_alpha : t -> bool

     

       83
       83
       +
       val next_is_indicator : t -> bool

     

       84
       84
       +
       

     

       85
       85
       +
       val at_document_boundary : t -> bool

     

       86
       86
       +
       (** Check if at document boundary (--- or ...) *)

     

       87
       87
       +
       

     

       88
       88
       +
       (** {2 Utilities} *)

     

       89
       89
       +
       

     

       90
       90
       +
       val remaining : t -> string

     

       91
       91
       +
       (** Get remaining content from current position *)

     

       92
       92
       +
       

     

       93
       93
       +
       val source : t -> string

     

       94
       94
       +
       (** Get a sample of the source for encoding detection *)

     

       95
       95
       +
       

     

       96
       96
       +
       val byte_pos : t -> int

     

       97
       97
       +
       (** Get the byte position in the underlying stream *)

+7 -18

lib/layout_style.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Collection layout styles *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = [

     

       9
       9
       -
         | `Any   (** Let emitter choose *)

     

       10
       10
       -
         | `Block (** Indentation-based *)

     

       11
       11
       -
         | `Flow  (** Inline with brackets *)

     

       12
       12
       -
       ]

     

       8
       8
       +
       type t =

     

       9
       9
       +
         [ `Any  (** Let emitter choose *)

     

       10
       10
       +
         | `Block  (** Indentation-based *)

     

       11
       11
       +
         | `Flow  (** Inline with brackets *) ]

     

       13
       12
        
       

     

       14
       14
       -
       let to_string = function

     

       15
       15
       -
         | `Any -> "any"

     

       16
       16
       -
         | `Block -> "block"

     

       17
       17
       -
         | `Flow -> "flow"

     

       18
       18
       -
       

     

       19
       19
       -
       let pp fmt t =

     

       20
       20
       -
         Format.pp_print_string fmt (to_string t)

     

       21
       21
       -
       

     

       13
       13
       +
       let to_string = function `Any -> "any" | `Block -> "block" | `Flow -> "flow"

     

       14
       14
       +
       let pp fmt t = Format.pp_print_string fmt (to_string t)

     

       22
       15
        
       let equal a b = a = b

     

       23
       16
        
       

     

       24
       17
        
       let compare a b =

     

       25
       25
       -
         let to_int = function

     

       26
       26
       -
           | `Any -> 0

     

       27
       27
       -
           | `Block -> 1

     

       28
       28
       -
           | `Flow -> 2

     

       29
       29
       -
         in

     

       18
       18
       +
         let to_int = function `Any -> 0 | `Block -> 1 | `Flow -> 2 in

     

       30
       19
        
         Int.compare (to_int a) (to_int b)

+24

lib/layout_style.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Collection layout styles *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = [

     

       9
       9
       +
         | `Any   (** Let emitter choose *)

     

       10
       10
       +
         | `Block (** Indentation-based *)

     

       11
       11
       +
         | `Flow  (** Inline with brackets *)

     

       12
       12
       +
       ]

     

       13
       13
       +
       

     

       14
       14
       +
       val to_string : t -> string

     

       15
       15
       +
       (** Convert style to string representation *)

     

       16
       16
       +
       

     

       17
       17
       +
       val pp : Format.formatter -> t -> unit

     

       18
       18
       +
       (** Pretty-print a style *)

     

       19
       19
       +
       

     

       20
       20
       +
       val equal : t -> t -> bool

     

       21
       21
       +
       (** Test equality of two styles *)

     

       22
       22
       +
       

     

       23
       23
       +
       val compare : t -> t -> int

     

       24
       24
       +
       (** Compare two styles *)

+184 -237

lib/loader.ml

···

       31
       31
        
         mutable doc_implicit_start : bool;

     

       32
       32
        
       }

     

       33
       33
        
       

     

       34
       34
       -
       let create_state () = {

     

       35
       35
       -
         stack = [];

     

       36
       36
       -
         current = None;

     

       37
       37
       -
         documents = [];

     

       38
       38
       -
         doc_version = None;

     

       39
       39
       -
         doc_implicit_start = true;

     

       40
       40
       -
       }

     

       34
       34
       +
       let create_state () =

     

       35
       35
       +
         {

     

       36
       36
       +
           stack = [];

     

       37
       37
       +
           current = None;

     

       38
       38
       +
           documents = [];

     

       39
       39
       +
           doc_version = None;

     

       40
       40
       +
           doc_implicit_start = true;

     

       41
       41
       +
         }

     

       41
       42
        
       

     

       42
       43
        
       (** Process a single event *)

     

       43
       44
        
       let rec process_event state (ev : Event.spanned) =

     

       44
       45
        
         match ev.event with

     

       45
       46
        
         | Event.Stream_start _ -> ()

     

       46
       46
       -
       

     

       47
       47
        
         | Event.Stream_end -> ()

     

       48
       48
       -
       

     

       49
       48
        
         | Event.Document_start { version; implicit } ->

     

       50
       49
        
             state.doc_version <- version;

     

       51
       50
        
             state.doc_implicit_start <- implicit

     

       52
       52
       -
       

     

       53
       51
        
         | Event.Document_end { implicit } ->

     

       54
       54
       -
             let doc = Document.make

     

       55
       55
       -
               ?version:state.doc_version

     

       56
       56
       -
               ~implicit_start:state.doc_implicit_start

     

       57
       57
       -
               ~implicit_end:implicit

     

       58
       58
       -
               state.current

     

       52
       52
       +
             let doc =

     

       53
       53
       +
               Document.make ?version:state.doc_version

     

       54
       54
       +
                 ~implicit_start:state.doc_implicit_start ~implicit_end:implicit

     

       55
       55
       +
                 state.current

     

       59
       56
        
             in

     

       60
       57
        
             state.documents <- doc :: state.documents;

     

       61
       58
        
             state.current <- None;

     

       62
       59
        
             state.doc_version <- None;

     

       63
       60
        
             state.doc_implicit_start <- true

     

       64
       64
       -
       

     

       65
       61
        
         | Event.Alias { anchor } ->

     

       66
       62
        
             let node : Yaml.t = `Alias anchor in

     

       67
       63
        
             add_node state node

     

       68
       68
       -
       

     

       69
       69
       -
         | Event.Scalar { anchor; tag; value; plain_implicit; quoted_implicit; style } ->

     

       70
       70
       -
             let scalar = Scalar.make

     

       71
       71
       -
               ?anchor ?tag

     

       72
       72
       -
               ~plain_implicit ~quoted_implicit

     

       73
       73
       -
               ~style value

     

       64
       64
       +
         | Event.Scalar { anchor; tag; value; plain_implicit; quoted_implicit; style }

     

       65
       65
       +
           ->

     

       66
       66
       +
             let scalar =

     

       67
       67
       +
               Scalar.make ?anchor ?tag ~plain_implicit ~quoted_implicit ~style value

     

       74
       68
        
             in

     

       75
       69
        
             let node : Yaml.t = `Scalar scalar in

     

       76
       70
        
             add_node state node

     

       77
       77
       -
       

     

       78
       71
        
         | Event.Sequence_start { anchor; tag; implicit; style } ->

     

       79
       79
       -
             let frame = Sequence_frame {

     

       80
       80
       -
               anchor; tag; implicit; style;

     

       81
       81
       -
               items = [];

     

       82
       82
       -
             } in

     

       72
       72
       +
             let frame = Sequence_frame { anchor; tag; implicit; style; items = [] } in

     

       83
       73
        
             state.stack <- frame :: state.stack

     

       84
       84
       -
       

     

       85
       85
       -
         | Event.Sequence_end ->

     

       86
       86
       -
             (match state.stack with

     

       87
       87
       -
              | Sequence_frame { anchor; tag; implicit; style; items } :: rest ->

     

       88
       88
       -
                  let seq = Sequence.make ?anchor ?tag ~implicit ~style (List.rev items) in

     

       89
       89
       -
                  let node : Yaml.t = `A seq in

     

       90
       90
       -
                  state.stack <- rest;

     

       91
       91
       -
                  add_node state node

     

       92
       92
       -
              | _ -> Error.raise (Invalid_state "unexpected sequence end"))

     

       93
       93
       -
       

     

       74
       74
       +
         | Event.Sequence_end -> (

     

       75
       75
       +
             match state.stack with

     

       76
       76
       +
             | Sequence_frame { anchor; tag; implicit; style; items } :: rest ->

     

       77
       77
       +
                 let seq =

     

       78
       78
       +
                   Sequence.make ?anchor ?tag ~implicit ~style (List.rev items)

     

       79
       79
       +
                 in

     

       80
       80
       +
                 let node : Yaml.t = `A seq in

     

       81
       81
       +
                 state.stack <- rest;

     

       82
       82
       +
                 add_node state node

     

       83
       83
       +
             | _ -> Error.raise (Invalid_state "unexpected sequence end"))

     

       94
       84
        
         | Event.Mapping_start { anchor; tag; implicit; style } ->

     

       95
       95
       -
             let frame = Mapping_frame {

     

       96
       96
       -
               anchor; tag; implicit; style;

     

       97
       97
       -
               pairs = [];

     

       98
       98
       -
               pending_key = None;

     

       99
       99
       -
             } in

     

       85
       85
       +
             let frame =

     

       86
       86
       +
               Mapping_frame

     

       87
       87
       +
                 { anchor; tag; implicit; style; pairs = []; pending_key = None }

     

       88
       88
       +
             in

     

       100
       89
        
             state.stack <- frame :: state.stack

     

       101
       101
       -
       

     

       102
       102
       -
         | Event.Mapping_end ->

     

       103
       103
       -
             (match state.stack with

     

       104
       104
       -
              | Mapping_frame { anchor; tag; implicit; style; pairs; pending_key = None } :: rest ->

     

       105
       105
       -
                  let map = Mapping.make ?anchor ?tag ~implicit ~style (List.rev pairs) in

     

       106
       106
       -
                  let node : Yaml.t = `O map in

     

       107
       107
       -
                  state.stack <- rest;

     

       108
       108
       -
                  add_node state node

     

       109
       109
       -
              | Mapping_frame { pending_key = Some _; _ } :: _ ->

     

       110
       110
       -
                  Error.raise (Invalid_state "mapping ended with pending key")

     

       111
       111
       -
              | _ -> Error.raise (Invalid_state "unexpected mapping end"))

     

       90
       90
       +
         | Event.Mapping_end -> (

     

       91
       91
       +
             match state.stack with

     

       92
       92
       +
             | Mapping_frame

     

       93
       93
       +
                 { anchor; tag; implicit; style; pairs; pending_key = None }

     

       94
       94
       +
               :: rest ->

     

       95
       95
       +
                 let map =

     

       96
       96
       +
                   Mapping.make ?anchor ?tag ~implicit ~style (List.rev pairs)

     

       97
       97
       +
                 in

     

       98
       98
       +
                 let node : Yaml.t = `O map in

     

       99
       99
       +
                 state.stack <- rest;

     

       100
       100
       +
                 add_node state node

     

       101
       101
       +
             | Mapping_frame { pending_key = Some _; _ } :: _ ->

     

       102
       102
       +
                 Error.raise (Invalid_state "mapping ended with pending key")

     

       103
       103
       +
             | _ -> Error.raise (Invalid_state "unexpected mapping end"))

     

       112
       104
        
       

     

       113
       105
        
       (** Add a node to current context *)

     

       114
       106
        
       and add_node state node =

     

       115
       107
        
         match state.stack with

     

       116
       116
       -
         | [] ->

     

       117
       117
       -
             state.current <- Some node

     

       118
       118
       -
       

     

       108
       108
       +
         | [] -> state.current <- Some node

     

       119
       109
        
         | Sequence_frame f :: rest ->

     

       120
       110
        
             state.stack <- Sequence_frame { f with items = node :: f.items } :: rest

     

       111
       111
       +
         | Mapping_frame f :: rest -> (

     

       112
       112
       +
             match f.pending_key with

     

       113
       113
       +
             | None ->

     

       114
       114
       +
                 (* This is a key *)

     

       115
       115
       +
                 state.stack <-

     

       116
       116
       +
                   Mapping_frame { f with pending_key = Some node } :: rest

     

       117
       117
       +
             | Some key ->

     

       118
       118
       +
                 (* This is a value *)

     

       119
       119
       +
                 state.stack <-

     

       120
       120
       +
                   Mapping_frame

     

       121
       121
       +
                     { f with pairs = (key, node) :: f.pairs; pending_key = None }

     

       122
       122
       +
                   :: rest)

     

       123
       123
       +
       

     

       124
       124
       +
       (** Internal: parse all documents from a parser *)

     

       125
       125
       +
       let parse_all_documents parser =

     

       126
       126
       +
         let state = create_state () in

     

       127
       127
       +
         Parser.iter (process_event state) parser;

     

       128
       128
       +
         List.rev state.documents

     

       121
       129
        
       

     

       122
       122
       -
         | Mapping_frame f :: rest ->

     

       123
       123
       -
             (match f.pending_key with

     

       124
       124
       -
              | None ->

     

       125
       125
       -
                  (* This is a key *)

     

       126
       126
       -
                  state.stack <- Mapping_frame { f with pending_key = Some node } :: rest

     

       127
       127
       -
              | Some key ->

     

       128
       128
       -
                  (* This is a value *)

     

       129
       129
       -
                  state.stack <- Mapping_frame {

     

       130
       130
       -
                    f with

     

       131
       131
       -
                    pairs = (key, node) :: f.pairs;

     

       132
       132
       -
                    pending_key = None;

     

       133
       133
       -
                  } :: rest)

     

       130
       130
       +
       (** Internal: extract single document or raise *)

     

       131
       131
       +
       let single_document_or_error docs ~empty =

     

       132
       132
       +
         match docs with

     

       133
       133
       +
         | [] -> empty

     

       134
       134
       +
         | [doc] -> doc

     

       135
       135
       +
         | _ -> Error.raise Multiple_documents

     

       134
       136
        
       

     

       135
       137
        
       (** Load single document as Value.

     

       136
       138
        
       

     

       137
       139
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       138
       140
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       139
       139
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       140
       140
       -
       *)

     

       141
       141
       -
       let value_of_string

     

       142
       142
       -
           ?(resolve_aliases = true)

     

       141
       141
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       142
       142
       +
       let value_of_string ?(resolve_aliases = true)

     

       143
       143
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       144
       144
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       145
       145
       -
           s =

     

       146
       146
       -
         let parser = Parser.of_string s in

     

       147
       147
       -
         let state = create_state () in

     

       148
       148
       -
         Parser.iter (process_event state) parser;

     

       149
       149
       -
         match state.documents with

     

       150
       150
       -
         | [] -> `Null

     

       151
       151
       -
         | [doc] ->

     

       152
       152
       -
             (match Document.root doc with

     

       153
       153
       -
              | None -> `Null

     

       154
       154
       -
              | Some yaml ->

     

       155
       155
       -
                  Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)

     

       156
       156
       -
         | _ -> Error.raise Multiple_documents

     

       144
       144
       +
           ?(max_depth = Yaml.default_max_alias_depth) s =

     

       145
       145
       +
         let docs = parse_all_documents (Parser.of_string s) in

     

       146
       146
       +
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       147
       147
       +
         match Document.root doc with

     

       148
       148
       +
         | None -> `Null

     

       149
       149
       +
         | Some yaml ->

     

       150
       150
       +
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth

     

       151
       151
       +
               yaml

     

       157
       152
        
       

     

       158
       153
        
       (** Load single document as Yaml.

     

       159
       154
        
       

     

       160
       155
        
           @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)

     

       161
       156
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       162
       162
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       163
       163
       -
       *)

     

       164
       164
       -
       let yaml_of_string

     

       165
       165
       -
           ?(resolve_aliases = false)

     

       157
       157
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       158
       158
       +
       let yaml_of_string ?(resolve_aliases = false)

     

       166
       159
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       167
       167
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       168
       168
       -
           s =

     

       169
       169
       -
         let parser = Parser.of_string s in

     

       170
       170
       -
         let state = create_state () in

     

       171
       171
       -
         Parser.iter (process_event state) parser;

     

       172
       172
       -
         match state.documents with

     

       173
       173
       -
         | [] -> `Scalar (Scalar.make "")

     

       174
       174
       -
         | [doc] ->

     

       175
       175
       -
             (match Document.root doc with

     

       176
       176
       -
              | None -> `Scalar (Scalar.make "")

     

       177
       177
       -
              | Some yaml ->

     

       178
       178
       -
                  if resolve_aliases then

     

       179
       179
       -
                    Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       180
       180
       -
                  else

     

       181
       181
       -
                    yaml)

     

       182
       182
       -
         | _ -> Error.raise Multiple_documents

     

       160
       160
       +
           ?(max_depth = Yaml.default_max_alias_depth) s =

     

       161
       161
       +
         let docs = parse_all_documents (Parser.of_string s) in

     

       162
       162
       +
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       163
       163
       +
         match Document.root doc with

     

       164
       164
       +
         | None -> `Scalar (Scalar.make "")

     

       165
       165
       +
         | Some yaml ->

     

       166
       166
       +
             if resolve_aliases then Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       167
       167
       +
             else yaml

     

       183
       168
        
       

     

       184
       169
        
       (** Load all documents *)

     

       185
       170
        
       let documents_of_string s =

     

       186
       186
       -
         let parser = Parser.of_string s in

     

       187
       187
       -
         let state = create_state () in

     

       188
       188
       -
         Parser.iter (process_event state) parser;

     

       189
       189
       -
         List.rev state.documents

     

       171
       171
       +
         parse_all_documents (Parser.of_string s)

     

       190
       172
        
       

     

       191
       173
        
       (** {2 Reader-based loading} *)

     

       192
       174
        
       

     
···

       194
       176
        
       

     

       195
       177
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       196
       178
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       197
       197
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       198
       198
       -
       *)

     

       199
       199
       -
       let value_of_reader

     

       200
       200
       -
           ?(resolve_aliases = true)

     

       179
       179
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       180
       180
       +
       let value_of_reader ?(resolve_aliases = true)

     

       201
       181
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       202
       202
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       203
       203
       -
           reader =

     

       204
       204
       -
         let parser = Parser.of_reader reader in

     

       205
       205
       -
         let state = create_state () in

     

       206
       206
       -
         Parser.iter (process_event state) parser;

     

       207
       207
       -
         match state.documents with

     

       208
       208
       -
         | [] -> `Null

     

       209
       209
       -
         | [doc] ->

     

       210
       210
       -
             (match Document.root doc with

     

       211
       211
       -
              | None -> `Null

     

       212
       212
       -
              | Some yaml ->

     

       213
       213
       -
                  Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)

     

       214
       214
       -
         | _ -> Error.raise Multiple_documents

     

       182
       182
       +
           ?(max_depth = Yaml.default_max_alias_depth) reader =

     

       183
       183
       +
         let docs = parse_all_documents (Parser.of_reader reader) in

     

       184
       184
       +
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       185
       185
       +
         match Document.root doc with

     

       186
       186
       +
         | None -> `Null

     

       187
       187
       +
         | Some yaml ->

     

       188
       188
       +
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth

     

       189
       189
       +
               yaml

     

       215
       190
        
       

     

       216
       191
        
       (** Load single document as Yaml from a Bytes.Reader.

     

       217
       192
        
       

     

       218
       193
        
           @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)

     

       219
       194
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       220
       220
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       221
       221
       -
       *)

     

       222
       222
       -
       let yaml_of_reader

     

       223
       223
       -
           ?(resolve_aliases = false)

     

       195
       195
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       196
       196
       +
       let yaml_of_reader ?(resolve_aliases = false)

     

       224
       197
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       225
       225
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       226
       226
       -
           reader =

     

       227
       227
       -
         let parser = Parser.of_reader reader in

     

       228
       228
       -
         let state = create_state () in

     

       229
       229
       -
         Parser.iter (process_event state) parser;

     

       230
       230
       -
         match state.documents with

     

       231
       231
       -
         | [] -> `Scalar (Scalar.make "")

     

       232
       232
       -
         | [doc] ->

     

       233
       233
       -
             (match Document.root doc with

     

       234
       234
       -
              | None -> `Scalar (Scalar.make "")

     

       235
       235
       -
              | Some yaml ->

     

       236
       236
       -
                  if resolve_aliases then

     

       237
       237
       -
                    Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       238
       238
       -
                  else

     

       239
       239
       -
                    yaml)

     

       240
       240
       -
         | _ -> Error.raise Multiple_documents

     

       198
       198
       +
           ?(max_depth = Yaml.default_max_alias_depth) reader =

     

       199
       199
       +
         let docs = parse_all_documents (Parser.of_reader reader) in

     

       200
       200
       +
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       201
       201
       +
         match Document.root doc with

     

       202
       202
       +
         | None -> `Scalar (Scalar.make "")

     

       203
       203
       +
         | Some yaml ->

     

       204
       204
       +
             if resolve_aliases then Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       205
       205
       +
             else yaml

     

       241
       206
        
       

     

       242
       207
        
       (** Load all documents from a Bytes.Reader *)

     

       243
       208
        
       let documents_of_reader reader =

     

       244
       244
       -
         let parser = Parser.of_reader reader in

     

       245
       245
       -
         let state = create_state () in

     

       246
       246
       -
         Parser.iter (process_event state) parser;

     

       247
       247
       -
         List.rev state.documents

     

       209
       209
       +
         parse_all_documents (Parser.of_reader reader)

     

       210
       210
       +
       

     

       211
       211
       +
       (** {2 Parser-function based loading}

     

       212
       212
       +
       

     

       213
       213
       +
           These functions accept a [unit -> Event.spanned option] function

     

       214
       214
       +
           instead of a [Parser.t], allowing them to work with any event source

     

       215
       215
       +
           (e.g., streaming parsers). *)

     

       248
       216
        
       

     

       249
       249
       -
       (** Generic document loader - extracts common pattern from load_* functions *)

     

       250
       250
       -
       let load_generic extract parser =

     

       217
       217
       +
       (** Generic document loader using event source function *)

     

       218
       218
       +
       let load_generic_fn extract next_event =

     

       251
       219
        
         let state = create_state () in

     

       252
       220
        
         let rec loop () =

     

       253
       253
       -
           match Parser.next parser with

     

       221
       221
       +
           match next_event () with

     

       254
       222
        
           | None -> None

     

       255
       255
       -
           | Some ev ->

     

       223
       223
       +
           | Some ev -> (

     

       256
       224
        
               process_event state ev;

     

       257
       225
        
               match ev.event with

     

       258
       258
       -
               | Event.Document_end _ ->

     

       259
       259
       -
                   (match state.documents with

     

       260
       260
       -
                    | doc :: _ ->

     

       261
       261
       -
                        state.documents <- [];

     

       262
       262
       -
                        Some (extract doc)

     

       263
       263
       -
                    | [] -> None)

     

       226
       226
       +
               | Event.Document_end _ -> (

     

       227
       227
       +
                   match state.documents with

     

       228
       228
       +
                   | doc :: _ ->

     

       229
       229
       +
                       state.documents <- [];

     

       230
       230
       +
                       Some (extract doc)

     

       231
       231
       +
                   | [] -> None)

     

       264
       232
        
               | Event.Stream_end -> None

     

       265
       265
       -
               | _ -> loop ()

     

       233
       233
       +
               | _ -> loop ())

     

       266
       234
        
         in

     

       267
       235
        
         loop ()

     

       268
       236
        
       

     

       237
       237
       +
       (** Generic document loader - extracts common pattern from load_* functions *)

     

       238
       238
       +
       let load_generic extract parser =

     

       239
       239
       +
         load_generic_fn extract (fun () -> Parser.next parser)

     

       240
       240
       +
       

     

       269
       241
        
       (** Load single Value from parser.

     

       270
       242
        
       

     

       271
       243
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       272
       244
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       273
       273
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       274
       274
       -
       *)

     

       275
       275
       -
       let load_value

     

       276
       276
       -
           ?(resolve_aliases = true)

     

       245
       245
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       246
       246
       +
       let load_value ?(resolve_aliases = true)

     

       277
       247
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       278
       278
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       279
       279
       -
           parser =

     

       280
       280
       -
         load_generic (fun doc ->

     

       281
       281
       -
           match Document.root doc with

     

       282
       282
       -
           | None -> `Null

     

       283
       283
       -
           | Some yaml ->

     

       284
       284
       -
               Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

       285
       285
       -
         ) parser

     

       248
       248
       +
           ?(max_depth = Yaml.default_max_alias_depth) parser =

     

       249
       249
       +
         load_generic

     

       250
       250
       +
           (fun doc ->

     

       251
       251
       +
             match Document.root doc with

     

       252
       252
       +
             | None -> `Null

     

       253
       253
       +
             | Some yaml ->

     

       254
       254
       +
                 Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes

     

       255
       255
       +
                   ~max_depth yaml)

     

       256
       256
       +
           parser

     

       286
       257
        
       

     

       287
       258
        
       (** Load single Yaml from parser *)

     

       288
       259
        
       let load_yaml parser =

     

       289
       289
       -
         load_generic (fun doc ->

     

       290
       290
       -
           Document.root doc |> Option.value ~default:(`Scalar (Scalar.make ""))

     

       291
       291
       -
         ) parser

     

       260
       260
       +
         load_generic

     

       261
       261
       +
           (fun doc ->

     

       262
       262
       +
             Document.root doc |> Option.value ~default:(`Scalar (Scalar.make "")))

     

       263
       263
       +
           parser

     

       292
       264
        
       

     

       293
       265
        
       (** Load single Document from parser *)

     

       294
       294
       -
       let load_document parser =

     

       295
       295
       -
         load_generic Fun.id parser

     

       266
       266
       +
       let load_document parser = load_generic Fun.id parser

     

       296
       267
        
       

     

       297
       268
        
       (** Iterate over documents *)

     

       298
       269
        
       let iter_documents f parser =

     

       299
       270
        
         let rec loop () =

     

       300
       271
        
           match load_document parser with

     

       301
       272
        
           | None -> ()

     

       302
       302
       -
           | Some doc -> f doc; loop ()

     

       273
       273
       +
           | Some doc ->

     

       274
       274
       +
               f doc;

     

       275
       275
       +
               loop ()

     

       303
       276
        
         in

     

       304
       277
        
         loop ()

     

       305
       278
        
       

     

       306
       279
        
       (** Fold over documents *)

     

       307
       280
        
       let fold_documents f init parser =

     

       308
       281
        
         let rec loop acc =

     

       309
       309
       -
           match load_document parser with

     

       310
       310
       -
           | None -> acc

     

       311
       311
       -
           | Some doc -> loop (f acc doc)

     

       282
       282
       +
           match load_document parser with None -> acc | Some doc -> loop (f acc doc)

     

       312
       283
        
         in

     

       313
       284
        
         loop init

     

       314
       285
        
       

     

       315
       315
       -
       (** {2 Parser-function based loading}

     

       316
       316
       -
       

     

       317
       317
       -
           These functions accept a [unit -> Event.spanned option] function

     

       318
       318
       -
           instead of a [Parser.t], allowing them to work with any event source

     

       319
       319
       -
           (e.g., streaming parsers). *)

     

       320
       320
       -
       

     

       321
       321
       -
       (** Generic document loader using event source function *)

     

       322
       322
       -
       let load_generic_fn extract next_event =

     

       323
       323
       -
         let state = create_state () in

     

       324
       324
       -
         let rec loop () =

     

       325
       325
       -
           match next_event () with

     

       326
       326
       -
           | None -> None

     

       327
       327
       -
           | Some ev ->

     

       328
       328
       -
               process_event state ev;

     

       329
       329
       -
               match ev.event with

     

       330
       330
       -
               | Event.Document_end _ ->

     

       331
       331
       -
                   (match state.documents with

     

       332
       332
       -
                    | doc :: _ ->

     

       333
       333
       -
                        state.documents <- [];

     

       334
       334
       -
                        Some (extract doc)

     

       335
       335
       -
                    | [] -> None)

     

       336
       336
       -
               | Event.Stream_end -> None

     

       337
       337
       -
               | _ -> loop ()

     

       338
       338
       -
         in

     

       339
       339
       -
         loop ()

     

       340
       286
        
       

     

       341
       287
        
       (** Load single Value from event source.

     

       342
       288
        
       

     

       343
       289
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       344
       290
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       345
       345
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       346
       346
       -
       *)

     

       347
       347
       -
       let value_of_parser

     

       348
       348
       -
           ?(resolve_aliases = true)

     

       291
       291
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       292
       292
       +
       let value_of_parser ?(resolve_aliases = true)

     

       349
       293
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       350
       350
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       351
       351
       -
           next_event =

     

       352
       352
       -
         match load_generic_fn (fun doc ->

     

       353
       353
       -
           match Document.root doc with

     

       354
       354
       -
           | None -> `Null

     

       355
       355
       -
           | Some yaml ->

     

       356
       356
       -
               Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

       357
       357
       -
         ) next_event with

     

       294
       294
       +
           ?(max_depth = Yaml.default_max_alias_depth) next_event =

     

       295
       295
       +
         match

     

       296
       296
       +
           load_generic_fn

     

       297
       297
       +
             (fun doc ->

     

       298
       298
       +
               match Document.root doc with

     

       299
       299
       +
               | None -> `Null

     

       300
       300
       +
               | Some yaml ->

     

       301
       301
       +
                   Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes

     

       302
       302
       +
                     ~max_depth yaml)

     

       303
       303
       +
             next_event

     

       304
       304
       +
         with

     

       358
       305
        
         | Some v -> v

     

       359
       306
        
         | None -> `Null

     

       360
       307
        
       

     
···

       362
       309
        
       

     

       363
       310
        
           @param resolve_aliases Whether to resolve aliases (default false)

     

       364
       311
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       365
       365
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       366
       366
       -
       *)

     

       367
       367
       -
       let yaml_of_parser

     

       368
       368
       -
           ?(resolve_aliases = false)

     

       312
       312
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       313
       313
       +
       let yaml_of_parser ?(resolve_aliases = false)

     

       369
       314
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       370
       370
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       371
       371
       -
           next_event =

     

       372
       372
       -
         match load_generic_fn (fun doc ->

     

       373
       373
       -
           match Document.root doc with

     

       374
       374
       -
           | None -> `Scalar (Scalar.make "")

     

       375
       375
       -
           | Some yaml ->

     

       376
       376
       -
               if resolve_aliases then

     

       377
       377
       -
                 Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       378
       378
       -
               else

     

       379
       379
       -
                 yaml

     

       380
       380
       -
         ) next_event with

     

       315
       315
       +
           ?(max_depth = Yaml.default_max_alias_depth) next_event =

     

       316
       316
       +
         match

     

       317
       317
       +
           load_generic_fn

     

       318
       318
       +
             (fun doc ->

     

       319
       319
       +
               match Document.root doc with

     

       320
       320
       +
               | None -> `Scalar (Scalar.make "")

     

       321
       321
       +
               | Some yaml ->

     

       322
       322
       +
                   if resolve_aliases then

     

       323
       323
       +
                     Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       324
       324
       +
                   else yaml)

     

       325
       325
       +
             next_event

     

       326
       326
       +
         with

     

       381
       327
        
         | Some v -> v

     

       382
       328
        
         | None -> `Scalar (Scalar.make "")

     

       383
       329
        
       

     

       384
       330
        
       (** Load single Document from event source *)

     

       385
       385
       -
       let document_of_parser next_event =

     

       386
       386
       -
         load_generic_fn Fun.id next_event

     

       331
       331
       +
       let document_of_parser next_event = load_generic_fn Fun.id next_event

     

       387
       332
        
       

     

       388
       333
        
       (** Load all documents from event source *)

     

       389
       334
        
       let documents_of_parser next_event =

     
···

       402
       347
        
         let rec loop () =

     

       403
       348
        
           match document_of_parser next_event with

     

       404
       349
        
           | None -> ()

     

       405
       405
       -
           | Some doc -> f doc; loop ()

     

       350
       350
       +
           | Some doc ->

     

       351
       351
       +
               f doc;

     

       352
       352
       +
               loop ()

     

       406
       353
        
         in

     

       407
       354
        
         loop ()

     

       408
       355

+104

lib/loader.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Loader - converts parser events to YAML data structures *)

     

       7
       7
       +
       

     

       8
       8
       +
       (** {1 String-based loading} *)

     

       9
       9
       +
       

     

       10
       10
       +
       val value_of_string :

     

       11
       11
       +
         ?resolve_aliases:bool ->

     

       12
       12
       +
         ?max_nodes:int ->

     

       13
       13
       +
         ?max_depth:int ->

     

       14
       14
       +
         string -> Value.t

     

       15
       15
       +
       (** Load single document as Value.

     

       16
       16
       +
       

     

       17
       17
       +
           @param resolve_aliases Whether to resolve aliases (default true)

     

       18
       18
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       19
       19
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       20
       20
       +
       

     

       21
       21
       +
       val yaml_of_string :

     

       22
       22
       +
         ?resolve_aliases:bool ->

     

       23
       23
       +
         ?max_nodes:int ->

     

       24
       24
       +
         ?max_depth:int ->

     

       25
       25
       +
         string -> Yaml.t

     

       26
       26
       +
       (** Load single document as Yaml.

     

       27
       27
       +
       

     

       28
       28
       +
           @param resolve_aliases Whether to resolve aliases (default false)

     

       29
       29
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       30
       30
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       31
       31
       +
       

     

       32
       32
       +
       val documents_of_string : string -> Document.t list

     

       33
       33
       +
       (** Load all documents from a string *)

     

       34
       34
       +
       

     

       35
       35
       +
       (** {1 Reader-based loading} *)

     

       36
       36
       +
       

     

       37
       37
       +
       val value_of_reader :

     

       38
       38
       +
         ?resolve_aliases:bool ->

     

       39
       39
       +
         ?max_nodes:int ->

     

       40
       40
       +
         ?max_depth:int ->

     

       41
       41
       +
         Bytesrw.Bytes.Reader.t -> Value.t

     

       42
       42
       +
       (** Load single document as Value from a Bytes.Reader *)

     

       43
       43
       +
       

     

       44
       44
       +
       val yaml_of_reader :

     

       45
       45
       +
         ?resolve_aliases:bool ->

     

       46
       46
       +
         ?max_nodes:int ->

     

       47
       47
       +
         ?max_depth:int ->

     

       48
       48
       +
         Bytesrw.Bytes.Reader.t -> Yaml.t

     

       49
       49
       +
       (** Load single document as Yaml from a Bytes.Reader *)

     

       50
       50
       +
       

     

       51
       51
       +
       val documents_of_reader : Bytesrw.Bytes.Reader.t -> Document.t list

     

       52
       52
       +
       (** Load all documents from a Bytes.Reader *)

     

       53
       53
       +
       

     

       54
       54
       +
       (** {1 Parser-based loading} *)

     

       55
       55
       +
       

     

       56
       56
       +
       val load_value :

     

       57
       57
       +
         ?resolve_aliases:bool ->

     

       58
       58
       +
         ?max_nodes:int ->

     

       59
       59
       +
         ?max_depth:int ->

     

       60
       60
       +
         Parser.t -> Value.t option

     

       61
       61
       +
       (** Load single Value from parser *)

     

       62
       62
       +
       

     

       63
       63
       +
       val load_yaml : Parser.t -> Yaml.t option

     

       64
       64
       +
       (** Load single Yaml from parser *)

     

       65
       65
       +
       

     

       66
       66
       +
       val load_document : Parser.t -> Document.t option

     

       67
       67
       +
       (** Load single Document from parser *)

     

       68
       68
       +
       

     

       69
       69
       +
       val iter_documents : (Document.t -> unit) -> Parser.t -> unit

     

       70
       70
       +
       (** Iterate over documents from parser *)

     

       71
       71
       +
       

     

       72
       72
       +
       val fold_documents : ('a -> Document.t -> 'a) -> 'a -> Parser.t -> 'a

     

       73
       73
       +
       (** Fold over documents from parser *)

     

       74
       74
       +
       

     

       75
       75
       +
       (** {1 Event function-based loading}

     

       76
       76
       +
       

     

       77
       77
       +
           These functions accept a [unit -> Event.spanned option] function

     

       78
       78
       +
           instead of a [Parser.t], allowing them to work with any event source. *)

     

       79
       79
       +
       

     

       80
       80
       +
       val value_of_parser :

     

       81
       81
       +
         ?resolve_aliases:bool ->

     

       82
       82
       +
         ?max_nodes:int ->

     

       83
       83
       +
         ?max_depth:int ->

     

       84
       84
       +
         (unit -> Event.spanned option) -> Value.t

     

       85
       85
       +
       (** Load single Value from event source function *)

     

       86
       86
       +
       

     

       87
       87
       +
       val yaml_of_parser :

     

       88
       88
       +
         ?resolve_aliases:bool ->

     

       89
       89
       +
         ?max_nodes:int ->

     

       90
       90
       +
         ?max_depth:int ->

     

       91
       91
       +
         (unit -> Event.spanned option) -> Yaml.t

     

       92
       92
       +
       (** Load single Yaml from event source function *)

     

       93
       93
       +
       

     

       94
       94
       +
       val document_of_parser : (unit -> Event.spanned option) -> Document.t option

     

       95
       95
       +
       (** Load single Document from event source function *)

     

       96
       96
       +
       

     

       97
       97
       +
       val documents_of_parser : (unit -> Event.spanned option) -> Document.t list

     

       98
       98
       +
       (** Load all documents from event source function *)

     

       99
       99
       +
       

     

       100
       100
       +
       val iter_documents_parser : (Document.t -> unit) -> (unit -> Event.spanned option) -> unit

     

       101
       101
       +
       (** Iterate over documents from event source function *)

     

       102
       102
       +
       

     

       103
       103
       +
       val fold_documents_parser : ('a -> Document.t -> 'a) -> 'a -> (unit -> Event.spanned option) -> 'a

     

       104
       104
       +
       (** Fold over documents from event source function *)

+40 -47

lib/mapping.ml

···

       13
       13
        
         members : ('k * 'v) list;

     

       14
       14
        
       }

     

       15
       15
        
       

     

       16
       16
       -
       let make

     

       17
       17
       -
           ?(anchor : string option)

     

       18
       18
       -
           ?(tag : string option)

     

       19
       19
       -
           ?(implicit = true)

     

       20
       20
       -
           ?(style = `Any)

     

       21
       21
       -
           members =

     

       16
       16
       +
       let make ?(anchor : string option) ?(tag : string option) ?(implicit = true)

     

       17
       17
       +
           ?(style = `Any) members =

     

       22
       18
        
         { anchor; tag; implicit; style; members }

     

       23
       19
        
       

     

       24
       20
        
       let members t = t.members

     
···

       26
       22
        
       let tag t = t.tag

     

       27
       23
        
       let implicit t = t.implicit

     

       28
       24
        
       let style t = t.style

     

       29
       29
       -
       

     

       30
       25
        
       let with_anchor anchor t = { t with anchor = Some anchor }

     

       31
       26
        
       let with_tag tag t = { t with tag = Some tag }

     

       32
       27
        
       let with_style style t = { t with style }

     

       33
       28
        
       

     

       34
       34
       -
       let map_keys f t = { t with members = List.map (fun (k, v) -> (f k, v)) t.members }

     

       35
       35
       -
       let map_values f t = { t with members = List.map (fun (k, v) -> (k, f v)) t.members }

     

       29
       29
       +
       let map_keys f t =

     

       30
       30
       +
         { t with members = List.map (fun (k, v) -> (f k, v)) t.members }

     

       31
       31
       +
       

     

       32
       32
       +
       let map_values f t =

     

       33
       33
       +
         { t with members = List.map (fun (k, v) -> (k, f v)) t.members }

     

       34
       34
       +
       

     

       36
       35
        
       let map f t = { t with members = List.map (fun (k, v) -> f k v) t.members }

     

       37
       37
       -
       

     

       38
       36
        
       let length t = List.length t.members

     

       39
       39
       -
       

     

       40
       37
        
       let is_empty t = t.members = []

     

       41
       38
        
       

     

       42
       39
        
       let find pred t =

     

       43
       40
        
         List.find_opt (fun (k, _) -> pred k) t.members |> Option.map snd

     

       44
       41
        
       

     

       45
       45
       -
       let find_key pred t =

     

       46
       46
       -
         List.find_opt (fun (k, _) -> pred k) t.members

     

       47
       47
       -
       

     

       48
       48
       -
       let mem pred t =

     

       49
       49
       -
         List.exists (fun (k, _) -> pred k) t.members

     

       50
       50
       -
       

     

       42
       42
       +
       let find_key pred t = List.find_opt (fun (k, _) -> pred k) t.members

     

       43
       43
       +
       let mem pred t = List.exists (fun (k, _) -> pred k) t.members

     

       51
       44
        
       let keys t = List.map fst t.members

     

       52
       52
       -
       

     

       53
       45
        
       let values t = List.map snd t.members

     

       54
       54
       -
       

     

       55
       46
        
       let iter f t = List.iter (fun (k, v) -> f k v) t.members

     

       56
       56
       -
       

     

       57
       47
        
       let fold f init t = List.fold_left (fun acc (k, v) -> f acc k v) init t.members

     

       58
       48
        
       

     

       59
       49
        
       let pp pp_key pp_val fmt t =

     

       60
       50
        
         Format.fprintf fmt "@[<hv 2>mapping(@,";

     

       61
       61
       -
         (match t.anchor with

     

       62
       62
       -
          | Some a -> Format.fprintf fmt "anchor=%s,@ " a

     

       63
       63
       -
          | None -> ());

     

       64
       64
       -
         (match t.tag with

     

       65
       65
       -
          | Some tag -> Format.fprintf fmt "tag=%s,@ " tag

     

       66
       66
       -
          | None -> ());

     

       51
       51
       +
         Option.iter (Format.fprintf fmt "anchor=%s,@ ") t.anchor;

     

       52
       52
       +
         Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;

     

       67
       53
        
         Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;

     

       68
       54
        
         Format.fprintf fmt "members={@,";

     

       69
       69
       -
         List.iteri (fun i (k, v) ->

     

       70
       70
       -
           if i > 0 then Format.fprintf fmt ",@ ";

     

       71
       71
       -
           Format.fprintf fmt "@[<hv 2>%a:@ %a@]" pp_key k pp_val v

     

       72
       72
       -
         ) t.members;

     

       55
       55
       +
         List.iteri

     

       56
       56
       +
           (fun i (k, v) ->

     

       57
       57
       +
             if i > 0 then Format.fprintf fmt ",@ ";

     

       58
       58
       +
             Format.fprintf fmt "@[<hv 2>%a:@ %a@]" pp_key k pp_val v)

     

       59
       59
       +
           t.members;

     

       73
       60
        
         Format.fprintf fmt "@]@,})"

     

       74
       61
        
       

     

       75
       62
        
       let equal eq_k eq_v a b =

     

       76
       76
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       77
       77
       -
         Option.equal String.equal a.tag b.tag &&

     

       78
       78
       -
         a.implicit = b.implicit &&

     

       79
       79
       -
         Layout_style.equal a.style b.style &&

     

       80
       80
       -
         List.equal (fun (k1, v1) (k2, v2) -> eq_k k1 k2 && eq_v v1 v2) a.members b.members

     

       63
       63
       +
         Option.equal String.equal a.anchor b.anchor

     

       64
       64
       +
         && Option.equal String.equal a.tag b.tag

     

       65
       65
       +
         && a.implicit = b.implicit

     

       66
       66
       +
         && Layout_style.equal a.style b.style

     

       67
       67
       +
         && List.equal

     

       68
       68
       +
              (fun (k1, v1) (k2, v2) -> eq_k k1 k2 && eq_v v1 v2)

     

       69
       69
       +
              a.members b.members

     

       81
       70
        
       

     

       82
       71
        
       let compare cmp_k cmp_v a b =

     

       83
       72
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       84
       84
       -
         if c <> 0 then c else

     

       85
       85
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       86
       86
       -
         if c <> 0 then c else

     

       87
       87
       -
         let c = Bool.compare a.implicit b.implicit in

     

       88
       88
       -
         if c <> 0 then c else

     

       89
       89
       -
         let c = Layout_style.compare a.style b.style in

     

       90
       90
       -
         if c <> 0 then c else

     

       91
       91
       -
         let cmp_pair (k1, v1) (k2, v2) =

     

       92
       92
       -
           let c = cmp_k k1 k2 in

     

       93
       93
       -
           if c <> 0 then c else cmp_v v1 v2

     

       94
       94
       -
         in

     

       95
       95
       -
         List.compare cmp_pair a.members b.members

     

       73
       73
       +
         if c <> 0 then c

     

       74
       74
       +
         else

     

       75
       75
       +
           let c = Option.compare String.compare a.tag b.tag in

     

       76
       76
       +
           if c <> 0 then c

     

       77
       77
       +
           else

     

       78
       78
       +
             let c = Bool.compare a.implicit b.implicit in

     

       79
       79
       +
             if c <> 0 then c

     

       80
       80
       +
             else

     

       81
       81
       +
               let c = Layout_style.compare a.style b.style in

     

       82
       82
       +
               if c <> 0 then c

     

       83
       83
       +
               else

     

       84
       84
       +
                 let cmp_pair (k1, v1) (k2, v2) =

     

       85
       85
       +
                   let c = cmp_k k1 k2 in

     

       86
       86
       +
                   if c <> 0 then c else cmp_v v1 v2

     

       87
       87
       +
                 in

     

       88
       88
       +
                 List.compare cmp_pair a.members b.members

+54

lib/mapping.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML mapping (object) values with metadata *)

     

       7
       7
       +
       

     

       8
       8
       +
       type ('k, 'v) t

     

       9
       9
       +
       

     

       10
       10
       +
       val make :

     

       11
       11
       +
         ?anchor:string ->

     

       12
       12
       +
         ?tag:string ->

     

       13
       13
       +
         ?implicit:bool ->

     

       14
       14
       +
         ?style:Layout_style.t ->

     

       15
       15
       +
         ('k * 'v) list -> ('k, 'v) t

     

       16
       16
       +
       (** Create a mapping *)

     

       17
       17
       +
       

     

       18
       18
       +
       (** {2 Accessors} *)

     

       19
       19
       +
       

     

       20
       20
       +
       val members : ('k, 'v) t -> ('k * 'v) list

     

       21
       21
       +
       val anchor : ('k, 'v) t -> string option

     

       22
       22
       +
       val tag : ('k, 'v) t -> string option

     

       23
       23
       +
       val implicit : ('k, 'v) t -> bool

     

       24
       24
       +
       val style : ('k, 'v) t -> Layout_style.t

     

       25
       25
       +
       

     

       26
       26
       +
       (** {2 Modifiers} *)

     

       27
       27
       +
       

     

       28
       28
       +
       val with_anchor : string -> ('k, 'v) t -> ('k, 'v) t

     

       29
       29
       +
       val with_tag : string -> ('k, 'v) t -> ('k, 'v) t

     

       30
       30
       +
       val with_style : Layout_style.t -> ('k, 'v) t -> ('k, 'v) t

     

       31
       31
       +
       

     

       32
       32
       +
       (** {2 Operations} *)

     

       33
       33
       +
       

     

       34
       34
       +
       val map_keys : ('k -> 'k2) -> ('k, 'v) t -> ('k2, 'v) t

     

       35
       35
       +
       val map_values : ('v -> 'v2) -> ('k, 'v) t -> ('k, 'v2) t

     

       36
       36
       +
       val map : ('k -> 'v -> 'k2 * 'v2) -> ('k, 'v) t -> ('k2, 'v2) t

     

       37
       37
       +
       val length : ('k, 'v) t -> int

     

       38
       38
       +
       val is_empty : ('k, 'v) t -> bool

     

       39
       39
       +
       val find : ('k -> bool) -> ('k, 'v) t -> 'v option

     

       40
       40
       +
       val find_key : ('k -> bool) -> ('k, 'v) t -> ('k * 'v) option

     

       41
       41
       +
       val mem : ('k -> bool) -> ('k, 'v) t -> bool

     

       42
       42
       +
       val keys : ('k, 'v) t -> 'k list

     

       43
       43
       +
       val values : ('k, 'v) t -> 'v list

     

       44
       44
       +
       val iter : ('k -> 'v -> unit) -> ('k, 'v) t -> unit

     

       45
       45
       +
       val fold : ('a -> 'k -> 'v -> 'a) -> 'a -> ('k, 'v) t -> 'a

     

       46
       46
       +
       

     

       47
       47
       +
       (** {2 Comparison} *)

     

       48
       48
       +
       

     

       49
       49
       +
       val pp :

     

       50
       50
       +
         (Format.formatter -> 'k -> unit) ->

     

       51
       51
       +
         (Format.formatter -> 'v -> unit) ->

     

       52
       52
       +
         Format.formatter -> ('k, 'v) t -> unit

     

       53
       53
       +
       val equal : ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> ('k, 'v) t -> ('k, 'v) t -> bool

     

       54
       54
       +
       val compare : ('k -> 'k -> int) -> ('v -> 'v -> int) -> ('k, 'v) t -> ('k, 'v) t -> int

+267 -342

lib/parser.ml

···

       9
       9
        
       type state =

     

       10
       10
        
         | Stream_start

     

       11
       11
        
         | Implicit_document_start

     

       12
       12
       -
         | Document_start

     

       13
       12
        
         | Document_content

     

       14
       14
       -
         | Document_content_done  (* After parsing a node, check for unexpected content *)

     

       13
       13
       +
         | Document_content_done

     

       14
       14
       +
           (* After parsing a node, check for unexpected content *)

     

       15
       15
        
         | Document_end

     

       16
       16
       -
         | Block_node

     

       17
       17
       -
         | Block_node_or_indentless_sequence

     

       18
       18
       -
         | Flow_node

     

       19
       16
        
         | Block_sequence_first_entry

     

       20
       17
        
         | Block_sequence_entry

     

       21
       18
        
         | Indentless_sequence_entry

     
···

       30
       27
        
         | Flow_mapping_first_key

     

       31
       28
        
         | Flow_mapping_key

     

       32
       29
        
         | Flow_mapping_value

     

       33
       33
       -
         | Flow_mapping_empty_value

     

       34
       30
        
         | End

     

       35
       31
        
       

     

       36
       32
        
       type t = {

     

       37
       33
        
         scanner : Scanner.t;

     

       38
       34
        
         mutable state : state;

     

       39
       35
        
         mutable states : state list;  (** State stack *)

     

       40
       40
       -
         mutable marks : Span.t list;  (** Mark stack for span tracking *)

     

       41
       36
        
         mutable version : (int * int) option;

     

       42
       37
        
         mutable tag_directives : (string * string) list;

     

       43
       38
        
         mutable current_token : Token.spanned option;

     

       44
       39
        
         mutable finished : bool;

     

       45
       45
       -
         mutable explicit_doc_end : bool;  (** True if last doc ended with explicit ... *)

     

       46
       46
       -
         mutable stream_start : bool;  (** True if we haven't emitted any documents yet *)

     

       40
       40
       +
         mutable explicit_doc_end : bool;

     

       41
       41
       +
             (** True if last doc ended with explicit ... *)

     

       42
       42
       +
         mutable stream_start : bool;

     

       43
       43
       +
             (** True if we haven't emitted any documents yet *)

     

       47
       44
        
       }

     

       48
       45
        
       

     

       49
       49
       -
       let create scanner = {

     

       50
       50
       -
         scanner;

     

       51
       51
       -
         state = Stream_start;

     

       52
       52
       -
         states = [];

     

       53
       53
       -
         marks = [];

     

       54
       54
       -
         version = None;

     

       55
       55
       -
         tag_directives = [

     

       56
       56
       -
           ("!", "!");

     

       57
       57
       -
           ("!!", "tag:yaml.org,2002:");

     

       58
       58
       -
         ];

     

       59
       59
       -
         current_token = None;

     

       60
       60
       -
         finished = false;

     

       61
       61
       -
         explicit_doc_end = false;

     

       62
       62
       -
         stream_start = true;

     

       63
       63
       -
       }

     

       46
       46
       +
       let create scanner =

     

       47
       47
       +
         {

     

       48
       48
       +
           scanner;

     

       49
       49
       +
           state = Stream_start;

     

       50
       50
       +
           states = [];

     

       51
       51
       +
           version = None;

     

       52
       52
       +
           tag_directives = [ ("!", "!"); ("!!", "tag:yaml.org,2002:") ];

     

       53
       53
       +
           current_token = None;

     

       54
       54
       +
           finished = false;

     

       55
       55
       +
           explicit_doc_end = false;

     

       56
       56
       +
           stream_start = true;

     

       57
       57
       +
         }

     

       64
       58
        
       

     

       65
       59
        
       let of_string s = create (Scanner.of_string s)

     

       66
       60
        
       let of_scanner = create

     
···

       71
       65
        
       let current_token t =

     

       72
       66
        
         match t.current_token with

     

       73
       67
        
         | Some tok -> tok

     

       74
       74
       -
         | None ->

     

       68
       68
       +
         | None -> (

     

       75
       69
        
             let tok = Scanner.next t.scanner in

     

       76
       70
        
             t.current_token <- tok;

     

       77
       77
       -
             match tok with

     

       78
       78
       -
             | Some tok -> tok

     

       79
       79
       -
             | None -> Error.raise Unexpected_eof

     

       71
       71
       +
             match tok with Some tok -> tok | None -> Error.raise Unexpected_eof)

     

       80
       72
        
       

     

       81
       73
        
       (** Peek at current token *)

     

       82
       74
        
       let peek_token t =

     
···

       87
       79
        
             t.current_token

     

       88
       80
        
       

     

       89
       81
        
       (** Skip current token *)

     

       90
       90
       -
       let skip_token t =

     

       91
       91
       -
         t.current_token <- None

     

       82
       82
       +
       let skip_token t = t.current_token <- None

     

       92
       83
        
       

     

       93
       93
       -
       (** Check if current token matches *)

     

       84
       84
       +
       (** Check if current token matches predicate *)

     

       94
       85
        
       let check t pred =

     

       95
       95
       -
         match peek_token t with

     

       96
       96
       -
         | Some tok -> pred tok.token

     

       97
       97
       -
         | None -> false

     

       86
       86
       +
         match peek_token t with Some tok -> pred tok.token | None -> false

     

       98
       87
        
       

     

       99
       99
       -
       (** Check for specific token *)

     

       100
       100
       -
       let check_token t token_match =

     

       101
       101
       -
         check t token_match

     

       102
       88
        
       

     

       103
       89
        
       (** Push state onto stack *)

     

       104
       104
       -
       let push_state t s =

     

       105
       105
       -
         t.states <- s :: t.states

     

       90
       90
       +
       let push_state t s = t.states <- s :: t.states

     

       106
       91
        
       

     

       107
       92
        
       (** Pop state from stack *)

     

       108
       93
        
       let pop_state t =

     
···

       126
       111
        
       (** Process directives at document start *)

     

       127
       112
        
       let process_directives t =

     

       128
       113
        
         t.version <- None;

     

       129
       129
       -
         t.tag_directives <- [("!", "!"); ("!!", "tag:yaml.org,2002:")];

     

       114
       114
       +
         t.tag_directives <- [ ("!", "!"); ("!!", "tag:yaml.org,2002:") ];

     

       130
       115
        
       

     

       131
       131
       -
         while check t (function

     

       132
       132
       -
           | Token.Version_directive _ | Token.Tag_directive _ -> true

     

       133
       133
       -
           | _ -> false)

     

       116
       116
       +
         while

     

       117
       117
       +
           check t (function

     

       118
       118
       +
             | Token.Version_directive _ | Token.Tag_directive _ -> true

     

       119
       119
       +
             | _ -> false)

     

       134
       120
        
         do

     

       135
       121
        
           let tok = current_token t in

     

       136
       122
        
           skip_token t;

     

       137
       123
        
           match tok.token with

     

       138
       124
        
           | Token.Version_directive { major; minor } ->

     

       139
       125
        
               if t.version <> None then

     

       140
       140
       -
                 Error.raise_span tok.span (Invalid_yaml_version "duplicate YAML directive");

     

       126
       126
       +
                 Error.raise_span tok.span

     

       127
       127
       +
                   (Invalid_yaml_version "duplicate YAML directive");

     

       141
       128
        
               t.version <- Some (major, minor)

     

       142
       129
        
           | Token.Tag_directive { handle; prefix } ->

     

       143
       130
        
               (* Skip empty tag directives (these are reserved/unknown directives that were ignored) *)

     

       144
       144
       -
               if handle = "" && prefix = "" then

     

       145
       145
       -
                 () (* Ignore reserved directives *)

     

       131
       131
       +
               if handle = "" && prefix = "" then () (* Ignore reserved directives *)

     

       146
       132
        
               else begin

     

       147
       147
       -
                 if List.mem_assoc handle t.tag_directives &&

     

       148
       148
       -
                    handle <> "!" && handle <> "!!" then

     

       149
       149
       -
                   Error.raise_span tok.span (Invalid_tag_directive ("duplicate tag handle: " ^ handle));

     

       133
       133
       +
                 if

     

       134
       134
       +
                   List.mem_assoc handle t.tag_directives

     

       135
       135
       +
                   && handle <> "!" && handle <> "!!"

     

       136
       136
       +
                 then

     

       137
       137
       +
                   Error.raise_span tok.span

     

       138
       138
       +
                     (Invalid_tag_directive ("duplicate tag handle: " ^ handle));

     

       150
       139
        
                 t.tag_directives <- (handle, prefix) :: t.tag_directives

     

       151
       140
        
               end

     

       152
       141
        
           | _ -> ()

     
···

       157
       146
        
         let anchor = ref None in

     

       158
       147
        
         let tag = ref None in

     

       159
       148
        
       

     

       160
       160
       -
         while check t (function

     

       161
       161
       -
           | Token.Anchor _ | Token.Tag _ -> true

     

       162
       162
       -
           | _ -> false)

     

       149
       149
       +
         while

     

       150
       150
       +
           check t (function Token.Anchor _ | Token.Tag _ -> true | _ -> false)

     

       163
       151
        
         do

     

       164
       152
        
           let tok = current_token t in

     

       165
       153
        
           skip_token t;

     
···

       183
       171
        
       

     

       184
       172
        
       (** Empty scalar event *)

     

       185
       173
        
       let empty_scalar_event ~anchor ~tag span =

     

       186
       186
       -
         Event.Scalar {

     

       187
       187
       -
           anchor;

     

       188
       188
       -
           tag;

     

       189
       189
       -
           value = "";

     

       190
       190
       -
           plain_implicit = tag = None;

     

       191
       191
       -
           quoted_implicit = false;

     

       192
       192
       -
           style = `Plain;

     

       193
       193
       -
         }, span

     

       174
       174
       +
         ( Event.Scalar

     

       175
       175
       +
             {

     

       176
       176
       +
               anchor;

     

       177
       177
       +
               tag;

     

       178
       178
       +
               value = "";

     

       179
       179
       +
               plain_implicit = tag = None;

     

       180
       180
       +
               quoted_implicit = false;

     

       181
       181
       +
               style = `Plain;

     

       182
       182
       +
             },

     

       183
       183
       +
           span )

     

       194
       184
        
       

     

       195
       185
        
       (** Parse stream start *)

     

       196
       186
        
       let parse_stream_start t =

     
···

       199
       189
        
         match tok.token with

     

       200
       190
        
         | Token.Stream_start encoding ->

     

       201
       191
        
             t.state <- Implicit_document_start;

     

       202
       202
       -
             Event.Stream_start { encoding }, tok.span

     

       203
       203
       -
         | _ ->

     

       204
       204
       -
             Error.raise_span tok.span (Unexpected_token "expected stream start")

     

       192
       192
       +
             (Event.Stream_start { encoding }, tok.span)

     

       193
       193
       +
         | _ -> Error.raise_span tok.span (Unexpected_token "expected stream start")

     

       205
       194
        
       

     

       206
       195
        
       (** Parse document start (implicit or explicit) *)

     

       207
       196
        
       let parse_document_start t ~implicit =

     
···

       210
       199
        
         if not implicit then begin

     

       211
       200
        
           let tok = current_token t in

     

       212
       201
        
           match tok.token with

     

       213
       213
       -
           | Token.Document_start ->

     

       214
       214
       -
               skip_token t

     

       215
       215
       -
           | _ ->

     

       216
       216
       -
               Error.raise_span tok.span Expected_document_start

     

       202
       202
       +
           | Token.Document_start -> skip_token t

     

       203
       203
       +
           | _ -> Error.raise_span tok.span Expected_document_start

     

       217
       204
        
         end;

     

       218
       205
        
       

     

       219
       219
       -
         let span = match peek_token t with

     

       206
       206
       +
         let span =

     

       207
       207
       +
           match peek_token t with

     

       220
       208
        
           | Some tok -> tok.span

     

       221
       209
        
           | None -> Span.point Position.initial

     

       222
       210
        
         in

     
···

       225
       213
        
         t.stream_start <- false;

     

       226
       214
        
         push_state t Document_end;

     

       227
       215
        
         t.state <- Document_content;

     

       228
       228
       -
         Event.Document_start { version = t.version; implicit }, span

     

       216
       216
       +
         (Event.Document_start { version = t.version; implicit }, span)

     

       229
       217
        
       

     

       230
       218
        
       (** Parse document end *)

     

       231
       219
        
       let parse_document_end t =

     

       232
       232
       -
         let implicit = not (check t (function Token.Document_end -> true | _ -> false)) in

     

       233
       233
       -
         let span = match peek_token t with

     

       220
       220
       +
         let implicit =

     

       221
       221
       +
           not (check t (function Token.Document_end -> true | _ -> false))

     

       222
       222
       +
         in

     

       223
       223
       +
         let span =

     

       224
       224
       +
           match peek_token t with

     

       234
       225
        
           | Some tok -> tok.span

     

       235
       226
        
           | None -> Span.point Position.initial

     

       236
       227
        
         in

     
···

       240
       231
        
         (* Track if this document ended explicitly with ... *)

     

       241
       232
        
         t.explicit_doc_end <- not implicit;

     

       242
       233
        
         t.state <- Implicit_document_start;

     

       243
       243
       -
         Event.Document_end { implicit }, span

     

       234
       234
       +
         (Event.Document_end { implicit }, span)

     

       244
       235
        
       

     

       245
       236
        
       (** Parse node in various contexts *)

     

       246
       237
        
       let parse_node t ~block ~indentless =

     
···

       249
       240
        
         | Token.Alias name ->

     

       250
       241
        
             skip_token t;

     

       251
       242
        
             t.state <- pop_state t;

     

       252
       252
       -
             Event.Alias { anchor = name }, tok.span

     

       253
       253
       -
       

     

       254
       254
       -
         | Token.Anchor _ | Token.Tag _ ->

     

       243
       243
       +
             (Event.Alias { anchor = name }, tok.span)

     

       244
       244
       +
         | Token.Anchor _ | Token.Tag _ -> (

     

       255
       245
        
             let anchor, tag = parse_properties t in

     

       256
       246
        
             let tok = current_token t in

     

       257
       257
       -
             (match tok.token with

     

       258
       258
       -
              | Token.Block_entry when indentless ->

     

       259
       259
       -
                  t.state <- Indentless_sequence_entry;

     

       260
       260
       -
                  Event.Sequence_start {

     

       261
       261
       -
                    anchor; tag;

     

       262
       262
       -
                    implicit = tag = None;

     

       263
       263
       -
                    style = `Block;

     

       264
       264
       -
                  }, tok.span

     

       265
       265
       -
       

     

       266
       266
       -
              | Token.Block_sequence_start when block ->

     

       267
       267
       -
                  t.state <- Block_sequence_first_entry;

     

       268
       268
       -
                  skip_token t;

     

       269
       269
       -
                  Event.Sequence_start {

     

       270
       270
       -
                    anchor; tag;

     

       271
       271
       -
                    implicit = tag = None;

     

       272
       272
       -
                    style = `Block;

     

       273
       273
       -
                  }, tok.span

     

       274
       274
       -
       

     

       275
       275
       -
              | Token.Block_mapping_start when block ->

     

       276
       276
       -
                  t.state <- Block_mapping_first_key;

     

       277
       277
       -
                  skip_token t;

     

       278
       278
       -
                  Event.Mapping_start {

     

       279
       279
       -
                    anchor; tag;

     

       280
       280
       -
                    implicit = tag = None;

     

       281
       281
       -
                    style = `Block;

     

       282
       282
       -
                  }, tok.span

     

       283
       283
       -
       

     

       284
       284
       -
              | Token.Flow_sequence_start ->

     

       285
       285
       -
                  t.state <- Flow_sequence_first_entry;

     

       286
       286
       -
                  skip_token t;

     

       287
       287
       -
                  Event.Sequence_start {

     

       288
       288
       -
                    anchor; tag;

     

       289
       289
       -
                    implicit = tag = None;

     

       290
       290
       -
                    style = `Flow;

     

       291
       291
       -
                  }, tok.span

     

       292
       292
       -
       

     

       293
       293
       -
              | Token.Flow_mapping_start ->

     

       294
       294
       -
                  t.state <- Flow_mapping_first_key;

     

       295
       295
       -
                  skip_token t;

     

       296
       296
       -
                  Event.Mapping_start {

     

       297
       297
       -
                    anchor; tag;

     

       298
       298
       -
                    implicit = tag = None;

     

       299
       299
       -
                    style = `Flow;

     

       300
       300
       -
                  }, tok.span

     

       301
       301
       -
       

     

       302
       302
       -
              | Token.Scalar { style; value } ->

     

       303
       303
       -
                  skip_token t;

     

       304
       304
       -
                  t.state <- pop_state t;

     

       305
       305
       -
                  let plain_implicit = tag = None && style = `Plain in

     

       306
       306
       -
                  let quoted_implicit = tag = None && style <> `Plain in

     

       307
       307
       -
                  Event.Scalar {

     

       308
       308
       -
                    anchor; tag; value;

     

       309
       309
       -
                    plain_implicit; quoted_implicit; style;

     

       310
       310
       -
                  }, tok.span

     

       311
       311
       -
       

     

       312
       312
       -
              | _ ->

     

       313
       313
       -
                  (* Empty node *)

     

       314
       314
       -
                  t.state <- pop_state t;

     

       315
       315
       -
                  empty_scalar_event ~anchor ~tag tok.span)

     

       316
       316
       -
       

     

       247
       247
       +
             match tok.token with

     

       248
       248
       +
             | Token.Block_entry when indentless ->

     

       249
       249
       +
                 t.state <- Indentless_sequence_entry;

     

       250
       250
       +
                 ( Event.Sequence_start

     

       251
       251
       +
                     { anchor; tag; implicit = tag = None; style = `Block },

     

       252
       252
       +
                   tok.span )

     

       253
       253
       +
             | Token.Block_sequence_start when block ->

     

       254
       254
       +
                 t.state <- Block_sequence_first_entry;

     

       255
       255
       +
                 skip_token t;

     

       256
       256
       +
                 ( Event.Sequence_start

     

       257
       257
       +
                     { anchor; tag; implicit = tag = None; style = `Block },

     

       258
       258
       +
                   tok.span )

     

       259
       259
       +
             | Token.Block_mapping_start when block ->

     

       260
       260
       +
                 t.state <- Block_mapping_first_key;

     

       261
       261
       +
                 skip_token t;

     

       262
       262
       +
                 ( Event.Mapping_start

     

       263
       263
       +
                     { anchor; tag; implicit = tag = None; style = `Block },

     

       264
       264
       +
                   tok.span )

     

       265
       265
       +
             | Token.Flow_sequence_start ->

     

       266
       266
       +
                 t.state <- Flow_sequence_first_entry;

     

       267
       267
       +
                 skip_token t;

     

       268
       268
       +
                 ( Event.Sequence_start

     

       269
       269
       +
                     { anchor; tag; implicit = tag = None; style = `Flow },

     

       270
       270
       +
                   tok.span )

     

       271
       271
       +
             | Token.Flow_mapping_start ->

     

       272
       272
       +
                 t.state <- Flow_mapping_first_key;

     

       273
       273
       +
                 skip_token t;

     

       274
       274
       +
                 ( Event.Mapping_start

     

       275
       275
       +
                     { anchor; tag; implicit = tag = None; style = `Flow },

     

       276
       276
       +
                   tok.span )

     

       277
       277
       +
             | Token.Scalar { style; value } ->

     

       278
       278
       +
                 skip_token t;

     

       279
       279
       +
                 t.state <- pop_state t;

     

       280
       280
       +
                 let plain_implicit = tag = None && style = `Plain in

     

       281
       281
       +
                 let quoted_implicit = tag = None && style <> `Plain in

     

       282
       282
       +
                 ( Event.Scalar

     

       283
       283
       +
                     { anchor; tag; value; plain_implicit; quoted_implicit; style },

     

       284
       284
       +
                   tok.span )

     

       285
       285
       +
             | _ ->

     

       286
       286
       +
                 (* Empty node *)

     

       287
       287
       +
                 t.state <- pop_state t;

     

       288
       288
       +
                 empty_scalar_event ~anchor ~tag tok.span)

     

       317
       289
        
         | Token.Block_sequence_start when block ->

     

       318
       290
        
             t.state <- Block_sequence_first_entry;

     

       319
       291
        
             skip_token t;

     

       320
       320
       -
             Event.Sequence_start {

     

       321
       321
       -
               anchor = None; tag = None;

     

       322
       322
       -
               implicit = true;

     

       323
       323
       -
               style = `Block;

     

       324
       324
       -
             }, tok.span

     

       325
       325
       -
       

     

       292
       292
       +
             ( Event.Sequence_start

     

       293
       293
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       294
       294
       +
               tok.span )

     

       326
       295
        
         | Token.Block_mapping_start when block ->

     

       327
       296
        
             t.state <- Block_mapping_first_key;

     

       328
       297
        
             skip_token t;

     

       329
       329
       -
             Event.Mapping_start {

     

       330
       330
       -
               anchor = None; tag = None;

     

       331
       331
       -
               implicit = true;

     

       332
       332
       -
               style = `Block;

     

       333
       333
       -
             }, tok.span

     

       334
       334
       -
       

     

       298
       298
       +
             ( Event.Mapping_start

     

       299
       299
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       300
       300
       +
               tok.span )

     

       335
       301
        
         | Token.Flow_sequence_start ->

     

       336
       302
        
             t.state <- Flow_sequence_first_entry;

     

       337
       303
        
             skip_token t;

     

       338
       338
       -
             Event.Sequence_start {

     

       339
       339
       -
               anchor = None; tag = None;

     

       340
       340
       -
               implicit = true;

     

       341
       341
       -
               style = `Flow;

     

       342
       342
       -
             }, tok.span

     

       343
       343
       -
       

     

       304
       304
       +
             ( Event.Sequence_start

     

       305
       305
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       306
       306
       +
               tok.span )

     

       344
       307
        
         | Token.Flow_mapping_start ->

     

       345
       308
        
             t.state <- Flow_mapping_first_key;

     

       346
       309
        
             skip_token t;

     

       347
       347
       -
             Event.Mapping_start {

     

       348
       348
       -
               anchor = None; tag = None;

     

       349
       349
       -
               implicit = true;

     

       350
       350
       -
               style = `Flow;

     

       351
       351
       -
             }, tok.span

     

       352
       352
       -
       

     

       310
       310
       +
             ( Event.Mapping_start

     

       311
       311
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       312
       312
       +
               tok.span )

     

       353
       313
        
         | Token.Block_entry when indentless ->

     

       354
       314
        
             t.state <- Indentless_sequence_entry;

     

       355
       355
       -
             Event.Sequence_start {

     

       356
       356
       -
               anchor = None; tag = None;

     

       357
       357
       -
               implicit = true;

     

       358
       358
       -
               style = `Block;

     

       359
       359
       -
             }, tok.span

     

       360
       360
       -
       

     

       315
       315
       +
             ( Event.Sequence_start

     

       316
       316
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       317
       317
       +
               tok.span )

     

       361
       318
        
         | Token.Scalar { style; value } ->

     

       362
       319
        
             skip_token t;

     

       363
       320
        
             t.state <- pop_state t;

     

       364
       321
        
             let plain_implicit = style = `Plain in

     

       365
       322
        
             let quoted_implicit = style <> `Plain in

     

       366
       366
       -
             Event.Scalar {

     

       367
       367
       -
               anchor = None; tag = None; value;

     

       368
       368
       -
               plain_implicit; quoted_implicit; style;

     

       369
       369
       -
             }, tok.span

     

       370
       370
       -
       

     

       323
       323
       +
             ( Event.Scalar

     

       324
       324
       +
                 {

     

       325
       325
       +
                   anchor = None;

     

       326
       326
       +
                   tag = None;

     

       327
       327
       +
                   value;

     

       328
       328
       +
                   plain_implicit;

     

       329
       329
       +
                   quoted_implicit;

     

       330
       330
       +
                   style;

     

       331
       331
       +
                 },

     

       332
       332
       +
               tok.span )

     

       371
       333
        
         | _ ->

     

       372
       334
        
             (* Empty node *)

     

       373
       335
        
             t.state <- pop_state t;

     
···

       379
       341
        
         match tok.token with

     

       380
       342
        
         | Token.Block_entry ->

     

       381
       343
        
             skip_token t;

     

       382
       382
       -
             if check t (function

     

       383
       383
       -
               | Token.Block_entry | Token.Block_end -> true

     

       384
       384
       -
               | _ -> false)

     

       344
       344
       +
             if

     

       345
       345
       +
               check t (function

     

       346
       346
       +
                 | Token.Block_entry | Token.Block_end -> true

     

       347
       347
       +
                 | _ -> false)

     

       385
       348
        
             then begin

     

       386
       349
        
               t.state <- Block_sequence_entry;

     

       387
       350
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       388
       388
       -
             end else begin

     

       351
       351
       +
             end

     

       352
       352
       +
             else begin

     

       389
       353
        
               push_state t Block_sequence_entry;

     

       390
       354
        
               parse_node t ~block:true ~indentless:false

     

       391
       355
        
             end

     

       392
       356
        
         | Token.Block_end ->

     

       393
       357
        
             skip_token t;

     

       394
       358
        
             t.state <- pop_state t;

     

       395
       395
       -
             Event.Sequence_end, tok.span

     

       396
       396
       -
         | _ ->

     

       397
       397
       -
             Error.raise_span tok.span Expected_block_entry

     

       359
       359
       +
             (Event.Sequence_end, tok.span)

     

       360
       360
       +
         | _ -> Error.raise_span tok.span Expected_block_entry

     

       398
       361
        
       

     

       399
       362
        
       (** Parse block mapping key *)

     

       400
       363
        
       let parse_block_mapping_key t =

     
···

       402
       365
        
         match tok.token with

     

       403
       366
        
         | Token.Key ->

     

       404
       367
        
             skip_token t;

     

       405
       405
       -
             if check t (function

     

       406
       406
       -
               | Token.Key | Token.Value | Token.Block_end -> true

     

       407
       407
       -
               | _ -> false)

     

       368
       368
       +
             if

     

       369
       369
       +
               check t (function

     

       370
       370
       +
                 | Token.Key | Token.Value | Token.Block_end -> true

     

       371
       371
       +
                 | _ -> false)

     

       408
       372
        
             then begin

     

       409
       373
        
               t.state <- Block_mapping_value;

     

       410
       374
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       411
       411
       -
             end else begin

     

       375
       375
       +
             end

     

       376
       376
       +
             else begin

     

       412
       377
        
               push_state t Block_mapping_value;

     

       413
       378
        
               parse_node t ~block:true ~indentless:true

     

       414
       379
        
             end

     
···

       419
       384
        
         | Token.Block_end ->

     

       420
       385
        
             skip_token t;

     

       421
       386
        
             t.state <- pop_state t;

     

       422
       422
       -
             Event.Mapping_end, tok.span

     

       423
       423
       -
         | _ ->

     

       424
       424
       -
             Error.raise_span tok.span Expected_key

     

       387
       387
       +
             (Event.Mapping_end, tok.span)

     

       388
       388
       +
         | _ -> Error.raise_span tok.span Expected_key

     

       425
       389
        
       

     

       426
       390
        
       (** Parse block mapping value *)

     

       427
       391
        
       let parse_block_mapping_value t =

     
···

       429
       393
        
         match tok.token with

     

       430
       394
        
         | Token.Value ->

     

       431
       395
        
             skip_token t;

     

       432
       432
       -
             if check t (function

     

       433
       433
       -
               | Token.Key | Token.Value | Token.Block_end -> true

     

       434
       434
       -
               | _ -> false)

     

       396
       396
       +
             if

     

       397
       397
       +
               check t (function

     

       398
       398
       +
                 | Token.Key | Token.Value | Token.Block_end -> true

     

       399
       399
       +
                 | _ -> false)

     

       435
       400
        
             then begin

     

       436
       401
        
               t.state <- Block_mapping_key;

     

       437
       402
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       438
       438
       -
             end else begin

     

       403
       403
       +
             end

     

       404
       404
       +
             else begin

     

       439
       405
        
               push_state t Block_mapping_key;

     

       440
       406
        
               parse_node t ~block:true ~indentless:true

     

       441
       407
        
             end

     
···

       450
       416
        
         match tok.token with

     

       451
       417
        
         | Token.Block_entry ->

     

       452
       418
        
             skip_token t;

     

       453
       453
       -
             if check t (function

     

       454
       454
       -
               | Token.Block_entry | Token.Key | Token.Value | Token.Block_end -> true

     

       455
       455
       -
               | _ -> false)

     

       419
       419
       +
             if

     

       420
       420
       +
               check t (function

     

       421
       421
       +
                 | Token.Block_entry | Token.Key | Token.Value | Token.Block_end ->

     

       422
       422
       +
                     true

     

       423
       423
       +
                 | _ -> false)

     

       456
       424
        
             then begin

     

       457
       425
        
               t.state <- Indentless_sequence_entry;

     

       458
       426
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       459
       459
       -
             end else begin

     

       427
       427
       +
             end

     

       428
       428
       +
             else begin

     

       460
       429
        
               push_state t Indentless_sequence_entry;

     

       461
       430
        
               parse_node t ~block:true ~indentless:false

     

       462
       431
        
             end

     

       463
       432
        
         | _ ->

     

       464
       433
        
             t.state <- pop_state t;

     

       465
       465
       -
             Event.Sequence_end, tok.span

     

       434
       434
       +
             (Event.Sequence_end, tok.span)

     

       466
       435
        
       

     

       467
       436
        
       (** Parse flow sequence *)

     

       468
       437
        
       let rec parse_flow_sequence_entry t ~first =

     
···

       471
       440
        
         | Token.Flow_sequence_end ->

     

       472
       441
        
             skip_token t;

     

       473
       442
        
             t.state <- pop_state t;

     

       474
       474
       -
             Event.Sequence_end, tok.span

     

       443
       443
       +
             (Event.Sequence_end, tok.span)

     

       475
       444
        
         | Token.Flow_entry when not first ->

     

       476
       445
        
             skip_token t;

     

       477
       446
        
             parse_flow_sequence_entry_internal t

     

       478
       478
       -
         | _ when first ->

     

       479
       479
       -
             parse_flow_sequence_entry_internal t

     

       480
       480
       -
         | _ ->

     

       481
       481
       -
             Error.raise_span tok.span Expected_sequence_end

     

       447
       447
       +
         | _ when first -> parse_flow_sequence_entry_internal t

     

       448
       448
       +
         | _ -> Error.raise_span tok.span Expected_sequence_end

     

       482
       449
        
       

     

       483
       450
        
       and parse_flow_sequence_entry_internal t =

     

       484
       451
        
         let tok = current_token t in

     
···

       487
       454
        
             (* Trailing comma case - don't emit empty scalar, just go back to sequence entry state *)

     

       488
       455
        
             skip_token t;

     

       489
       456
        
             t.state <- pop_state t;

     

       490
       490
       -
             Event.Sequence_end, tok.span

     

       457
       457
       +
             (Event.Sequence_end, tok.span)

     

       491
       458
        
         | Token.Flow_entry ->

     

       492
       459
        
             (* Double comma or comma after comma - invalid *)

     

       493
       493
       -
             Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow sequence")

     

       460
       460
       +
             Error.raise_span tok.span

     

       461
       461
       +
               (Unexpected_token "unexpected ',' in flow sequence")

     

       494
       462
        
         | Token.Key ->

     

       495
       463
        
             skip_token t;

     

       496
       464
        
             t.state <- Flow_sequence_entry_mapping_key;

     

       497
       497
       -
             Event.Mapping_start {

     

       498
       498
       -
               anchor = None; tag = None;

     

       499
       499
       -
               implicit = true;

     

       500
       500
       -
               style = `Flow;

     

       501
       501
       -
             }, tok.span

     

       465
       465
       +
             ( Event.Mapping_start

     

       466
       466
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       467
       467
       +
               tok.span )

     

       502
       468
        
         | Token.Value ->

     

       503
       469
        
             (* Implicit empty key mapping: [ : value ] *)

     

       504
       470
        
             t.state <- Flow_sequence_entry_mapping_key;

     

       505
       505
       -
             Event.Mapping_start {

     

       506
       506
       -
               anchor = None; tag = None;

     

       507
       507
       -
               implicit = true;

     

       508
       508
       -
               style = `Flow;

     

       509
       509
       -
             }, tok.span

     

       471
       471
       +
             ( Event.Mapping_start

     

       472
       472
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       473
       473
       +
               tok.span )

     

       510
       474
        
         | _ ->

     

       511
       475
        
             push_state t Flow_sequence_entry;

     

       512
       476
        
             parse_node t ~block:false ~indentless:false

     
···

       514
       478
        
       (** Parse flow sequence entry mapping *)

     

       515
       479
        
       let parse_flow_sequence_entry_mapping_key t =

     

       516
       480
        
         let tok = current_token t in

     

       517
       517
       -
         if check t (function

     

       518
       518
       -
           | Token.Value | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       519
       519
       -
           | _ -> false)

     

       481
       481
       +
         if

     

       482
       482
       +
           check t (function

     

       483
       483
       +
             | Token.Value | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       484
       484
       +
             | _ -> false)

     

       520
       485
        
         then begin

     

       521
       486
        
           t.state <- Flow_sequence_entry_mapping_value;

     

       522
       487
        
           empty_scalar_event ~anchor:None ~tag:None tok.span

     

       523
       523
       -
         end else begin

     

       488
       488
       +
         end

     

       489
       489
       +
         else begin

     

       524
       490
        
           push_state t Flow_sequence_entry_mapping_value;

     

       525
       491
        
           parse_node t ~block:false ~indentless:false

     

       526
       492
        
         end

     
···

       530
       496
        
         match tok.token with

     

       531
       497
        
         | Token.Value ->

     

       532
       498
        
             skip_token t;

     

       533
       533
       -
             if check t (function

     

       534
       534
       -
               | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       535
       535
       -
               | _ -> false)

     

       499
       499
       +
             if

     

       500
       500
       +
               check t (function

     

       501
       501
       +
                 | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       502
       502
       +
                 | _ -> false)

     

       536
       503
        
             then begin

     

       537
       504
        
               t.state <- Flow_sequence_entry_mapping_end;

     

       538
       505
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       539
       539
       -
             end else begin

     

       506
       506
       +
             end

     

       507
       507
       +
             else begin

     

       540
       508
        
               push_state t Flow_sequence_entry_mapping_end;

     

       541
       509
        
               parse_node t ~block:false ~indentless:false

     

       542
       510
        
             end

     
···

       547
       515
        
       let parse_flow_sequence_entry_mapping_end t =

     

       548
       516
        
         let tok = current_token t in

     

       549
       517
        
         t.state <- Flow_sequence_entry;

     

       550
       550
       -
         Event.Mapping_end, tok.span

     

       518
       518
       +
         (Event.Mapping_end, tok.span)

     

       551
       519
        
       

     

       552
       520
        
       (** Parse flow mapping *)

     

       553
       521
        
       let rec parse_flow_mapping_key t ~first =

     
···

       556
       524
        
         | Token.Flow_mapping_end ->

     

       557
       525
        
             skip_token t;

     

       558
       526
        
             t.state <- pop_state t;

     

       559
       559
       -
             Event.Mapping_end, tok.span

     

       527
       527
       +
             (Event.Mapping_end, tok.span)

     

       560
       528
        
         | Token.Flow_entry when not first ->

     

       561
       529
        
             skip_token t;

     

       562
       530
        
             parse_flow_mapping_key_internal t

     

       563
       563
       -
         | _ when first ->

     

       564
       564
       -
             parse_flow_mapping_key_internal t

     

       565
       565
       -
         | _ ->

     

       566
       566
       -
             Error.raise_span tok.span Expected_mapping_end

     

       531
       531
       +
         | _ when first -> parse_flow_mapping_key_internal t

     

       532
       532
       +
         | _ -> Error.raise_span tok.span Expected_mapping_end

     

       567
       533
        
       

     

       568
       534
        
       and parse_flow_mapping_key_internal t =

     

       569
       535
        
         let tok = current_token t in

     
···

       572
       538
        
             (* Trailing comma case - don't emit empty scalar, just return to key state *)

     

       573
       539
        
             skip_token t;

     

       574
       540
        
             t.state <- pop_state t;

     

       575
       575
       -
             Event.Mapping_end, tok.span

     

       541
       541
       +
             (Event.Mapping_end, tok.span)

     

       576
       542
        
         | Token.Flow_entry ->

     

       577
       543
        
             (* Double comma or comma after comma - invalid *)

     

       578
       578
       -
             Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow mapping")

     

       544
       544
       +
             Error.raise_span tok.span

     

       545
       545
       +
               (Unexpected_token "unexpected ',' in flow mapping")

     

       579
       546
        
         | Token.Key ->

     

       580
       547
        
             skip_token t;

     

       581
       581
       -
             if check t (function

     

       582
       582
       -
               | Token.Value | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       583
       583
       -
               | _ -> false)

     

       548
       548
       +
             if

     

       549
       549
       +
               check t (function

     

       550
       550
       +
                 | Token.Value | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       551
       551
       +
                 | _ -> false)

     

       584
       552
        
             then begin

     

       585
       553
        
               t.state <- Flow_mapping_value;

     

       586
       554
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       587
       587
       -
             end else begin

     

       555
       555
       +
             end

     

       556
       556
       +
             else begin

     

       588
       557
        
               push_state t Flow_mapping_value;

     

       589
       558
        
               parse_node t ~block:false ~indentless:false

     

       590
       559
        
             end

     
···

       597
       566
        
         if empty then begin

     

       598
       567
        
           t.state <- Flow_mapping_key;

     

       599
       568
        
           empty_scalar_event ~anchor:None ~tag:None tok.span

     

       600
       600
       -
         end else

     

       569
       569
       +
         end

     

       570
       570
       +
         else

     

       601
       571
        
           match tok.token with

     

       602
       572
        
           | Token.Value ->

     

       603
       573
        
               skip_token t;

     

       604
       604
       -
               if check t (function

     

       605
       605
       -
                 | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       606
       606
       -
                 | _ -> false)

     

       574
       574
       +
               if

     

       575
       575
       +
                 check t (function

     

       576
       576
       +
                   | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       577
       577
       +
                   | _ -> false)

     

       607
       578
        
               then begin

     

       608
       579
        
                 t.state <- Flow_mapping_key;

     

       609
       580
        
                 empty_scalar_event ~anchor:None ~tag:None tok.span

     

       610
       610
       -
               end else begin

     

       581
       581
       +
               end

     

       582
       582
       +
               else begin

     

       611
       583
        
                 push_state t Flow_mapping_key;

     

       612
       584
        
                 parse_node t ~block:false ~indentless:false

     

       613
       585
        
               end

     
···

       618
       590
        
       (** Main state machine dispatcher *)

     

       619
       591
        
       let rec parse t =

     

       620
       592
        
         match t.state with

     

       621
       621
       -
         | Stream_start ->

     

       622
       622
       -
             parse_stream_start t

     

       623
       623
       -
       

     

       624
       624
       -
         | Implicit_document_start ->

     

       593
       593
       +
         | Stream_start -> parse_stream_start t

     

       594
       594
       +
         | Implicit_document_start -> (

     

       625
       595
        
             (* Skip any document end markers before checking what's next *)

     

       626
       596
        
             while check t (function Token.Document_end -> true | _ -> false) do

     

       627
       627
       -
               t.explicit_doc_end <- true;  (* Seeing ... counts as explicit end *)

     

       597
       597
       +
               t.explicit_doc_end <- true;

     

       598
       598
       +
               (* Seeing ... counts as explicit end *)

     

       628
       599
        
               skip_token t

     

       629
       600
        
             done;

     

       630
       601
        
       

     

       631
       602
        
             let tok = current_token t in

     

       632
       632
       -
             (match tok.token with

     

       633
       633
       -
              | Token.Stream_end ->

     

       634
       634
       -
                  skip_token t;

     

       635
       635
       -
                  t.state <- End;

     

       636
       636
       -
                  t.finished <- true;

     

       637
       637
       -
                  Event.Stream_end, tok.span

     

       638
       638
       -
              | Token.Version_directive _ | Token.Tag_directive _ ->

     

       639
       639
       -
                  (* Directives are only allowed at stream start or after explicit ... (MUS6/01) *)

     

       640
       640
       -
                  if not t.stream_start && not t.explicit_doc_end then

     

       641
       641
       -
                    Error.raise_span tok.span (Invalid_directive "directives require explicit document end '...' before them");

     

       642
       642
       -
                  parse_document_start t ~implicit:false

     

       643
       643
       -
              | Token.Document_start ->

     

       644
       644
       -
                  parse_document_start t ~implicit:false

     

       645
       645
       -
              (* These tokens are invalid at document start - they indicate leftover junk *)

     

       646
       646
       -
              | Token.Flow_sequence_end | Token.Flow_mapping_end | Token.Flow_entry

     

       647
       647
       -
              | Token.Block_end | Token.Value ->

     

       648
       648
       -
                  Error.raise_span tok.span (Unexpected_token "unexpected token at document start")

     

       649
       649
       -
              | _ ->

     

       650
       650
       -
                  parse_document_start t ~implicit:true)

     

       651
       651
       -
       

     

       652
       652
       -
         | Document_start ->

     

       653
       653
       -
             parse_document_start t ~implicit:false

     

       603
       603
       +
             match tok.token with

     

       604
       604
       +
             | Token.Stream_end ->

     

       605
       605
       +
                 skip_token t;

     

       606
       606
       +
                 t.state <- End;

     

       607
       607
       +
                 t.finished <- true;

     

       608
       608
       +
                 (Event.Stream_end, tok.span)

     

       609
       609
       +
             | Token.Version_directive _ | Token.Tag_directive _ ->

     

       610
       610
       +
                 (* Directives are only allowed at stream start or after explicit ... (MUS6/01) *)

     

       611
       611
       +
                 if (not t.stream_start) && not t.explicit_doc_end then

     

       612
       612
       +
                   Error.raise_span tok.span

     

       613
       613
       +
                     (Invalid_directive

     

       614
       614
       +
                        "directives require explicit document end '...' before them");

     

       615
       615
       +
                 parse_document_start t ~implicit:false

     

       616
       616
       +
             | Token.Document_start -> parse_document_start t ~implicit:false

     

       617
       617
       +
             (* These tokens are invalid at document start - they indicate leftover junk *)

     

       618
       618
       +
             | Token.Flow_sequence_end | Token.Flow_mapping_end | Token.Flow_entry

     

       619
       619
       +
             | Token.Block_end | Token.Value ->

     

       620
       620
       +
                 Error.raise_span tok.span

     

       621
       621
       +
                   (Unexpected_token "unexpected token at document start")

     

       622
       622
       +
             | _ -> parse_document_start t ~implicit:true)

     

       654
       623
        
       

     

       655
       624
        
         | Document_content ->

     

       656
       656
       -
             if check t (function

     

       657
       657
       -
               | Token.Version_directive _ | Token.Tag_directive _

     

       658
       658
       -
               | Token.Document_start | Token.Document_end | Token.Stream_end -> true

     

       659
       659
       -
               | _ -> false)

     

       625
       625
       +
             if

     

       626
       626
       +
               check t (function

     

       627
       627
       +
                 | Token.Version_directive _ | Token.Tag_directive _

     

       628
       628
       +
                 | Token.Document_start | Token.Document_end | Token.Stream_end ->

     

       629
       629
       +
                     true

     

       630
       630
       +
                 | _ -> false)

     

       660
       631
        
             then begin

     

       661
       632
        
               let tok = current_token t in

     

       662
       633
        
               t.state <- pop_state t;

     

       663
       634
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       664
       664
       -
             end else begin

     

       635
       635
       +
             end

     

       636
       636
       +
             else begin

     

       665
       637
        
               (* Push Document_content_done so we return there after parsing the node.

     

       666
       638
        
                  This allows us to check for unexpected content after the node. *)

     

       667
       639
        
               push_state t Document_content_done;

     

       668
       640
        
               parse_node t ~block:true ~indentless:false

     

       669
       641
        
             end

     

       670
       670
       -
       

     

       671
       642
        
         | Document_content_done ->

     

       672
       643
        
             (* After parsing a node in document content, check for unexpected content *)

     

       673
       673
       -
             if check t (function

     

       674
       674
       -
               | Token.Version_directive _ | Token.Tag_directive _

     

       675
       675
       -
               | Token.Document_start | Token.Document_end | Token.Stream_end -> true

     

       676
       676
       -
               | _ -> false)

     

       644
       644
       +
             if

     

       645
       645
       +
               check t (function

     

       646
       646
       +
                 | Token.Version_directive _ | Token.Tag_directive _

     

       647
       647
       +
                 | Token.Document_start | Token.Document_end | Token.Stream_end ->

     

       648
       648
       +
                     true

     

       649
       649
       +
                 | _ -> false)

     

       677
       650
        
             then begin

     

       678
       651
        
               (* Valid document boundary - continue to Document_end *)

     

       679
       652
        
               t.state <- pop_state t;

     

       680
       680
       -
               parse t  (* Continue to emit the next event *)

     

       681
       681
       -
             end else begin

     

       653
       653
       +
               parse t (* Continue to emit the next event *)

     

       654
       654
       +
             end

     

       655
       655
       +
             else begin

     

       682
       656
        
               (* Unexpected content after document value - this is an error (KS4U, BS4K) *)

     

       683
       657
        
               let tok = current_token t in

     

       684
       658
        
               Error.raise_span tok.span

     

       685
       659
        
                 (Unexpected_token "content not allowed after document value")

     

       686
       660
        
             end

     

       687
       687
       -
       

     

       688
       688
       -
         | Document_end ->

     

       689
       689
       -
             parse_document_end t

     

       690
       690
       -
       

     

       691
       691
       -
         | Block_node ->

     

       692
       692
       -
             parse_node t ~block:true ~indentless:false

     

       693
       693
       -
       

     

       694
       694
       -
         | Block_node_or_indentless_sequence ->

     

       695
       695
       -
             parse_node t ~block:true ~indentless:true

     

       696
       696
       -
       

     

       697
       697
       -
         | Flow_node ->

     

       698
       698
       -
             parse_node t ~block:false ~indentless:false

     

       661
       661
       +
         | Document_end -> parse_document_end t

     

       699
       662
        
       

     

       700
       663
        
         | Block_sequence_first_entry ->

     

       701
       664
        
             t.state <- Block_sequence_entry;

     

       702
       665
        
             parse_block_sequence_entry t

     

       703
       703
       -
       

     

       704
       704
       -
         | Block_sequence_entry ->

     

       705
       705
       -
             parse_block_sequence_entry t

     

       706
       706
       -
       

     

       707
       707
       -
         | Indentless_sequence_entry ->

     

       708
       708
       -
             parse_indentless_sequence_entry t

     

       709
       709
       -
       

     

       666
       666
       +
         | Block_sequence_entry -> parse_block_sequence_entry t

     

       667
       667
       +
         | Indentless_sequence_entry -> parse_indentless_sequence_entry t

     

       710
       668
        
         | Block_mapping_first_key ->

     

       711
       669
        
             t.state <- Block_mapping_key;

     

       712
       670
        
             parse_block_mapping_key t

     

       713
       713
       -
       

     

       714
       714
       -
         | Block_mapping_key ->

     

       715
       715
       -
             parse_block_mapping_key t

     

       716
       716
       -
       

     

       717
       717
       -
         | Block_mapping_value ->

     

       718
       718
       -
             parse_block_mapping_value t

     

       719
       719
       -
       

     

       720
       720
       -
         | Flow_sequence_first_entry ->

     

       721
       721
       -
             parse_flow_sequence_entry t ~first:true

     

       722
       722
       -
       

     

       723
       723
       -
         | Flow_sequence_entry ->

     

       724
       724
       -
             parse_flow_sequence_entry t ~first:false

     

       725
       725
       -
       

     

       726
       726
       -
         | Flow_sequence_entry_mapping_key ->

     

       727
       727
       -
             parse_flow_sequence_entry_mapping_key t

     

       728
       728
       -
       

     

       671
       671
       +
         | Block_mapping_key -> parse_block_mapping_key t

     

       672
       672
       +
         | Block_mapping_value -> parse_block_mapping_value t

     

       673
       673
       +
         | Flow_sequence_first_entry -> parse_flow_sequence_entry t ~first:true

     

       674
       674
       +
         | Flow_sequence_entry -> parse_flow_sequence_entry t ~first:false

     

       675
       675
       +
         | Flow_sequence_entry_mapping_key -> parse_flow_sequence_entry_mapping_key t

     

       729
       676
        
         | Flow_sequence_entry_mapping_value ->

     

       730
       677
        
             parse_flow_sequence_entry_mapping_value t

     

       731
       731
       -
       

     

       732
       732
       -
         | Flow_sequence_entry_mapping_end ->

     

       733
       733
       -
             parse_flow_sequence_entry_mapping_end t

     

       734
       734
       -
       

     

       735
       735
       -
         | Flow_mapping_first_key ->

     

       736
       736
       -
             parse_flow_mapping_key t ~first:true

     

       737
       737
       -
       

     

       738
       738
       -
         | Flow_mapping_key ->

     

       739
       739
       -
             parse_flow_mapping_key t ~first:false

     

       740
       740
       -
       

     

       741
       741
       -
         | Flow_mapping_value ->

     

       742
       742
       -
             parse_flow_mapping_value t ~empty:false

     

       743
       743
       -
       

     

       744
       744
       -
         | Flow_mapping_empty_value ->

     

       745
       745
       -
             parse_flow_mapping_value t ~empty:true

     

       678
       678
       +
         | Flow_sequence_entry_mapping_end -> parse_flow_sequence_entry_mapping_end t

     

       679
       679
       +
         | Flow_mapping_first_key -> parse_flow_mapping_key t ~first:true

     

       680
       680
       +
         | Flow_mapping_key -> parse_flow_mapping_key t ~first:false

     

       681
       681
       +
         | Flow_mapping_value -> parse_flow_mapping_value t ~empty:false

     

       746
       682
        
       

     

       747
       683
        
         | End ->

     

       748
       684
        
             let span = Span.point Position.initial in

     

       749
       685
        
             t.finished <- true;

     

       750
       750
       -
             Event.Stream_end, span

     

       686
       686
       +
             (Event.Stream_end, span)

     

       751
       687
        
       

     

       752
       688
        
       (** Get next event *)

     

       753
       689
        
       let next t =

     

       754
       690
        
         if t.finished then None

     

       755
       755
       -
         else begin

     

       691
       691
       +
         else

     

       756
       692
        
           let event, span = parse t in

     

       757
       693
        
           Some { Event.event; span }

     

       758
       758
       -
         end

     

       759
       759
       -
       

     

       760
       760
       -
       (** Peek at next event *)

     

       761
       761
       -
       let peek t =

     

       762
       762
       -
         (* Parser is not easily peekable without full state save/restore *)

     

       763
       763
       -
         (* For now, we don't support peek - could add caching if needed *)

     

       764
       764
       -
         if t.finished then None

     

       765
       765
       -
         else

     

       766
       766
       -
           (* Just call next and the caller will have to deal with it *)

     

       767
       767
       -
           next t

     

       768
       694
        
       

     

       769
       695
        
       (** Iterate over all events *)

     

       770
       696
        
       let iter f t =

     

       771
       697
        
         let rec loop () =

     

       772
       698
        
           match next t with

     

       773
       699
        
           | None -> ()

     

       774
       774
       -
           | Some ev -> f ev; loop ()

     

       700
       700
       +
           | Some ev ->

     

       701
       701
       +
               f ev;

     

       702
       702
       +
               loop ()

     

       775
       703
        
         in

     

       776
       704
        
         loop ()

     

       777
       705
        
       

     

       778
       706
        
       (** Fold over all events *)

     

       779
       707
        
       let fold f init t =

     

       780
       708
        
         let rec loop acc =

     

       781
       781
       -
           match next t with

     

       782
       782
       -
           | None -> acc

     

       783
       783
       -
           | Some ev -> loop (f acc ev)

     

       709
       709
       +
           match next t with None -> acc | Some ev -> loop (f acc ev)

     

       784
       710
        
         in

     

       785
       711
        
         loop init

     

       786
       712
        
       

     

       787
       713
        
       (** Convert to list *)

     

       788
       788
       -
       let to_list t =

     

       789
       789
       -
         fold (fun acc ev -> ev :: acc) [] t |> List.rev

     

       714
       714
       +
       let to_list t = fold (fun acc ev -> ev :: acc) [] t |> List.rev

+38

lib/parser.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML parser - converts tokens to semantic events via state machine *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t

     

       9
       9
       +
       

     

       10
       10
       +
       (** {2 Constructors} *)

     

       11
       11
       +
       

     

       12
       12
       +
       val of_string : string -> t

     

       13
       13
       +
       (** Create parser from a string *)

     

       14
       14
       +
       

     

       15
       15
       +
       val of_scanner : Scanner.t -> t

     

       16
       16
       +
       (** Create parser from a scanner *)

     

       17
       17
       +
       

     

       18
       18
       +
       val of_input : Input.t -> t

     

       19
       19
       +
       (** Create parser from an input source *)

     

       20
       20
       +
       

     

       21
       21
       +
       val of_reader : Bytesrw.Bytes.Reader.t -> t

     

       22
       22
       +
       (** Create parser from a Bytes.Reader *)

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Event Access} *)

     

       25
       25
       +
       

     

       26
       26
       +
       val next : t -> Event.spanned option

     

       27
       27
       +
       (** Get next event *)

     

       28
       28
       +
       

     

       29
       29
       +
       (** {2 Iteration} *)

     

       30
       30
       +
       

     

       31
       31
       +
       val iter : (Event.spanned -> unit) -> t -> unit

     

       32
       32
       +
       (** Iterate over all events *)

     

       33
       33
       +
       

     

       34
       34
       +
       val fold : ('a -> Event.spanned -> 'a) -> 'a -> t -> 'a

     

       35
       35
       +
       (** Fold over all events *)

     

       36
       36
       +
       

     

       37
       37
       +
       val to_list : t -> Event.spanned list

     

       38
       38
       +
       (** Convert to list of events *)

+11 -28

lib/position.ml

···

       6
       6
        
       (** Position tracking for source locations *)

     

       7
       7
        
       

     

       8
       8
        
       type t = {

     

       9
       9
       -
         index : int;   (** Byte offset from start *)

     

       10
       10
       -
         line : int;    (** 1-indexed line number *)

     

       9
       9
       +
         index : int;  (** Byte offset from start *)

     

       10
       10
       +
         line : int;  (** 1-indexed line number *)

     

       11
       11
        
         column : int;  (** 1-indexed column number *)

     

       12
       12
        
       }

     

       13
       13
        
       

     

       14
       14
        
       let initial = { index = 0; line = 1; column = 1 }

     

       15
       15
       -
       

     

       16
       16
       -
       let advance_byte t =

     

       17
       17
       -
         { t with index = t.index + 1; column = t.column + 1 }

     

       18
       18
       -
       

     

       19
       19
       -
       let advance_line t =

     

       20
       20
       -
         { index = t.index + 1; line = t.line + 1; column = 1 }

     

       21
       21
       -
       

     

       22
       22
       -
       let advance_char c t =

     

       23
       23
       -
         if c = '\n' then advance_line t

     

       24
       24
       -
         else advance_byte t

     

       15
       15
       +
       let advance_byte t = { t with index = t.index + 1; column = t.column + 1 }

     

       16
       16
       +
       let advance_line t = { index = t.index + 1; line = t.line + 1; column = 1 }

     

       17
       17
       +
       let advance_char c t = if c = '\n' then advance_line t else advance_byte t

     

       25
       18
        
       

     

       26
       19
        
       let advance_utf8 uchar t =

     

       27
       20
        
         let len = Uchar.utf_8_byte_length uchar in

     

       28
       21
        
         let code = Uchar.to_int uchar in

     

       29
       22
        
         if code = 0x0A (* LF *) then

     

       30
       23
        
           { index = t.index + len; line = t.line + 1; column = 1 }

     

       31
       31
       -
         else

     

       32
       32
       -
           { t with index = t.index + len; column = t.column + 1 }

     

       24
       24
       +
         else { t with index = t.index + len; column = t.column + 1 }

     

       33
       25
        
       

     

       34
       34
       -
       let advance_bytes n t =

     

       35
       35
       -
         { t with index = t.index + n; column = t.column + n }

     

       36
       36
       -
       

     

       37
       37
       -
       let pp fmt t =

     

       38
       38
       -
         Format.fprintf fmt "line %d, column %d" t.line t.column

     

       39
       39
       -
       

     

       40
       40
       -
       let to_string t =

     

       41
       41
       -
         Format.asprintf "%a" pp t

     

       42
       42
       -
       

     

       43
       43
       -
       let compare a b =

     

       44
       44
       -
         Int.compare a.index b.index

     

       45
       45
       -
       

     

       46
       46
       -
       let equal a b =

     

       47
       47
       -
         a.index = b.index

     

       26
       26
       +
       let advance_bytes n t = { t with index = t.index + n; column = t.column + n }

     

       27
       27
       +
       let pp fmt t = Format.fprintf fmt "line %d, column %d" t.line t.column

     

       28
       28
       +
       let to_string t = Format.asprintf "%a" pp t

     

       29
       29
       +
       let compare a b = Int.compare a.index b.index

     

       30
       30
       +
       let equal a b = a.index = b.index

+42

lib/position.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Position tracking for source locations *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = {

     

       9
       9
       +
         index : int;   (** Byte offset from start *)

     

       10
       10
       +
         line : int;    (** 1-indexed line number *)

     

       11
       11
       +
         column : int;  (** 1-indexed column number *)

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       val initial : t

     

       15
       15
       +
       (** Initial position (index=0, line=1, column=1) *)

     

       16
       16
       +
       

     

       17
       17
       +
       val advance_byte : t -> t

     

       18
       18
       +
       (** Advance by one byte (increments index and column) *)

     

       19
       19
       +
       

     

       20
       20
       +
       val advance_line : t -> t

     

       21
       21
       +
       (** Advance to next line (increments index and line, resets column to 1) *)

     

       22
       22
       +
       

     

       23
       23
       +
       val advance_char : char -> t -> t

     

       24
       24
       +
       (** Advance by one character, handling newlines appropriately *)

     

       25
       25
       +
       

     

       26
       26
       +
       val advance_utf8 : Uchar.t -> t -> t

     

       27
       27
       +
       (** Advance by one Unicode character, handling newlines and multi-byte characters *)

     

       28
       28
       +
       

     

       29
       29
       +
       val advance_bytes : int -> t -> t

     

       30
       30
       +
       (** Advance by n bytes *)

     

       31
       31
       +
       

     

       32
       32
       +
       val pp : Format.formatter -> t -> unit

     

       33
       33
       +
       (** Pretty-print a position *)

     

       34
       34
       +
       

     

       35
       35
       +
       val to_string : t -> string

     

       36
       36
       +
       (** Convert position to string *)

     

       37
       37
       +
       

     

       38
       38
       +
       val compare : t -> t -> int

     

       39
       39
       +
       (** Compare two positions by index *)

     

       40
       40
       +
       

     

       41
       41
       +
       val equal : t -> t -> bool

     

       42
       42
       +
       (** Test equality of two positions *)

+31 -27

lib/quoting.ml

···

       5
       5
        
       

     

       6
       6
        
       (** YAML scalar quoting detection *)

     

       7
       7
        
       

     

       8
       8
       -
       (** Check if a string value needs quoting in YAML output.

     

       9
       9
       -
           Returns true if the string:

     

       8
       8
       +
       (** Check if a string value needs quoting in YAML output. Returns true if the

     

       9
       9
       +
           string:

     

       10
       10
        
           - Is empty

     

       11
       11
        
           - Starts with an indicator character

     

       12
       12
        
           - Is a reserved word (null, true, false, yes, no, etc.)

     
···

       17
       17
        
         else

     

       18
       18
        
           let first = s.[0] in

     

       19
       19
        
           (* Check first character for indicators *)

     

       20
       20
       -
           if first = '-' || first = '?' || first = ':' || first = ',' ||

     

       21
       21
       -
              first = '[' || first = ']' || first = '{' || first = '}' ||

     

       22
       22
       -
              first = '#' || first = '&' || first = '*' || first = '!' ||

     

       23
       23
       -
              first = '|' || first = '>' || first = '\'' || first = '"' ||

     

       24
       24
       -
              first = '%' || first = '@' || first = '`' || first = ' ' then

     

       25
       25
       -
             true

     

       20
       20
       +
           if

     

       21
       21
       +
             first = '-' || first = '?' || first = ':' || first = ',' || first = '['

     

       22
       22
       +
             || first = ']' || first = '{' || first = '}' || first = '#' || first = '&'

     

       23
       23
       +
             || first = '*' || first = '!' || first = '|' || first = '>'

     

       24
       24
       +
             || first = '\'' || first = '"' || first = '%' || first = '@'

     

       25
       25
       +
             || first = '`' || first = ' '

     

       26
       26
       +
           then true

     

       26
       27
        
           else

     

       27
       28
        
             (* Check for reserved/special values *)

     

       28
       29
        
             let lower = String.lowercase_ascii s in

     

       29
       29
       -
             if lower = "null" || lower = "true" || lower = "false" ||

     

       30
       30
       -
                lower = "yes" || lower = "no" || lower = "on" || lower = "off" ||

     

       31
       31
       -
                lower = "~" || lower = ".inf" || lower = "-.inf" || lower = ".nan" then

     

       32
       32
       -
               true

     

       30
       30
       +
             if

     

       31
       31
       +
               lower = "null" || lower = "true" || lower = "false" || lower = "yes"

     

       32
       32
       +
               || lower = "no" || lower = "on" || lower = "off" || lower = "~"

     

       33
       33
       +
               || lower = ".inf" || lower = "-.inf" || lower = ".nan"

     

       34
       34
       +
             then true

     

       33
       35
        
             else

     

       34
       36
        
               (* Check for problematic characters *)

     

       35
       37
        
               try

     

       36
       36
       -
                 String.iter (fun c ->

     

       37
       37
       -
                   if c = ':' || c = '#' || c = '\n' || c = '\r' then

     

       38
       38
       -
                     raise Exit

     

       39
       39
       -
                 ) s;

     

       38
       38
       +
                 String.iter

     

       39
       39
       +
                   (fun c ->

     

       40
       40
       +
                     if c = ':' || c = '#' || c = '\n' || c = '\r' then raise Exit)

     

       41
       41
       +
                   s;

     

       40
       42
        
                 (* Check if it looks like a number *)

     

       41
       41
       -
                 (try ignore (Float.of_string s); true with _ -> false)

     

       43
       43
       +
                 try

     

       44
       44
       +
                   ignore (Float.of_string s);

     

       45
       45
       +
                   true

     

       46
       46
       +
                 with _ -> false

     

       42
       47
        
               with Exit -> true

     

       43
       48
        
       

     

       44
       44
       -
       (** Check if a string requires double quotes (vs single quotes).

     

       45
       45
       -
           Returns true if the string contains characters that need escape sequences. *)

     

       49
       49
       +
       (** Check if a string requires double quotes (vs single quotes). Returns true if

     

       50
       50
       +
           the string contains characters that need escape sequences. *)

     

       46
       51
        
       let needs_double_quotes s =

     

       47
       52
        
         try

     

       48
       48
       -
           String.iter (fun c ->

     

       49
       49
       -
             if c = '\n' || c = '\r' || c = '\t' || c = '\\' ||

     

       50
       50
       -
                c < ' ' || c = '"' then

     

       51
       51
       -
               raise Exit

     

       52
       52
       -
           ) s;

     

       53
       53
       +
           String.iter

     

       54
       54
       +
             (fun c ->

     

       55
       55
       +
               if c = '\n' || c = '\r' || c = '\t' || c = '\\' || c < ' ' || c = '"'

     

       56
       56
       +
               then raise Exit)

     

       57
       57
       +
             s;

     

       53
       58
        
           false

     

       54
       59
        
         with Exit -> true

     

       55
       60
        
       

     

       56
       61
        
       (** Choose the appropriate quoting style for a string value *)

     

       57
       62
        
       let choose_style s =

     

       58
       63
        
         match (needs_double_quotes s, needs_quoting s) with

     

       59
       59
       -
         | (true, _) -> `Double_quoted

     

       60
       60
       -
         | (_, true) -> `Single_quoted

     

       64
       64
       +
         | true, _ -> `Double_quoted

     

       65
       65
       +
         | _, true -> `Single_quoted

     

       61
       66
        
         | _ -> `Plain

     

       62
       62
       -

+22

lib/quoting.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML scalar quoting detection *)

     

       7
       7
       +
       

     

       8
       8
       +
       val needs_quoting : string -> bool

     

       9
       9
       +
       (** Check if a string value needs quoting in YAML output.

     

       10
       10
       +
           Returns true if the string:

     

       11
       11
       +
           - Is empty

     

       12
       12
       +
           - Starts with an indicator character

     

       13
       13
       +
           - Is a reserved word (null, true, false, yes, no, etc.)

     

       14
       14
       +
           - Contains characters that would be ambiguous

     

       15
       15
       +
           - Looks like a number *)

     

       16
       16
       +
       

     

       17
       17
       +
       val needs_double_quotes : string -> bool

     

       18
       18
       +
       (** Check if a string requires double quotes (vs single quotes).

     

       19
       19
       +
           Returns true if the string contains characters that need escape sequences. *)

     

       20
       20
       +
       

     

       21
       21
       +
       val choose_style : string -> [> `Plain | `Single_quoted | `Double_quoted ]

     

       22
       22
       +
       (** Choose the appropriate quoting style for a string value *)

+24 -30

lib/scalar.ml

···

       14
       14
        
         style : Scalar_style.t;

     

       15
       15
        
       }

     

       16
       16
        
       

     

       17
       17
       -
       let make

     

       18
       18
       -
           ?(anchor : string option)

     

       19
       19
       -
           ?(tag : string option)

     

       20
       20
       -
           ?(plain_implicit = true)

     

       21
       21
       -
           ?(quoted_implicit = false)

     

       22
       22
       -
           ?(style = `Plain)

     

       23
       23
       -
           value =

     

       17
       17
       +
       let make ?(anchor : string option) ?(tag : string option)

     

       18
       18
       +
           ?(plain_implicit = true) ?(quoted_implicit = false) ?(style = `Plain) value

     

       19
       19
       +
           =

     

       24
       20
        
         { anchor; tag; value; plain_implicit; quoted_implicit; style }

     

       25
       21
        
       

     

       26
       22
        
       let value t = t.value

     
···

       29
       25
        
       let style t = t.style

     

       30
       26
        
       let plain_implicit t = t.plain_implicit

     

       31
       27
        
       let quoted_implicit t = t.quoted_implicit

     

       32
       32
       -
       

     

       33
       28
        
       let with_anchor anchor t = { t with anchor = Some anchor }

     

       34
       29
        
       let with_tag tag t = { t with tag = Some tag }

     

       35
       30
        
       let with_style style t = { t with style }

     

       36
       31
        
       

     

       37
       32
        
       let pp fmt t =

     

       38
       33
        
         Format.fprintf fmt "scalar(%S" t.value;

     

       39
       39
       -
         (match t.anchor with

     

       40
       40
       -
          | Some a -> Format.fprintf fmt ", anchor=%s" a

     

       41
       41
       -
          | None -> ());

     

       42
       42
       -
         (match t.tag with

     

       43
       43
       -
          | Some tag -> Format.fprintf fmt ", tag=%s" tag

     

       44
       44
       -
          | None -> ());

     

       34
       34
       +
         Option.iter (Format.fprintf fmt ", anchor=%s") t.anchor;

     

       35
       35
       +
         Option.iter (Format.fprintf fmt ", tag=%s") t.tag;

     

       45
       36
        
         Format.fprintf fmt ", style=%a)" Scalar_style.pp t.style

     

       46
       37
        
       

     

       47
       38
        
       let equal a b =

     

       48
       48
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       49
       49
       -
         Option.equal String.equal a.tag b.tag &&

     

       50
       50
       -
         String.equal a.value b.value &&

     

       51
       51
       -
         a.plain_implicit = b.plain_implicit &&

     

       52
       52
       -
         a.quoted_implicit = b.quoted_implicit &&

     

       53
       53
       -
         Scalar_style.equal a.style b.style

     

       39
       39
       +
         Option.equal String.equal a.anchor b.anchor

     

       40
       40
       +
         && Option.equal String.equal a.tag b.tag

     

       41
       41
       +
         && String.equal a.value b.value

     

       42
       42
       +
         && a.plain_implicit = b.plain_implicit

     

       43
       43
       +
         && a.quoted_implicit = b.quoted_implicit

     

       44
       44
       +
         && Scalar_style.equal a.style b.style

     

       54
       45
        
       

     

       55
       46
        
       let compare a b =

     

       56
       47
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       57
       57
       -
         if c <> 0 then c else

     

       58
       58
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       59
       59
       -
         if c <> 0 then c else

     

       60
       60
       -
         let c = String.compare a.value b.value in

     

       61
       61
       -
         if c <> 0 then c else

     

       62
       62
       -
         let c = Bool.compare a.plain_implicit b.plain_implicit in

     

       63
       63
       -
         if c <> 0 then c else

     

       64
       64
       -
         let c = Bool.compare a.quoted_implicit b.quoted_implicit in

     

       65
       65
       -
         if c <> 0 then c else

     

       66
       66
       -
         Scalar_style.compare a.style b.style

     

       48
       48
       +
         if c <> 0 then c

     

       49
       49
       +
         else

     

       50
       50
       +
           let c = Option.compare String.compare a.tag b.tag in

     

       51
       51
       +
           if c <> 0 then c

     

       52
       52
       +
           else

     

       53
       53
       +
             let c = String.compare a.value b.value in

     

       54
       54
       +
             if c <> 0 then c

     

       55
       55
       +
             else

     

       56
       56
       +
               let c = Bool.compare a.plain_implicit b.plain_implicit in

     

       57
       57
       +
               if c <> 0 then c

     

       58
       58
       +
               else

     

       59
       59
       +
                 let c = Bool.compare a.quoted_implicit b.quoted_implicit in

     

       60
       60
       +
                 if c <> 0 then c else Scalar_style.compare a.style b.style

+38

lib/scalar.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML scalar values with metadata *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t

     

       9
       9
       +
       

     

       10
       10
       +
       val make :

     

       11
       11
       +
         ?anchor:string ->

     

       12
       12
       +
         ?tag:string ->

     

       13
       13
       +
         ?plain_implicit:bool ->

     

       14
       14
       +
         ?quoted_implicit:bool ->

     

       15
       15
       +
         ?style:Scalar_style.t ->

     

       16
       16
       +
         string -> t

     

       17
       17
       +
       (** Create a scalar value *)

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Accessors} *)

     

       20
       20
       +
       

     

       21
       21
       +
       val value : t -> string

     

       22
       22
       +
       val anchor : t -> string option

     

       23
       23
       +
       val tag : t -> string option

     

       24
       24
       +
       val style : t -> Scalar_style.t

     

       25
       25
       +
       val plain_implicit : t -> bool

     

       26
       26
       +
       val quoted_implicit : t -> bool

     

       27
       27
       +
       

     

       28
       28
       +
       (** {2 Modifiers} *)

     

       29
       29
       +
       

     

       30
       30
       +
       val with_anchor : string -> t -> t

     

       31
       31
       +
       val with_tag : string -> t -> t

     

       32
       32
       +
       val with_style : Scalar_style.t -> t -> t

     

       33
       33
       +
       

     

       34
       34
       +
       (** {2 Comparison} *)

     

       35
       35
       +
       

     

       36
       36
       +
       val pp : Format.formatter -> t -> unit

     

       37
       37
       +
       val equal : t -> t -> bool

     

       38
       38
       +
       val compare : t -> t -> int

+8 -11

lib/scalar_style.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Scalar formatting styles *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = [

     

       9
       9
       -
         | `Any           (** Let emitter choose *)

     

       10
       10
       -
         | `Plain         (** Unquoted: foo *)

     

       11
       11
       -
         | `Single_quoted (** 'foo' *)

     

       12
       12
       -
         | `Double_quoted (** "foo" *)

     

       13
       13
       -
         | `Literal       (** | block *)

     

       14
       14
       -
         | `Folded        (** > block *)

     

       15
       15
       -
       ]

     

       8
       8
       +
       type t =

     

       9
       9
       +
         [ `Any  (** Let emitter choose *)

     

       10
       10
       +
         | `Plain  (** Unquoted: foo *)

     

       11
       11
       +
         | `Single_quoted  (** 'foo' *)

     

       12
       12
       +
         | `Double_quoted  (** "foo" *)

     

       13
       13
       +
         | `Literal  (** | block *)

     

       14
       14
       +
         | `Folded  (** > block *) ]

     

       16
       15
        
       

     

       17
       16
        
       let to_string = function

     

       18
       17
        
         | `Any -> "any"

     
···

       22
       21
        
         | `Literal -> "literal"

     

       23
       22
        
         | `Folded -> "folded"

     

       24
       23
        
       

     

       25
       25
       -
       let pp fmt t =

     

       26
       26
       -
         Format.pp_print_string fmt (to_string t)

     

       27
       27
       -
       

     

       24
       24
       +
       let pp fmt t = Format.pp_print_string fmt (to_string t)

     

       28
       25
        
       let equal a b = a = b

     

       29
       26
        
       

     

       30
       27
        
       let compare a b =

+27

lib/scalar_style.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Scalar formatting styles *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = [

     

       9
       9
       +
         | `Any           (** Let emitter choose *)

     

       10
       10
       +
         | `Plain         (** Unquoted: foo *)

     

       11
       11
       +
         | `Single_quoted (** 'foo' *)

     

       12
       12
       +
         | `Double_quoted (** "foo" *)

     

       13
       13
       +
         | `Literal       (** | block *)

     

       14
       14
       +
         | `Folded        (** > block *)

     

       15
       15
       +
       ]

     

       16
       16
       +
       

     

       17
       17
       +
       val to_string : t -> string

     

       18
       18
       +
       (** Convert style to string representation *)

     

       19
       19
       +
       

     

       20
       20
       +
       val pp : Format.formatter -> t -> unit

     

       21
       21
       +
       (** Pretty-print a style *)

     

       22
       22
       +
       

     

       23
       23
       +
       val equal : t -> t -> bool

     

       24
       24
       +
       (** Test equality of two styles *)

     

       25
       25
       +
       

     

       26
       26
       +
       val compare : t -> t -> int

     

       27
       27
       +
       (** Compare two styles *)

+558 -438

lib/scanner.ml

···

       5
       5
        
       

     

       6
       6
        
       (** YAML tokenizer/scanner with lookahead for ambiguity resolution *)

     

       7
       7
        
       

     

       8
       8
       -
       (** Simple key tracking for mapping key disambiguation *)

     

       9
       8
        
       type simple_key = {

     

       10
       9
        
         sk_possible : bool;

     

       11
       10
        
         sk_required : bool;

     

       12
       11
        
         sk_token_number : int;

     

       13
       12
        
         sk_position : Position.t;

     

       14
       13
        
       }

     

       14
       14
       +
       (** Simple key tracking for mapping key disambiguation *)

     

       15
       15
        
       

     

       16
       16
       -
       (** Indent level tracking *)

     

       17
       16
        
       type indent = {

     

       18
       17
        
         indent : int;

     

       19
       18
        
         needs_block_end : bool;

     

       20
       20
       -
         sequence : bool;  (** true if this is a sequence indent *)

     

       21
       19
        
       }

     

       20
       20
       +
       (** Indent level tracking *)

     

       22
       21
        
       

     

       23
       22
        
       type t = {

     

       24
       23
        
         input : Input.t;

     

       25
       25
       -
         mutable tokens : Token.spanned Queue.t;

     

       24
       24
       +
         tokens : Token.spanned Queue.t;

     

       26
       25
        
         mutable token_number : int;

     

       27
       26
        
         mutable tokens_taken : int;

     

       28
       27
        
         mutable stream_started : bool;

     

       29
       28
        
         mutable stream_ended : bool;

     

       30
       29
        
         mutable indent_stack : indent list;  (** Stack of indentation levels *)

     

       31
       31
       -
         mutable flow_level : int;            (** Nesting depth in \[\] or \{\} *)

     

       32
       32
       -
         mutable flow_indent : int;           (** Column where outermost flow collection started *)

     

       33
       33
       -
         mutable simple_keys : simple_key option list;  (** Per flow-level simple key tracking *)

     

       30
       30
       +
         mutable flow_level : int;  (** Nesting depth in \[\] or \{\} *)

     

       31
       31
       +
         mutable flow_indent : int;

     

       32
       32
       +
             (** Column where outermost flow collection started *)

     

       33
       33
       +
         mutable simple_keys : simple_key option list;

     

       34
       34
       +
             (** Per flow-level simple key tracking *)

     

       34
       35
        
         mutable allow_simple_key : bool;

     

       35
       35
       -
         mutable leading_whitespace : bool;   (** True when at start of line (only whitespace seen) *)

     

       36
       36
       -
         mutable document_has_content : bool; (** True if we've emitted content tokens in current document *)

     

       37
       37
       -
         mutable adjacent_value_allowed_at : Position.t option; (** Position where adjacent : is allowed *)

     

       38
       38
       -
         mutable pending_value : bool;        (** True if we've emitted a KEY and are waiting for VALUE *)

     

       39
       39
       -
         mutable flow_mapping_stack : bool list;  (** Stack of whether each flow level is a mapping *)

     

       36
       36
       +
         mutable leading_whitespace : bool;

     

       37
       37
       +
             (** True when at start of line (only whitespace seen) *)

     

       38
       38
       +
         mutable document_has_content : bool;

     

       39
       39
       +
             (** True if we've emitted content tokens in current document *)

     

       40
       40
       +
         mutable adjacent_value_allowed_at : Position.t option;

     

       41
       41
       +
             (** Position where adjacent : is allowed *)

     

       42
       42
       +
         mutable flow_mapping_stack : bool list;

     

       43
       43
       +
             (** Stack of whether each flow level is a mapping *)

     

       40
       44
        
       }

     

       41
       45
        
       

     

       42
       46
        
       let create input =

     
···

       50
       54
        
           indent_stack = [];

     

       51
       55
        
           flow_level = 0;

     

       52
       56
        
           flow_indent = 0;

     

       53
       53
       -
           simple_keys = [None];  (* One entry for the base level *)

     

       57
       57
       +
           simple_keys = [ None ];

     

       58
       58
       +
           (* One entry for the base level *)

     

       54
       59
        
           allow_simple_key = true;

     

       55
       55
       -
           leading_whitespace = true;  (* Start at beginning of stream *)

     

       60
       60
       +
           leading_whitespace = true;

     

       61
       61
       +
           (* Start at beginning of stream *)

     

       56
       62
        
           document_has_content = false;

     

       57
       63
        
           adjacent_value_allowed_at = None;

     

       58
       58
       -
           pending_value = false;

     

       59
       64
        
           flow_mapping_stack = [];

     

       60
       65
        
         }

     

       61
       66
        
       

     

       62
       67
        
       let of_string s = create (Input.of_string s)

     

       63
       68
        
       let of_input = create

     

       64
       69
        
       let of_reader r = create (Input.of_reader r)

     

       65
       65
       -
       

     

       66
       70
        
       let position t = Input.position t.input

     

       67
       71
        
       

     

       68
       72
        
       (** Add a token to the queue *)

     
···

       75
       79
        
       

     

       76
       80
        
       (** Get current indent level *)

     

       77
       81
        
       let current_indent t =

     

       78
       78
       -
         match t.indent_stack with

     

       79
       79
       -
         | [] -> -1

     

       80
       80
       -
         | { indent; _ } :: _ -> indent

     

       82
       82
       +
         match t.indent_stack with [] -> -1 | { indent; _ } :: _ -> indent

     

       81
       83
        
       

     

       82
       82
       -
       (** Skip whitespace to end of line, checking for valid comments.

     

       83
       83
       -
           Returns true if any whitespace (including tabs) was found before a comment. *)

     

       84
       84
       +
       (** Skip whitespace to end of line, checking for valid comments. Returns true if

     

       85
       85
       +
           any whitespace (including tabs) was found before a comment. *)

     

       84
       86
        
       let skip_whitespace_and_comment t =

     

       85
       87
        
         let has_whitespace = ref false in

     

       86
       88
        
         (* Skip blanks (spaces and tabs) *)

     
···

       101
       103
        
                 Error.raise_at (Input.mark t.input) Invalid_comment

     

       102
       104
        
           end;

     

       103
       105
        
           (* Skip to end of line *)

     

       104
       104
       -
           while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do

     

       106
       106
       +
           while (not (Input.is_eof t.input)) && not (Input.next_is_break t.input) do

     

       105
       107
        
             ignore (Input.next t.input)

     

       106
       108
        
           done

     

       107
       109
        
         end

     
···

       112
       114
        
         let found_space = ref false in

     

       113
       115
        
         while Input.next_is_blank t.input do

     

       114
       116
        
           (match Input.peek t.input with

     

       115
       115
       -
            | Some '\t' -> found_tab := true

     

       116
       116
       -
            | Some ' ' -> found_space := true

     

       117
       117
       -
            | _ -> ());

     

       117
       117
       +
           | Some '\t' -> found_tab := true

     

       118
       118
       +
           | Some ' ' -> found_space := true

     

       119
       119
       +
           | _ -> ());

     

       118
       120
        
           ignore (Input.next t.input)

     

       119
       121
        
         done;

     

       120
       122
        
         (!found_tab, !found_space)

     
···

       123
       125
        
       let rec skip_to_next_token t =

     

       124
       126
        
         (* Check for tabs used as indentation in block context *)

     

       125
       127
        
         (match Input.peek t.input with

     

       126
       126
       -
          | Some '\t' when t.flow_level = 0 && t.leading_whitespace &&

     

       127
       127
       -
                           (column t - 1) < current_indent t ->

     

       128
       128
       -
              (* Tab found in indentation zone - this is invalid *)

     

       129
       129
       -
              (* Skip to end of line to check if line has content *)

     

       130
       130
       -
              let start_pos = Input.mark t.input in

     

       131
       131
       -
              while Input.next_is_blank t.input do

     

       132
       132
       -
                ignore (Input.next t.input)

     

       133
       133
       -
              done;

     

       134
       134
       -
              (* If we have content on this line with a tab, raise error *)

     

       135
       135
       -
              if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then

     

       136
       136
       -
                Error.raise_at start_pos Tab_in_indentation

     

       137
       137
       -
          | _ -> ());

     

       128
       128
       +
         | Some '\t'

     

       129
       129
       +
           when t.flow_level = 0 && t.leading_whitespace

     

       130
       130
       +
                && column t - 1 < current_indent t ->

     

       131
       131
       +
             (* Tab found in indentation zone - this is invalid *)

     

       132
       132
       +
             (* Skip to end of line to check if line has content *)

     

       133
       133
       +
             let start_pos = Input.mark t.input in

     

       134
       134
       +
             while Input.next_is_blank t.input do

     

       135
       135
       +
               ignore (Input.next t.input)

     

       136
       136
       +
             done;

     

       137
       137
       +
             (* If we have content on this line with a tab, raise error *)

     

       138
       138
       +
             if (not (Input.next_is_break t.input)) && not (Input.is_eof t.input) then

     

       139
       139
       +
               Error.raise_at start_pos Tab_in_indentation

     

       140
       140
       +
         | _ -> ());

     

       138
       141
        
       

     

       139
       142
        
         (* Skip blanks and validate comments *)

     

       140
       143
        
         skip_whitespace_and_comment t;

     
···

       161
       164
        
                 ignore (Input.next t.input)

     

       162
       165
        
               done;

     

       163
       166
        
               (* If only tabs were used (no spaces) and column < flow_indent, error *)

     

       164
       164
       -
               if not (Input.next_is_break t.input) && not (Input.is_eof t.input) &&

     

       165
       165
       -
                  column t < t.flow_indent then

     

       166
       166
       -
                 Error.raise_at start_mark Invalid_flow_indentation

     

       167
       167
       +
               if

     

       168
       168
       +
                 (not (Input.next_is_break t.input))

     

       169
       169
       +
                 && (not (Input.is_eof t.input))

     

       170
       170
       +
                 && column t < t.flow_indent

     

       171
       171
       +
               then Error.raise_at start_mark Invalid_flow_indentation

     

       167
       172
        
             end;

     

       168
       173
        
             skip_to_next_token t

     

       169
       169
       -
           end else begin

     

       174
       174
       +
           end

     

       175
       175
       +
           else begin

     

       170
       176
        
             ignore (Input.next t.input);

     

       171
       177
        
             skip_to_next_token t

     

       172
       178
        
           end

     

       173
       179
        
         end

     

       174
       180
        
       

     

       175
       181
        
       (** Roll the indentation level *)

     

       176
       176
       -
       let roll_indent t col ~sequence =

     

       182
       182
       +
       let roll_indent t col =

     

       177
       183
        
         if t.flow_level = 0 && col > current_indent t then begin

     

       178
       178
       -
           t.indent_stack <- { indent = col; needs_block_end = true; sequence } :: t.indent_stack;

     

       184
       184
       +
           t.indent_stack <- { indent = col; needs_block_end = true } :: t.indent_stack;

     

       179
       185
        
           true

     

       180
       180
       -
         end else

     

       181
       181
       -
           false

     

       186
       186
       +
         end

     

       187
       187
       +
         else false

     

       182
       188
        
       

     

       183
       189
        
       (** Unroll indentation to given column *)

     

       184
       190
        
       let unroll_indent t col =

     

       185
       185
       -
         while t.flow_level = 0 &&

     

       186
       186
       -
               match t.indent_stack with

     

       187
       187
       -
               | { indent; needs_block_end = true; _ } :: _ when indent > col -> true

     

       188
       188
       -
               | _ -> false

     

       191
       191
       +
         while

     

       192
       192
       +
           t.flow_level = 0

     

       193
       193
       +
           &&

     

       194
       194
       +
           match t.indent_stack with

     

       195
       195
       +
           | { indent; needs_block_end = true; _ } :: _ when indent > col -> true

     

       196
       196
       +
           | _ -> false

     

       189
       197
        
         do

     

       190
       198
        
           match t.indent_stack with

     

       191
       199
        
           | { indent = _; needs_block_end = true; _ } :: rest ->

     
···

       202
       210
        
           (* A simple key is required only if we're in a block context,

     

       203
       211
        
              at the current indentation level, AND the current indent needs a block end.

     

       204
       212
        
              This matches saphyr's logic and prevents false positives for values. *)

     

       205
       205
       -
           let required = t.flow_level = 0 &&

     

       206
       206
       -
                          match t.indent_stack with

     

       207
       207
       -
                          | { indent; needs_block_end = true; _ } :: _ ->

     

       208
       208
       -
                              indent = column t

     

       209
       209
       -
                          | _ -> false

     

       213
       213
       +
           let required =

     

       214
       214
       +
             t.flow_level = 0

     

       215
       215
       +
             &&

     

       216
       216
       +
             match t.indent_stack with

     

       217
       217
       +
             | { indent; needs_block_end = true; _ } :: _ -> indent = column t

     

       218
       218
       +
             | _ -> false

     

       219
       219
       +
           in

     

       220
       220
       +
           let sk =

     

       221
       221
       +
             {

     

       222
       222
       +
               sk_possible = true;

     

       223
       223
       +
               sk_required = required;

     

       224
       224
       +
               sk_token_number = t.token_number;

     

       225
       225
       +
               sk_position = Input.position t.input;

     

       226
       226
       +
             }

     

       210
       227
        
           in

     

       211
       211
       -
           let sk = {

     

       212
       212
       -
             sk_possible = true;

     

       213
       213
       -
             sk_required = required;

     

       214
       214
       -
             sk_token_number = t.token_number;

     

       215
       215
       -
             sk_position = Input.position t.input;

     

       216
       216
       -
           } in

     

       217
       228
        
           (* Remove any existing simple key at current level *)

     

       218
       218
       -
           t.simple_keys <- (

     

       219
       219
       -
             match t.simple_keys with

     

       229
       229
       +
           t.simple_keys <-

     

       230
       230
       +
             (match t.simple_keys with

     

       220
       231
        
             | _ :: rest -> Some sk :: rest

     

       221
       221
       -
             | [] -> [Some sk]

     

       222
       222
       -
           )

     

       232
       232
       +
             | [] -> [ Some sk ])

     

       223
       233
        
         end

     

       224
       234
        
       

     

       225
       235
        
       (** Remove simple key at current level *)

     
···

       232
       242
        
       

     

       233
       243
        
       (** Stale simple keys that span too many tokens *)

     

       234
       244
        
       let stale_simple_keys t =

     

       235
       235
       -
         t.simple_keys <- List.map (fun sk_opt ->

     

       236
       236
       -
           match sk_opt with

     

       237
       237
       -
           | Some sk when sk.sk_possible &&

     

       238
       238
       -
                          (Input.position t.input).line > sk.sk_position.line &&

     

       239
       239
       -
                          t.flow_level = 0 ->

     

       240
       240
       -
               if sk.sk_required then

     

       241
       241
       -
                 Error.raise_at sk.sk_position Expected_key;

     

       242
       242
       -
               None

     

       243
       243
       -
           | _ -> sk_opt

     

       244
       244
       -
         ) t.simple_keys

     

       245
       245
       +
         t.simple_keys <-

     

       246
       246
       +
           List.map

     

       247
       247
       +
             (fun sk_opt ->

     

       248
       248
       +
               match sk_opt with

     

       249
       249
       +
               | Some sk

     

       250
       250
       +
                 when sk.sk_possible

     

       251
       251
       +
                      && (Input.position t.input).line > sk.sk_position.line

     

       252
       252
       +
                      && t.flow_level = 0 ->

     

       253
       253
       +
                   if sk.sk_required then Error.raise_at sk.sk_position Expected_key;

     

       254
       254
       +
                   None

     

       255
       255
       +
               | _ -> sk_opt)

     

       256
       256
       +
             t.simple_keys

     

       245
       257
        
       

     

       246
       258
        
       (** Read anchor or alias name *)

     

       247
       259
        
       let scan_anchor_alias t =

     
···

       254
       266
        
            This matches the saphyr implementation: is_yaml_non_space && !is_flow *)

     

       255
       267
        
         while

     

       256
       268
        
           match Input.peek t.input with

     

       257
       257
       -
           | Some c when not (Input.is_whitespace c) &&

     

       258
       258
       -
                         not (Input.is_flow_indicator c) &&

     

       259
       259
       -
                         c <> '\x00' ->

     

       269
       269
       +
           | Some c

     

       270
       270
       +
             when (not (Input.is_whitespace c))

     

       271
       271
       +
                  && (not (Input.is_flow_indicator c))

     

       272
       272
       +
                  && c <> '\x00' ->

     

       260
       273
        
               Buffer.add_char buf c;

     

       261
       274
        
               ignore (Input.next t.input);

     

       262
       275
        
               true

     

       263
       276
        
           | _ -> false

     

       264
       264
       -
         do () done;

     

       277
       277
       +
         do

     

       278
       278
       +
           ()

     

       279
       279
       +
         done;

     

       265
       280
        
         let name = Buffer.contents buf in

     

       266
       281
        
         if String.length name = 0 then

     

       267
       282
        
           Error.raise_at start (Invalid_anchor "empty anchor name");

     
···

       273
       288
        
         let buf = Buffer.create 16 in

     

       274
       289
        
         (* Expect ! *)

     

       275
       290
        
         (match Input.peek t.input with

     

       276
       276
       -
          | Some '!' ->

     

       277
       277
       -
              Buffer.add_char buf '!';

     

       278
       278
       -
              ignore (Input.next t.input)

     

       279
       279
       -
          | _ -> Error.raise_at start (Invalid_tag "expected '!'"));

     

       291
       291
       +
         | Some '!' ->

     

       292
       292
       +
             Buffer.add_char buf '!';

     

       293
       293
       +
             ignore (Input.next t.input)

     

       294
       294
       +
         | _ -> Error.raise_at start (Invalid_tag "expected '!'"));

     

       280
       295
        
         (* Read word chars *)

     

       281
       296
        
         while

     

       282
       297
        
           match Input.peek t.input with

     
···

       285
       300
        
               ignore (Input.next t.input);

     

       286
       301
        
               true

     

       287
       302
        
           | _ -> false

     

       288
       288
       -
         do () done;

     

       303
       303
       +
         do

     

       304
       304
       +
           ()

     

       305
       305
       +
         done;

     

       289
       306
        
         (* Check for secondary ! *)

     

       290
       307
        
         (match Input.peek t.input with

     

       291
       291
       -
          | Some '!' ->

     

       292
       292
       -
              Buffer.add_char buf '!';

     

       293
       293
       -
              ignore (Input.next t.input)

     

       294
       294
       -
          | _ -> ());

     

       308
       308
       +
         | Some '!' ->

     

       309
       309
       +
             Buffer.add_char buf '!';

     

       310
       310
       +
             ignore (Input.next t.input)

     

       311
       311
       +
         | _ -> ());

     

       295
       312
        
         Buffer.contents buf

     

       296
       313
        
       

     

       297
       314
        
       (** Scan tag suffix (after handle) *)

     
···

       301
       318
        
         in

     

       302
       319
        
         let hex_val c =

     

       303
       320
        
           match c with

     

       304
       304
       -
           | '0'..'9' -> Char.code c - Char.code '0'

     

       305
       305
       -
           | 'A'..'F' -> Char.code c - Char.code 'A' + 10

     

       306
       306
       -
           | 'a'..'f' -> Char.code c - Char.code 'a' + 10

     

       321
       321
       +
           | '0' .. '9' -> Char.code c - Char.code '0'

     

       322
       322
       +
           | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10

     

       323
       323
       +
           | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10

     

       307
       324
        
           | _ -> 0

     

       308
       325
        
         in

     

       309
       326
        
         let buf = Buffer.create 32 in

     

       310
       327
        
         while

     

       311
       328
        
           match Input.peek t.input with

     

       312
       312
       -
           | Some '%' ->

     

       329
       329
       +
           | Some '%' -> (

     

       313
       330
        
               (* Percent-encoded character *)

     

       314
       331
        
               ignore (Input.next t.input);

     

       315
       315
       -
               (match Input.peek t.input, Input.peek_nth t.input 1 with

     

       316
       316
       -
                | Some c1, Some c2 when is_hex_digit c1 && is_hex_digit c2 ->

     

       317
       317
       -
                    ignore (Input.next t.input);

     

       318
       318
       -
                    ignore (Input.next t.input);

     

       319
       319
       -
                    let code = (hex_val c1) * 16 + (hex_val c2) in

     

       320
       320
       -
                    Buffer.add_char buf (Char.chr code);

     

       321
       321
       -
                    true

     

       322
       322
       -
                | _ ->

     

       323
       323
       -
                    (* Invalid percent encoding - keep the % *)

     

       324
       324
       -
                    Buffer.add_char buf '%';

     

       325
       325
       -
                    true)

     

       326
       326
       -
           | Some c when not (Input.is_whitespace c) &&

     

       327
       327
       -
                         not (Input.is_flow_indicator c) ->

     

       332
       332
       +
               match (Input.peek t.input, Input.peek_nth t.input 1) with

     

       333
       333
       +
               | Some c1, Some c2 when is_hex_digit c1 && is_hex_digit c2 ->

     

       334
       334
       +
                   ignore (Input.next t.input);

     

       335
       335
       +
                   ignore (Input.next t.input);

     

       336
       336
       +
                   let code = (hex_val c1 * 16) + hex_val c2 in

     

       337
       337
       +
                   Buffer.add_char buf (Char.chr code);

     

       338
       338
       +
                   true

     

       339
       339
       +
               | _ ->

     

       340
       340
       +
                   (* Invalid percent encoding - keep the % *)

     

       341
       341
       +
                   Buffer.add_char buf '%';

     

       342
       342
       +
                   true)

     

       343
       343
       +
           | Some c

     

       344
       344
       +
             when (not (Input.is_whitespace c)) && not (Input.is_flow_indicator c) ->

     

       328
       345
        
               Buffer.add_char buf c;

     

       329
       346
        
               ignore (Input.next t.input);

     

       330
       347
        
               true

     

       331
       348
        
           | _ -> false

     

       332
       332
       -
         do () done;

     

       349
       349
       +
         do

     

       350
       350
       +
           ()

     

       351
       351
       +
         done;

     

       333
       352
        
         Buffer.contents buf

     

       334
       353
        
       

     

       335
       354
        
       (** Scan a tag *)

     

       336
       355
        
       let scan_tag t =

     

       337
       356
        
         let start = Input.mark t.input in

     

       338
       338
       -
         ignore (Input.next t.input); (* consume ! *)

     

       357
       357
       +
         ignore (Input.next t.input);

     

       358
       358
       +
         (* consume ! *)

     

       339
       359
        
         let handle, suffix =

     

       340
       360
        
           match Input.peek t.input with

     

       341
       361
        
           | Some '<' ->

     
···

       349
       369
        
                     Buffer.add_char buf c;

     

       350
       370
        
                     ignore (Input.next t.input);

     

       351
       371
        
                     true

     

       352
       352
       -
                 | None -> Error.raise_at (Input.mark t.input) (Invalid_tag "unclosed verbatim tag")

     

       353
       353
       -
               do () done;

     

       354
       354
       -
               ignore (Input.next t.input); (* consume > *)

     

       372
       372
       +
                 | None ->

     

       373
       373
       +
                     Error.raise_at (Input.mark t.input)

     

       374
       374
       +
                       (Invalid_tag "unclosed verbatim tag")

     

       375
       375
       +
               do

     

       376
       376
       +
                 ()

     

       377
       377
       +
               done;

     

       378
       378
       +
               ignore (Input.next t.input);

     

       379
       379
       +
               (* consume > *)

     

       355
       380
        
               ("", Buffer.contents buf)

     

       356
       381
        
           | Some c when Input.is_whitespace c || Input.is_flow_indicator c ->

     

       357
       382
        
               (* Non-specific tag: ! *)

     

       358
       383
        
               ("!", "")

     

       359
       384
        
           | Some '!' ->

     

       360
       385
        
               (* Secondary handle: !! *)

     

       361
       361
       -
               ignore (Input.next t.input); (* consume second ! *)

     

       386
       386
       +
               ignore (Input.next t.input);

     

       387
       387
       +
               (* consume second ! *)

     

       362
       388
        
               let suffix = scan_tag_suffix t in

     

       363
       389
        
               ("!!", suffix)

     

       364
       364
       -
           | _ ->

     

       390
       390
       +
           | _ -> (

     

       365
       391
        
               (* Primary handle or just suffix: !foo or !e!foo *)

     

       366
       392
        
               (* Read alphanumeric characters *)

     

       367
       393
        
               let buf = Buffer.create 16 in

     
···

       372
       398
        
                     ignore (Input.next t.input);

     

       373
       399
        
                     true

     

       374
       400
        
                 | _ -> false

     

       375
       375
       -
               do () done;

     

       401
       401
       +
               do

     

       402
       402
       +
                 ()

     

       403
       403
       +
               done;

     

       376
       404
        
               (* Check if next character is ! - if so, this is a named handle *)

     

       377
       377
       -
               (match Input.peek t.input with

     

       378
       378
       -
                | Some '!' ->

     

       379
       379
       -
                    (* Named handle like !e! *)

     

       380
       380
       -
                    ignore (Input.next t.input);

     

       381
       381
       -
                    let handle_name = Buffer.contents buf in

     

       382
       382
       -
                    let suffix = scan_tag_suffix t in

     

       383
       383
       -
                    ("!" ^ handle_name ^ "!", suffix)

     

       384
       384
       -
                | _ ->

     

       385
       385
       -
                    (* Just ! followed by suffix *)

     

       386
       386
       -
                    ("!", Buffer.contents buf ^ scan_tag_suffix t))

     

       405
       405
       +
               match Input.peek t.input with

     

       406
       406
       +
               | Some '!' ->

     

       407
       407
       +
                   (* Named handle like !e! *)

     

       408
       408
       +
                   ignore (Input.next t.input);

     

       409
       409
       +
                   let handle_name = Buffer.contents buf in

     

       410
       410
       +
                   let suffix = scan_tag_suffix t in

     

       411
       411
       +
                   ("!" ^ handle_name ^ "!", suffix)

     

       412
       412
       +
               | _ ->

     

       413
       413
       +
                   (* Just ! followed by suffix *)

     

       414
       414
       +
                   ("!", Buffer.contents buf ^ scan_tag_suffix t))

     

       387
       415
        
         in

     

       388
       416
        
         (* Validate that tag is followed by whitespace, break, or (in flow) flow indicator *)

     

       389
       417
        
         (match Input.peek t.input with

     

       390
       390
       -
          | None -> ()  (* EOF is ok *)

     

       391
       391
       -
          | Some c when Input.is_whitespace c || Input.is_break c -> ()

     

       392
       392
       -
          | Some c when t.flow_level > 0 && Input.is_flow_indicator c -> ()

     

       393
       393
       -
          | _ -> Error.raise_at start (Invalid_tag "expected whitespace or line break after tag"));

     

       418
       418
       +
         | None -> () (* EOF is ok *)

     

       419
       419
       +
         | Some c when Input.is_whitespace c || Input.is_break c -> ()

     

       420
       420
       +
         | Some c when t.flow_level > 0 && Input.is_flow_indicator c -> ()

     

       421
       421
       +
         | _ ->

     

       422
       422
       +
             Error.raise_at start

     

       423
       423
       +
               (Invalid_tag "expected whitespace or line break after tag"));

     

       394
       424
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       395
       425
        
         (handle, suffix, span)

     

       396
       426
        
       

     

       397
       427
        
       (** Scan single-quoted scalar *)

     

       398
       428
        
       let scan_single_quoted t =

     

       399
       429
        
         let start = Input.mark t.input in

     

       400
       400
       -
         ignore (Input.next t.input); (* consume opening single-quote *)

     

       430
       430
       +
         ignore (Input.next t.input);

     

       431
       431
       +
         (* consume opening single-quote *)

     

       401
       432
        
         let buf = Buffer.create 64 in

     

       402
       402
       -
         let whitespace = Buffer.create 16 in (* Track trailing whitespace *)

     

       433
       433
       +
         let whitespace = Buffer.create 16 in

     

       434
       434
       +
         (* Track trailing whitespace *)

     

       403
       435
        
       

     

       404
       436
        
         let flush_whitespace () =

     

       405
       437
        
           if Buffer.length whitespace > 0 then begin

     
···

       411
       443
        
         let rec loop () =

     

       412
       444
        
           match Input.peek t.input with

     

       413
       445
        
           | None -> Error.raise_at start Unclosed_single_quote

     

       414
       414
       -
           | Some '\'' ->

     

       446
       446
       +
           | Some '\'' -> (

     

       415
       447
        
               ignore (Input.next t.input);

     

       416
       448
        
               (* Check for escaped quote ('') *)

     

       417
       417
       -
               (match Input.peek t.input with

     

       418
       418
       -
                | Some '\'' ->

     

       419
       419
       -
                    flush_whitespace ();

     

       420
       420
       -
                    Buffer.add_char buf '\'';

     

       421
       421
       -
                    ignore (Input.next t.input);

     

       422
       422
       -
                    loop ()

     

       423
       423
       -
                | _ ->

     

       424
       424
       -
                    (* End of string - flush any trailing whitespace *)

     

       425
       425
       -
                    flush_whitespace ())

     

       449
       449
       +
               match Input.peek t.input with

     

       450
       450
       +
               | Some '\'' ->

     

       451
       451
       +
                   flush_whitespace ();

     

       452
       452
       +
                   Buffer.add_char buf '\'';

     

       453
       453
       +
                   ignore (Input.next t.input);

     

       454
       454
       +
                   loop ()

     

       455
       455
       +
               | _ ->

     

       456
       456
       +
                   (* End of string - flush any trailing whitespace *)

     

       457
       457
       +
                   flush_whitespace ())

     

       426
       458
        
           | Some ' ' | Some '\t' ->

     

       427
       459
        
               (* Track whitespace - don't add to buf yet *)

     

       428
       460
        
               Buffer.add_char whitespace (Option.get (Input.peek t.input));

     
···

       442
       474
        
               (* Check indentation: continuation must be > block indent (QB6E, DK95) *)

     

       443
       475
        
               let col = column t in

     

       444
       476
        
               let indent = current_indent t in

     

       445
       445
       -
               if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then

     

       446
       446
       -
                 Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar");

     

       477
       477
       +
               if

     

       478
       478
       +
                 (not (Input.is_eof t.input))

     

       479
       479
       +
                 && (not (Input.next_is_break t.input))

     

       480
       480
       +
                 && col <= indent && indent >= 0

     

       481
       481
       +
               then

     

       482
       482
       +
                 Error.raise_at (Input.mark t.input)

     

       483
       483
       +
                   (Invalid_quoted_scalar_indentation

     

       484
       484
       +
                      "invalid indentation in quoted scalar");

     

       447
       485
        
               (* Count empty lines (consecutive line breaks) *)

     

       448
       486
        
               let empty_lines = ref 0 in

     

       449
       487
        
               while Input.next_is_break t.input do

     
···

       457
       495
        
                 (* Check indentation after each empty line too *)

     

       458
       496
        
                 let col = column t in

     

       459
       497
        
                 let indent = current_indent t in

     

       460
       460
       -
                 if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then

     

       461
       461
       -
                   Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar")

     

       498
       498
       +
                 if

     

       499
       499
       +
                   (not (Input.is_eof t.input))

     

       500
       500
       +
                   && (not (Input.next_is_break t.input))

     

       501
       501
       +
                   && col <= indent && indent >= 0

     

       502
       502
       +
                 then

     

       503
       503
       +
                   Error.raise_at (Input.mark t.input)

     

       504
       504
       +
                     (Invalid_quoted_scalar_indentation

     

       505
       505
       +
                        "invalid indentation in quoted scalar")

     

       462
       506
        
               done;

     

       463
       507
        
               (* Apply folding rules *)

     

       464
       508
        
               if !empty_lines > 0 then begin

     
···

       466
       510
        
                 for _ = 1 to !empty_lines do

     

       467
       511
        
                   Buffer.add_char buf '\n'

     

       468
       512
        
                 done

     

       469
       469
       -
               end else

     

       513
       513
       +
               end

     

       514
       514
       +
               else

     

       470
       515
        
                 (* Single break: fold to space (even at start of string) *)

     

       471
       516
        
                 Buffer.add_char buf ' ';

     

       472
       517
        
               loop ()

     
···

       489
       534
        
           | Some c when Input.is_hex c ->

     

       490
       535
        
               Buffer.add_char buf c;

     

       491
       536
        
               ignore (Input.next t.input)

     

       492
       492
       -
           | _ ->

     

       493
       493
       -
               Error.raise_at start (Invalid_hex_escape (Buffer.contents buf))

     

       537
       537
       +
           | _ -> Error.raise_at start (Invalid_hex_escape (Buffer.contents buf))

     

       494
       538
        
         done;

     

       495
       539
        
         let code = int_of_string ("0x" ^ Buffer.contents buf) in

     

       496
       496
       -
         if code <= 0x7F then

     

       497
       497
       -
           String.make 1 (Char.chr code)

     

       540
       540
       +
         if code <= 0x7F then String.make 1 (Char.chr code)

     

       498
       541
        
         else if code <= 0x7FF then

     

       499
       542
        
           let b1 = 0xC0 lor (code lsr 6) in

     

       500
       543
        
           let b2 = 0x80 lor (code land 0x3F) in

     
···

       503
       546
        
           let b1 = 0xE0 lor (code lsr 12) in

     

       504
       547
        
           let b2 = 0x80 lor ((code lsr 6) land 0x3F) in

     

       505
       548
        
           let b3 = 0x80 lor (code land 0x3F) in

     

       506
       506
       -
           String.init 3 (fun i -> Char.chr (match i with 0 -> b1 | 1 -> b2 | _ -> b3))

     

       549
       549
       +
           String.init 3 (fun i ->

     

       550
       550
       +
               Char.chr (match i with 0 -> b1 | 1 -> b2 | _ -> b3))

     

       507
       551
        
         else

     

       508
       552
        
           let b1 = 0xF0 lor (code lsr 18) in

     

       509
       553
        
           let b2 = 0x80 lor ((code lsr 12) land 0x3F) in

     

       510
       554
        
           let b3 = 0x80 lor ((code lsr 6) land 0x3F) in

     

       511
       555
        
           let b4 = 0x80 lor (code land 0x3F) in

     

       512
       512
       -
           String.init 4 (fun i -> Char.chr (match i with 0 -> b1 | 1 -> b2 | 2 -> b3 | _ -> b4))

     

       556
       556
       +
           String.init 4 (fun i ->

     

       557
       557
       +
               Char.chr (match i with 0 -> b1 | 1 -> b2 | 2 -> b3 | _ -> b4))

     

       513
       558
        
       

     

       514
       559
        
       (** Scan double-quoted scalar *)

     

       515
       560
        
       let scan_double_quoted t =

     

       516
       561
        
         let start = Input.mark t.input in

     

       517
       517
       -
         ignore (Input.next t.input); (* consume opening double-quote *)

     

       562
       562
       +
         ignore (Input.next t.input);

     

       563
       563
       +
         (* consume opening double-quote *)

     

       518
       564
        
         let buf = Buffer.create 64 in

     

       519
       519
       -
         let whitespace = Buffer.create 16 in  (* Track pending whitespace *)

     

       565
       565
       +
         let whitespace = Buffer.create 16 in

     

       566
       566
       +
         (* Track pending whitespace *)

     

       520
       567
        
       

     

       521
       568
        
         let flush_whitespace () =

     

       522
       569
        
           if Buffer.length whitespace > 0 then begin

     
···

       532
       579
        
               (* Flush trailing whitespace before closing quote to preserve it *)

     

       533
       580
        
               flush_whitespace ();

     

       534
       581
        
               ignore (Input.next t.input)

     

       535
       535
       -
           | Some ' ' | Some '\t' as c_opt ->

     

       582
       582
       +
           | (Some ' ' | Some '\t') as c_opt ->

     

       536
       583
        
               (* Track whitespace - don't add to buf yet *)

     

       537
       584
        
               let c = match c_opt with Some c -> c | None -> assert false in

     

       538
       585
        
               Buffer.add_char whitespace c;

     
···

       540
       587
        
               loop ()

     

       541
       588
        
           | Some '\\' ->

     

       542
       589
        
               (* Escape sequence - this is non-whitespace content *)

     

       543
       543
       -
               flush_whitespace ();  (* Commit any pending whitespace *)

     

       590
       590
       +
               flush_whitespace ();

     

       591
       591
       +
               (* Commit any pending whitespace *)

     

       544
       592
        
               ignore (Input.next t.input);

     

       545
       593
        
               (match Input.peek t.input with

     

       546
       546
       -
                | None -> Error.raise_at start (Invalid_escape_sequence "\\<EOF>")

     

       547
       547
       -
                | Some '0' -> Buffer.add_char buf '\x00'; ignore (Input.next t.input)

     

       548
       548
       -
                | Some 'a' -> Buffer.add_char buf '\x07'; ignore (Input.next t.input)

     

       549
       549
       -
                | Some 'b' -> Buffer.add_char buf '\x08'; ignore (Input.next t.input)

     

       550
       550
       -
                | Some 't' | Some '\t' -> Buffer.add_char buf '\t'; ignore (Input.next t.input)

     

       551
       551
       -
                | Some 'n' -> Buffer.add_char buf '\n'; ignore (Input.next t.input)

     

       552
       552
       -
                | Some 'v' -> Buffer.add_char buf '\x0B'; ignore (Input.next t.input)

     

       553
       553
       -
                | Some 'f' -> Buffer.add_char buf '\x0C'; ignore (Input.next t.input)

     

       554
       554
       -
                | Some 'r' -> Buffer.add_char buf '\r'; ignore (Input.next t.input)

     

       555
       555
       -
                | Some 'e' -> Buffer.add_char buf '\x1B'; ignore (Input.next t.input)

     

       556
       556
       -
                | Some ' ' -> Buffer.add_char buf ' '; ignore (Input.next t.input)

     

       557
       557
       -
                | Some '"' -> Buffer.add_char buf '"'; ignore (Input.next t.input)

     

       558
       558
       -
                | Some '/' -> Buffer.add_char buf '/'; ignore (Input.next t.input)

     

       559
       559
       -
                | Some '\\' -> Buffer.add_char buf '\\'; ignore (Input.next t.input)

     

       560
       560
       -
                | Some 'N' -> Buffer.add_string buf "\xC2\x85"; ignore (Input.next t.input) (* NEL *)

     

       561
       561
       -
                | Some '_' -> Buffer.add_string buf "\xC2\xA0"; ignore (Input.next t.input) (* NBSP *)

     

       562
       562
       -
                | Some 'L' -> Buffer.add_string buf "\xE2\x80\xA8"; ignore (Input.next t.input) (* LS *)

     

       563
       563
       -
                | Some 'P' -> Buffer.add_string buf "\xE2\x80\xA9"; ignore (Input.next t.input) (* PS *)

     

       564
       564
       -
                | Some 'x' ->

     

       565
       565
       -
                    ignore (Input.next t.input);

     

       566
       566
       -
                    Buffer.add_string buf (decode_hex t 2)

     

       567
       567
       -
                | Some 'u' ->

     

       568
       568
       -
                    ignore (Input.next t.input);

     

       569
       569
       -
                    Buffer.add_string buf (decode_hex t 4)

     

       570
       570
       -
                | Some 'U' ->

     

       571
       571
       -
                    ignore (Input.next t.input);

     

       572
       572
       -
                    Buffer.add_string buf (decode_hex t 8)

     

       573
       573
       -
                | Some '\n' | Some '\r' ->

     

       574
       574
       -
                    (* Line continuation escape *)

     

       575
       575
       -
                    Input.consume_break t.input;

     

       576
       576
       -
                    while Input.next_is_blank t.input do

     

       577
       577
       -
                      ignore (Input.next t.input)

     

       578
       578
       -
                    done

     

       579
       579
       -
                | Some c ->

     

       580
       580
       -
                    Error.raise_at (Input.mark t.input)

     

       581
       581
       -
                      (Invalid_escape_sequence (Printf.sprintf "\\%c" c)));

     

       594
       594
       +
               | None -> Error.raise_at start (Invalid_escape_sequence "\\<EOF>")

     

       595
       595
       +
               | Some '0' ->

     

       596
       596
       +
                   Buffer.add_char buf '\x00';

     

       597
       597
       +
                   ignore (Input.next t.input)

     

       598
       598
       +
               | Some 'a' ->

     

       599
       599
       +
                   Buffer.add_char buf '\x07';

     

       600
       600
       +
                   ignore (Input.next t.input)

     

       601
       601
       +
               | Some 'b' ->

     

       602
       602
       +
                   Buffer.add_char buf '\x08';

     

       603
       603
       +
                   ignore (Input.next t.input)

     

       604
       604
       +
               | Some 't' | Some '\t' ->

     

       605
       605
       +
                   Buffer.add_char buf '\t';

     

       606
       606
       +
                   ignore (Input.next t.input)

     

       607
       607
       +
               | Some 'n' ->

     

       608
       608
       +
                   Buffer.add_char buf '\n';

     

       609
       609
       +
                   ignore (Input.next t.input)

     

       610
       610
       +
               | Some 'v' ->

     

       611
       611
       +
                   Buffer.add_char buf '\x0B';

     

       612
       612
       +
                   ignore (Input.next t.input)

     

       613
       613
       +
               | Some 'f' ->

     

       614
       614
       +
                   Buffer.add_char buf '\x0C';

     

       615
       615
       +
                   ignore (Input.next t.input)

     

       616
       616
       +
               | Some 'r' ->

     

       617
       617
       +
                   Buffer.add_char buf '\r';

     

       618
       618
       +
                   ignore (Input.next t.input)

     

       619
       619
       +
               | Some 'e' ->

     

       620
       620
       +
                   Buffer.add_char buf '\x1B';

     

       621
       621
       +
                   ignore (Input.next t.input)

     

       622
       622
       +
               | Some ' ' ->

     

       623
       623
       +
                   Buffer.add_char buf ' ';

     

       624
       624
       +
                   ignore (Input.next t.input)

     

       625
       625
       +
               | Some '"' ->

     

       626
       626
       +
                   Buffer.add_char buf '"';

     

       627
       627
       +
                   ignore (Input.next t.input)

     

       628
       628
       +
               | Some '/' ->

     

       629
       629
       +
                   Buffer.add_char buf '/';

     

       630
       630
       +
                   ignore (Input.next t.input)

     

       631
       631
       +
               | Some '\\' ->

     

       632
       632
       +
                   Buffer.add_char buf '\\';

     

       633
       633
       +
                   ignore (Input.next t.input)

     

       634
       634
       +
               | Some 'N' ->

     

       635
       635
       +
                   Buffer.add_string buf "\xC2\x85";

     

       636
       636
       +
                   ignore (Input.next t.input) (* NEL *)

     

       637
       637
       +
               | Some '_' ->

     

       638
       638
       +
                   Buffer.add_string buf "\xC2\xA0";

     

       639
       639
       +
                   ignore (Input.next t.input) (* NBSP *)

     

       640
       640
       +
               | Some 'L' ->

     

       641
       641
       +
                   Buffer.add_string buf "\xE2\x80\xA8";

     

       642
       642
       +
                   ignore (Input.next t.input) (* LS *)

     

       643
       643
       +
               | Some 'P' ->

     

       644
       644
       +
                   Buffer.add_string buf "\xE2\x80\xA9";

     

       645
       645
       +
                   ignore (Input.next t.input) (* PS *)

     

       646
       646
       +
               | Some 'x' ->

     

       647
       647
       +
                   ignore (Input.next t.input);

     

       648
       648
       +
                   Buffer.add_string buf (decode_hex t 2)

     

       649
       649
       +
               | Some 'u' ->

     

       650
       650
       +
                   ignore (Input.next t.input);

     

       651
       651
       +
                   Buffer.add_string buf (decode_hex t 4)

     

       652
       652
       +
               | Some 'U' ->

     

       653
       653
       +
                   ignore (Input.next t.input);

     

       654
       654
       +
                   Buffer.add_string buf (decode_hex t 8)

     

       655
       655
       +
               | Some '\n' | Some '\r' ->

     

       656
       656
       +
                   (* Line continuation escape *)

     

       657
       657
       +
                   Input.consume_break t.input;

     

       658
       658
       +
                   while Input.next_is_blank t.input do

     

       659
       659
       +
                     ignore (Input.next t.input)

     

       660
       660
       +
                   done

     

       661
       661
       +
               | Some c ->

     

       662
       662
       +
                   Error.raise_at (Input.mark t.input)

     

       663
       663
       +
                     (Invalid_escape_sequence (Printf.sprintf "\\%c" c)));

     

       582
       664
        
               loop ()

     

       583
       665
        
           | Some '\n' | Some '\r' ->

     

       584
       666
        
               (* Line break: discard any pending trailing whitespace *)

     
···

       599
       681
        
                 if Input.next_is_break t.input then begin

     

       600
       682
        
                   Input.consume_break t.input;

     

       601
       683
        
                   incr empty_lines;

     

       602
       602
       -
                   started_with_tab := false  (* Reset for next line *)

     

       603
       603
       -
                 end else

     

       604
       604
       -
                   continue := false

     

       684
       684
       +
                   started_with_tab := false (* Reset for next line *)

     

       685
       685
       +
                 end

     

       686
       686
       +
                 else continue := false

     

       605
       687
        
               done;

     

       606
       688
        
               (* Check for document boundary - this terminates the quoted string *)

     

       607
       689
        
               if Input.at_document_boundary t.input then

     
···

       612
       694
        
               let indent = current_indent t in

     

       613
       695
        
               let start_col = start.column in

     

       614
       696
        
               (* DK95/01: if continuation started with tabs and column < start column, error *)

     

       615
       615
       -
               if not (Input.is_eof t.input) && !started_with_tab && col < start_col then

     

       616
       616
       -
                 Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar");

     

       617
       617
       -
               if not (Input.is_eof t.input) && col <= indent && indent >= 0 then

     

       618
       618
       -
                 Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar");

     

       697
       697
       +
               if (not (Input.is_eof t.input)) && !started_with_tab && col < start_col

     

       698
       698
       +
               then

     

       699
       699
       +
                 Error.raise_at (Input.mark t.input)

     

       700
       700
       +
                   (Invalid_quoted_scalar_indentation

     

       701
       701
       +
                      "invalid indentation in quoted scalar");

     

       702
       702
       +
               if (not (Input.is_eof t.input)) && col <= indent && indent >= 0 then

     

       703
       703
       +
                 Error.raise_at (Input.mark t.input)

     

       704
       704
       +
                   (Invalid_quoted_scalar_indentation

     

       705
       705
       +
                      "invalid indentation in quoted scalar");

     

       619
       706
        
               (* Per YAML spec: single break = space, break + empty lines = newlines *)

     

       620
       707
        
               if !empty_lines > 0 then begin

     

       621
       708
        
                 (* Empty lines: output N newlines where N = number of empty lines *)

     

       622
       709
        
                 for _ = 1 to !empty_lines do

     

       623
       710
        
                   Buffer.add_char buf '\n'

     

       624
       711
        
                 done

     

       625
       625
       -
               end else

     

       712
       712
       +
               end

     

       713
       713
       +
               else

     

       626
       714
        
                 (* Single break folds to space *)

     

       627
       715
        
                 Buffer.add_char buf ' ';

     

       628
       716
        
               loop ()

     

       629
       717
        
           | Some c ->

     

       630
       718
        
               (* Non-whitespace character *)

     

       631
       631
       -
               flush_whitespace ();  (* Commit any pending whitespace *)

     

       719
       719
       +
               flush_whitespace ();

     

       720
       720
       +
               (* Commit any pending whitespace *)

     

       632
       721
        
               Buffer.add_char buf c;

     

       633
       722
        
               ignore (Input.next t.input);

     

       634
       723
        
               loop ()

     
···

       640
       729
        
       (** Check if character can appear in plain scalar at this position *)

     

       641
       730
        
       let can_continue_plain t c ~in_flow =

     

       642
       731
        
         match c with

     

       643
       643
       -
         | ':' ->

     

       732
       732
       +
         | ':' -> (

     

       644
       733
        
             (* : is OK if not followed by whitespace or flow indicator *)

     

       645
       645
       -
             (match Input.peek_nth t.input 1 with

     

       646
       646
       -
              | None -> true

     

       647
       647
       -
              | Some c2 when Input.is_whitespace c2 -> false

     

       648
       648
       -
              | Some c2 when in_flow && Input.is_flow_indicator c2 -> false

     

       649
       649
       -
              | _ -> true)

     

       650
       650
       -
         | '#' ->

     

       734
       734
       +
             match Input.peek_nth t.input 1 with

     

       735
       735
       +
             | None -> true

     

       736
       736
       +
             | Some c2 when Input.is_whitespace c2 -> false

     

       737
       737
       +
             | Some c2 when in_flow && Input.is_flow_indicator c2 -> false

     

       738
       738
       +
             | _ -> true)

     

       739
       739
       +
         | '#' -> (

     

       651
       740
        
             (* # is a comment indicator only if preceded by whitespace *)

     

       652
       741
        
             (* Check the previous character to determine if this is a comment *)

     

       653
       653
       -
             (match Input.peek_back t.input with

     

       654
       654
       -
              | None -> true  (* At start - can't be comment indicator, allow it *)

     

       655
       655
       -
              | Some c when Input.is_whitespace c -> false  (* Preceded by whitespace - comment *)

     

       656
       656
       -
              | Some c when Input.is_break c -> false  (* At start of line - comment *)

     

       657
       657
       -
              | _ -> true)  (* Not preceded by whitespace - part of scalar *)

     

       742
       742
       +
             match Input.peek_back t.input with

     

       743
       743
       +
             | None -> true (* At start - can't be comment indicator, allow it *)

     

       744
       744
       +
             | Some c when Input.is_whitespace c ->

     

       745
       745
       +
                 false (* Preceded by whitespace - comment *)

     

       746
       746
       +
             | Some c when Input.is_break c -> false (* At start of line - comment *)

     

       747
       747
       +
             | _ -> true (* Not preceded by whitespace - part of scalar *))

     

       658
       748
        
         | c when in_flow && Input.is_flow_indicator c -> false

     

       659
       749
        
         | _ when Input.is_break c -> false

     

       660
       750
        
         | _ -> true

     
···

       666
       756
        
         let indent = current_indent t in

     

       667
       757
        
         (* In flow context, scalars must be indented more than the current block indent.

     

       668
       758
        
            This ensures that content at block indent or less ends the flow context. *)

     

       669
       669
       -
         if in_flow && (column t - 1) < indent then

     

       759
       759
       +
         if in_flow && column t - 1 < indent then

     

       670
       760
        
           Error.raise_at start Invalid_flow_indentation;

     

       671
       761
        
         let buf = Buffer.create 64 in

     

       672
       762
        
         let spaces = Buffer.create 16 in

     

       673
       673
       -
         let whitespace = Buffer.create 16 in  (* Track whitespace within a line *)

     

       763
       763
       +
         let whitespace = Buffer.create 16 in

     

       764
       764
       +
         (* Track whitespace within a line *)

     

       674
       765
        
         let leading_blanks = ref false in

     

       675
       766
        
       

     

       676
       767
        
         let rec scan_line () =

     
···

       687
       778
        
                 if Buffer.length spaces > 0 then begin

     

       688
       779
        
                   if !leading_blanks then begin

     

       689
       780
        
                     (* Fold line break *)

     

       690
       690
       -
                     if Buffer.contents spaces = "\n" then

     

       691
       691
       -
                       Buffer.add_char buf ' '

     

       781
       781
       +
                     if Buffer.contents spaces = "\n" then Buffer.add_char buf ' '

     

       692
       782
        
                     else begin

     

       693
       783
        
                       (* Multiple breaks - preserve all but first *)

     

       694
       784
        
                       let s = Buffer.contents spaces in

     

       695
       785
        
                       Buffer.add_substring buf s 1 (String.length s - 1)

     

       696
       786
        
                     end

     

       697
       697
       -
                   end else

     

       698
       698
       -
                     Buffer.add_buffer buf spaces;

     

       787
       787
       +
                   end

     

       788
       788
       +
                   else Buffer.add_buffer buf spaces;

     

       699
       789
        
                   Buffer.clear spaces

     

       700
       790
        
                 end;

     

       701
       791
        
                 (* Add any pending whitespace from within the line *)

     
···

       722
       812
        
             if !leading_blanks then begin

     

       723
       813
        
               (* We already had a break - this is an additional break (empty line) *)

     

       724
       814
        
               Buffer.add_char spaces '\n'

     

       725
       725
       -
             end else begin

     

       815
       815
       +
             end

     

       816
       816
       +
             else begin

     

       726
       817
        
               (* First line break *)

     

       727
       818
        
               Buffer.clear spaces;

     

       728
       819
        
               Buffer.add_char spaces '\n';

     
···

       742
       833
        
             (* However, allow empty lines (line breaks) to continue even if dedented *)

     

       743
       834
        
             if Input.next_is_break t.input then

     

       744
       835
        
               scan_lines () (* Empty line - continue *)

     

       745
       745
       -
             else if not in_flow && col <= indent then

     

       746
       746
       -
               () (* Stop - dedented or at parent level in block context *)

     

       747
       747
       -
             else if Input.at_document_boundary t.input then

     

       748
       748
       -
               () (* Stop - document boundary *)

     

       749
       749
       -
             else

     

       750
       750
       -
               scan_lines ()

     

       836
       836
       +
             else if (not in_flow) && col <= indent then ()

     

       837
       837
       +
               (* Stop - dedented or at parent level in block context *)

     

       838
       838
       +
             else if Input.at_document_boundary t.input then ()

     

       839
       839
       +
               (* Stop - document boundary *)

     

       840
       840
       +
             else scan_lines ()

     

       751
       841
        
           end

     

       752
       842
        
         in

     

       753
       843
        
       

     
···

       758
       848
        
           let len = String.length value in

     

       759
       849
        
           let rec find_end i =

     

       760
       850
        
             if i < 0 then 0

     

       761
       761
       -
             else match value.[i] with

     

       762
       762
       -
               | ' ' | '\t' -> find_end (i - 1)

     

       763
       763
       -
               | _ -> i + 1

     

       851
       851
       +
             else match value.[i] with ' ' | '\t' -> find_end (i - 1) | _ -> i + 1

     

       764
       852
        
           in

     

       765
       853
        
           let end_pos = find_end (len - 1) in

     

       766
       854
        
           String.sub value 0 end_pos

     
···

       772
       860
        
       (** Scan block scalar (literal | or folded >) *)

     

       773
       861
        
       let scan_block_scalar t literal =

     

       774
       862
        
         let start = Input.mark t.input in

     

       775
       775
       -
         ignore (Input.next t.input); (* consume | or > *)

     

       863
       863
       +
         ignore (Input.next t.input);

     

       864
       864
       +
       

     

       865
       865
       +
         (* consume | or > *)

     

       776
       866
        
       

     

       777
       867
        
         (* Parse header: optional indentation indicator and chomping *)

     

       778
       868
        
         let explicit_indent = ref None in

     
···

       780
       870
        
       

     

       781
       871
        
         (* First character of header *)

     

       782
       872
        
         (match Input.peek t.input with

     

       783
       783
       -
          | Some c when Input.is_digit c && c <> '0' ->

     

       784
       784
       -
              explicit_indent := Some (Char.code c - Char.code '0');

     

       785
       785
       -
              ignore (Input.next t.input)

     

       786
       786
       -
          | Some '-' -> chomping := Chomping.Strip; ignore (Input.next t.input)

     

       787
       787
       -
          | Some '+' -> chomping := Chomping.Keep; ignore (Input.next t.input)

     

       788
       788
       -
          | _ -> ());

     

       873
       873
       +
         | Some c when Input.is_digit c && c <> '0' ->

     

       874
       874
       +
             explicit_indent := Some (Char.code c - Char.code '0');

     

       875
       875
       +
             ignore (Input.next t.input)

     

       876
       876
       +
         | Some '-' ->

     

       877
       877
       +
             chomping := Chomping.Strip;

     

       878
       878
       +
             ignore (Input.next t.input)

     

       879
       879
       +
         | Some '+' ->

     

       880
       880
       +
             chomping := Chomping.Keep;

     

       881
       881
       +
             ignore (Input.next t.input)

     

       882
       882
       +
         | _ -> ());

     

       789
       883
        
       

     

       790
       884
        
         (* Second character of header *)

     

       791
       885
        
         (match Input.peek t.input with

     

       792
       792
       -
          | Some c when Input.is_digit c && c <> '0' && !explicit_indent = None ->

     

       793
       793
       -
              explicit_indent := Some (Char.code c - Char.code '0');

     

       794
       794
       -
              ignore (Input.next t.input)

     

       795
       795
       -
          | Some '-' when !chomping = Chomping.Clip ->

     

       796
       796
       -
              chomping := Chomping.Strip; ignore (Input.next t.input)

     

       797
       797
       -
          | Some '+' when !chomping = Chomping.Clip ->

     

       798
       798
       -
              chomping := Chomping.Keep; ignore (Input.next t.input)

     

       799
       799
       -
          | _ -> ());

     

       886
       886
       +
         | Some c when Input.is_digit c && c <> '0' && !explicit_indent = None ->

     

       887
       887
       +
             explicit_indent := Some (Char.code c - Char.code '0');

     

       888
       888
       +
             ignore (Input.next t.input)

     

       889
       889
       +
         | Some '-' when !chomping = Chomping.Clip ->

     

       890
       890
       +
             chomping := Chomping.Strip;

     

       891
       891
       +
             ignore (Input.next t.input)

     

       892
       892
       +
         | Some '+' when !chomping = Chomping.Clip ->

     

       893
       893
       +
             chomping := Chomping.Keep;

     

       894
       894
       +
             ignore (Input.next t.input)

     

       895
       895
       +
         | _ -> ());

     

       800
       896
        
       

     

       801
       897
        
         (* Skip whitespace and optional comment *)

     

       802
       898
        
         skip_whitespace_and_comment t;

     

       803
       899
        
       

     

       804
       900
        
         (* Consume line break *)

     

       805
       805
       -
         if Input.next_is_break t.input then

     

       806
       806
       -
           Input.consume_break t.input

     

       901
       901
       +
         if Input.next_is_break t.input then Input.consume_break t.input

     

       807
       902
        
         else if not (Input.is_eof t.input) then

     

       808
       903
        
           Error.raise_at (Input.mark t.input)

     

       809
       904
        
             (Invalid_block_scalar_header "expected newline after header");

     
···

       811
       906
        
         let base_indent = current_indent t in

     

       812
       907
        
         (* base_indent is the indent level from the stack, -1 if empty.

     

       813
       908
        
            It's used directly for comparisons in implicit indent case. *)

     

       814
       814
       -
         let content_indent = ref (

     

       815
       815
       -
           match !explicit_indent with

     

       816
       816
       -
           | Some n ->

     

       817
       817
       -
               (* Explicit indent: base_indent is 1-indexed column, convert to 0-indexed.

     

       909
       909
       +
         let content_indent =

     

       910
       910
       +
           ref

     

       911
       911
       +
             (match !explicit_indent with

     

       912
       912
       +
             | Some n ->

     

       913
       913
       +
                 (* Explicit indent: base_indent is 1-indexed column, convert to 0-indexed.

     

       818
       914
        
                  content_indent = (base_indent - 1) + n, but at least n for document level. *)

     

       819
       819
       -
               let base_level = max 0 (base_indent - 1) in

     

       820
       820
       -
               base_level + n

     

       821
       821
       -
           | None -> 0  (* Will be determined by first non-empty line *)

     

       822
       822
       -
         ) in

     

       915
       915
       +
                 let base_level = max 0 (base_indent - 1) in

     

       916
       916
       +
                 base_level + n

     

       917
       917
       +
             | None -> 0 (* Will be determined by first non-empty line *))

     

       918
       918
       +
         in

     

       823
       919
        
       

     

       824
       920
        
         let buf = Buffer.create 256 in

     

       825
       921
        
         let trailing_breaks = Buffer.create 16 in

     

       826
       826
       -
         let leading_blank = ref false in  (* Was the previous line "more indented"? *)

     

       827
       827
       -
         let max_empty_line_indent = ref 0 in  (* Track max indent of empty lines before first content *)

     

       922
       922
       +
         let leading_blank = ref false in

     

       923
       923
       +
         (* Was the previous line "more indented"? *)

     

       924
       924
       +
         let max_empty_line_indent = ref 0 in

     

       925
       925
       +
         (* Track max indent of empty lines before first content *)

     

       828
       926
        
       

     

       829
       927
        
         (* Skip to content indentation, skipping empty lines.

     

       830
       928
        
            Returns the number of spaces actually skipped (important for detecting dedentation). *)

     
···

       832
       930
        
           if !content_indent > 0 then begin

     

       833
       931
        
             (* Explicit indent - skip up to content_indent spaces *)

     

       834
       932
        
             let spaces_skipped = ref 0 in

     

       835
       835
       -
             while !spaces_skipped < !content_indent && Input.next_is (( = ) ' ') t.input do

     

       933
       933
       +
             while

     

       934
       934
       +
               !spaces_skipped < !content_indent && Input.next_is (( = ) ' ') t.input

     

       935
       935
       +
             do

     

       836
       936
        
               incr spaces_skipped;

     

       837
       937
        
               ignore (Input.next t.input)

     

       838
       938
        
             done;

     
···

       843
       943
        
               Buffer.add_char trailing_breaks '\n';

     

       844
       944
        
               Input.consume_break t.input;

     

       845
       945
        
               skip_to_content_indent ()

     

       846
       846
       -
             end else if !spaces_skipped < !content_indent then begin

     

       946
       946
       +
             end

     

       947
       947
       +
             else if !spaces_skipped < !content_indent then begin

     

       847
       948
        
               (* Line starts with fewer spaces than content_indent - dedented *)

     

       848
       949
        
               !spaces_skipped

     

       849
       849
       -
             end else if Input.next_is_blank t.input then begin

     

       950
       950
       +
             end

     

       951
       951
       +
             else if Input.next_is_blank t.input then begin

     

       850
       952
        
               (* Line has spaces/tabs beyond content_indent - could be whitespace content or empty line.

     

       851
       953
        
                  For literal scalars, whitespace-only lines ARE content (not empty).

     

       852
       954
        
                  For folded scalars, whitespace-only lines that are "more indented" are preserved. *)

     
···

       856
       958
        
               else begin

     

       857
       959
        
                 (* Folded: check if rest is only blanks *)

     

       858
       960
        
                 let idx = ref 0 in

     

       859
       859
       -
                 while match Input.peek_nth t.input !idx with

     

       860
       860
       -
                       | Some c when Input.is_blank c -> incr idx; true

     

       861
       861
       -
                       | _ -> false

     

       862
       862
       -
                 do () done;

     

       863
       863
       -
                 match Input.peek_nth t.input (!idx) with

     

       961
       961
       +
                 while

     

       962
       962
       +
                   match Input.peek_nth t.input !idx with

     

       963
       963
       +
                   | Some c when Input.is_blank c ->

     

       964
       964
       +
                       incr idx;

     

       965
       965
       +
                       true

     

       966
       966
       +
                   | _ -> false

     

       967
       967
       +
                 do

     

       968
       968
       +
                   ()

     

       969
       969
       +
                 done;

     

       970
       970
       +
                 match Input.peek_nth t.input !idx with

     

       864
       971
        
                 | None | Some '\n' | Some '\r' ->

     

       865
       972
        
                     (* Empty/whitespace-only line in folded - skip spaces *)

     

       866
       973
        
                     while Input.next_is_blank t.input do

     
···

       873
       980
        
                     (* Has non-whitespace content *)

     

       874
       981
        
                     !content_indent

     

       875
       982
        
               end

     

       876
       876
       -
             end else

     

       877
       877
       -
               !content_indent

     

       878
       878
       -
           end else begin

     

       983
       983
       +
             end

     

       984
       984
       +
             else !content_indent

     

       985
       985
       +
           end

     

       986
       986
       +
           else begin

     

       879
       987
        
             (* Implicit indent - skip empty lines without consuming spaces.

     

       880
       988
        
                Note: Only SPACES count as indentation. Tabs are content, not indentation.

     

       881
       989
        
                So we only check for spaces when determining if a line is "empty". *)

     
···

       883
       991
        
               Buffer.add_char trailing_breaks '\n';

     

       884
       992
        
               Input.consume_break t.input;

     

       885
       993
        
               skip_to_content_indent ()

     

       886
       886
       -
             end else if Input.next_is (( = ) ' ') t.input then begin

     

       994
       994
       +
             end

     

       995
       995
       +
             else if Input.next_is (( = ) ' ') t.input then begin

     

       887
       996
        
               (* Check if line is empty (only spaces before break) *)

     

       888
       997
        
               let idx = ref 0 in

     

       889
       889
       -
               while match Input.peek_nth t.input !idx with

     

       890
       890
       -
                     | Some ' ' -> incr idx; true

     

       891
       891
       -
                     | _ -> false

     

       892
       892
       -
               do () done;

     

       893
       893
       -
               match Input.peek_nth t.input (!idx) with

     

       998
       998
       +
               while

     

       999
       999
       +
                 match Input.peek_nth t.input !idx with

     

       1000
       1000
       +
                 | Some ' ' ->

     

       1001
       1001
       +
                     incr idx;

     

       1002
       1002
       +
                     true

     

       1003
       1003
       +
                 | _ -> false

     

       1004
       1004
       +
               do

     

       1005
       1005
       +
                 ()

     

       1006
       1006
       +
               done;

     

       1007
       1007
       +
               match Input.peek_nth t.input !idx with

     

       894
       1008
        
               | None | Some '\n' | Some '\r' ->

     

       895
       1009
        
                   (* Line has only spaces - empty line *)

     

       896
       1010
        
                   (* Track max indent of empty lines for later validation *)

     

       897
       897
       -
                   if !idx > !max_empty_line_indent then

     

       898
       898
       -
                     max_empty_line_indent := !idx;

     

       1011
       1011
       +
                   if !idx > !max_empty_line_indent then max_empty_line_indent := !idx;

     

       899
       1012
        
                   while Input.next_is (( = ) ' ') t.input do

     

       900
       1013
        
                     ignore (Input.next t.input)

     

       901
       1014
        
                   done;

     
···

       905
       1018
        
               | _ ->

     

       906
       1019
        
                   (* Has content (including tabs which are content, not indentation) *)

     

       907
       1020
        
                   0

     

       908
       908
       -
             end else if Input.next_is (( = ) '\t') t.input then begin

     

       1021
       1021
       +
             end

     

       1022
       1022
       +
             else if Input.next_is (( = ) '\t') t.input then begin

     

       909
       1023
        
               (* Tab at start of line in implicit indent mode - this is an error (Y79Y)

     

       910
       1024
        
                  because tabs cannot be used as indentation in YAML *)

     

       911
       1025
        
               Error.raise_at (Input.mark t.input) Tab_in_indentation

     

       912
       912
       -
             end else

     

       1026
       1026
       +
             end

     

       1027
       1027
       +
             else

     

       913
       1028
        
               (* Not at break or space - other content character *)

     

       914
       1029
        
               0

     

       915
       1030
        
           end

     
···

       941
       1056
        
             let should_process =

     

       942
       1057
        
               if !content_indent = 0 then begin

     

       943
       1058
        
                 (* For implicit indent, content must be more indented than base_level. *)

     

       944
       944
       -
                 if line_indent <= base_level then

     

       945
       945
       -
                   false  (* No content - first line not indented enough *)

     

       1059
       1059
       +
                 if line_indent <= base_level then false

     

       1060
       1060
       +
                   (* No content - first line not indented enough *)

     

       946
       1061
        
                 else begin

     

       947
       1062
        
                   (* Validate: first content line must be indented at least as much as

     

       948
       1063
        
                      the maximum indent seen on empty lines before it (5LLU, S98Z, W9L4) *)

     

       949
       949
       -
                   if line_indent < !max_empty_line_indent && line_indent > base_level then

     

       1064
       1064
       +
                   if line_indent < !max_empty_line_indent && line_indent > base_level

     

       1065
       1065
       +
                   then

     

       950
       1066
        
                     Error.raise_at (Input.mark t.input)

     

       951
       951
       -
                       (Invalid_block_scalar_header "wrongly indented line in block scalar");

     

       1067
       1067
       +
                       (Invalid_block_scalar_header

     

       1068
       1068
       +
                          "wrongly indented line in block scalar");

     

       952
       1069
        
                   content_indent := line_indent;

     

       953
       1070
        
                   true

     

       954
       1071
        
                 end

     

       955
       955
       -
               end else if line_indent < !content_indent then

     

       956
       956
       -
                 false  (* Dedented - done with content *)

     

       957
       957
       -
               else

     

       958
       958
       -
                 true

     

       1072
       1072
       +
               end

     

       1073
       1073
       +
               else if line_indent < !content_indent then false

     

       1074
       1074
       +
                 (* Dedented - done with content *)

     

       1075
       1075
       +
               else true

     

       959
       1076
        
             in

     

       960
       1077
        
       

     

       961
       1078
        
             if should_process then begin

     
···

       963
       1080
        
                  For folded scalars, lines that start with any whitespace (space or tab) after the

     

       964
       1081
        
                  content indentation are "more indented" and preserve breaks.

     

       965
       1082
        
                  Note: we check Input.next_is_blank BEFORE reading content to see if content starts with whitespace. *)

     

       966
       966
       -
               let trailing_blank = line_indent > !content_indent || Input.next_is_blank t.input in

     

       1083
       1083
       +
               let trailing_blank =

     

       1084
       1084
       +
                 line_indent > !content_indent || Input.next_is_blank t.input

     

       1085
       1085
       +
               in

     

       967
       1086
        
       

     

       968
       1087
        
               (* Add trailing breaks to buffer *)

     

       969
       1088
        
               if Buffer.length buf > 0 then begin

     

       970
       1089
        
                 if Buffer.length trailing_breaks > 0 then begin

     

       971
       971
       -
                   if literal then

     

       972
       972
       -
                     Buffer.add_buffer buf trailing_breaks

     

       1090
       1090
       +
                   if literal then Buffer.add_buffer buf trailing_breaks

     

       973
       1091
        
                   else begin

     

       974
       1092
        
                     (* Folded scalar: fold only if both previous and current lines are not more-indented *)

     

       975
       975
       -
                     if not !leading_blank && not trailing_blank then begin

     

       1093
       1093
       +
                     if (not !leading_blank) && not trailing_blank then begin

     

       976
       1094
        
                       let breaks = Buffer.contents trailing_breaks in

     

       977
       977
       -
                       if String.length breaks = 1 then

     

       978
       978
       -
                         Buffer.add_char buf ' '

     

       979
       979
       -
                       else

     

       980
       980
       -
                         Buffer.add_substring buf breaks 1 (String.length breaks - 1)

     

       981
       981
       -
                     end else begin

     

       1095
       1095
       +
                       if String.length breaks = 1 then Buffer.add_char buf ' '

     

       1096
       1096
       +
                       else Buffer.add_substring buf breaks 1 (String.length breaks - 1)

     

       1097
       1097
       +
                     end

     

       1098
       1098
       +
                     else begin

     

       982
       1099
        
                       (* Preserve breaks for more-indented lines *)

     

       983
       1100
        
                       Buffer.add_buffer buf trailing_breaks

     

       984
       1101
        
                     end

     

       985
       1102
        
                   end

     

       986
       986
       -
                 end else if not literal then

     

       987
       987
       -
                   Buffer.add_char buf ' '

     

       988
       988
       -
               end else

     

       989
       989
       -
                 Buffer.add_buffer buf trailing_breaks;

     

       1103
       1103
       +
                 end

     

       1104
       1104
       +
                 else if not literal then Buffer.add_char buf ' '

     

       1105
       1105
       +
               end

     

       1106
       1106
       +
               else Buffer.add_buffer buf trailing_breaks;

     

       990
       1107
        
               Buffer.clear trailing_breaks;

     

       991
       1108
        
       

     

       992
       1109
        
               (* Add extra indentation for literal or more-indented folded lines *)

     

       993
       1110
        
               (* On the first line (when determining content_indent), we've already consumed all spaces,

     

       994
       1111
        
                  so we should NOT add any back. On subsequent lines, we add only the spaces beyond content_indent. *)

     

       995
       995
       -
               if not first_line && (literal || (!extra_spaces > 0 && not literal)) then begin

     

       1112
       1112
       +
               if (not first_line) && (literal || (!extra_spaces > 0 && not literal))

     

       1113
       1113
       +
               then begin

     

       996
       1114
        
                 for _ = 1 to !extra_spaces do

     

       997
       1115
        
                   Buffer.add_char buf ' '

     

       998
       1116
        
                 done

     

       999
       1117
        
               end;

     

       1000
       1118
        
       

     

       1001
       1119
        
               (* Read line content *)

     

       1002
       1002
       -
               while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do

     

       1120
       1120
       +
               while

     

       1121
       1121
       +
                 (not (Input.is_eof t.input)) && not (Input.next_is_break t.input)

     

       1122
       1122
       +
               do

     

       1003
       1123
        
                 Buffer.add_char buf (Input.next_exn t.input)

     

       1004
       1124
        
               done;

     

       1005
       1125
        
       

     
···

       1026
       1146
        
           | Chomping.Strip -> content

     

       1027
       1147
        
           | Chomping.Clip ->

     

       1028
       1148
        
               if String.length content > 0 then content ^ "\n" else content

     

       1029
       1029
       -
           | Chomping.Keep ->

     

       1030
       1030
       -
               content ^ Buffer.contents trailing_breaks

     

       1149
       1149
       +
           | Chomping.Keep -> content ^ Buffer.contents trailing_breaks

     

       1031
       1150
        
         in

     

       1032
       1151
        
       

     

       1033
       1152
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     
···

       1037
       1156
        
       (** Scan directive (after %) *)

     

       1038
       1157
        
       let scan_directive t =

     

       1039
       1158
        
         let start = Input.mark t.input in

     

       1040
       1040
       -
         ignore (Input.next t.input); (* consume % *)

     

       1159
       1159
       +
         ignore (Input.next t.input);

     

       1160
       1160
       +
       

     

       1161
       1161
       +
         (* consume % *)

     

       1041
       1162
        
       

     

       1042
       1163
        
         (* Read directive name *)

     

       1043
       1164
        
         let name_buf = Buffer.create 16 in

     
···

       1048
       1169
        
               ignore (Input.next t.input);

     

       1049
       1170
        
               true

     

       1050
       1171
        
           | _ -> false

     

       1051
       1051
       -
         do () done;

     

       1172
       1172
       +
         do

     

       1173
       1173
       +
           ()

     

       1174
       1174
       +
         done;

     

       1052
       1175
        
         let name = Buffer.contents name_buf in

     

       1053
       1176
        
       

     

       1054
       1177
        
         (* Skip blanks *)

     
···

       1063
       1186
        
             let minor = ref 0 in

     

       1064
       1187
        
             (* Read major version *)

     

       1065
       1188
        
             while Input.next_is_digit t.input do

     

       1066
       1066
       -
               major := !major * 10 + (Char.code (Input.next_exn t.input) - Char.code '0')

     

       1189
       1189
       +
               major :=

     

       1190
       1190
       +
                 (!major * 10) + (Char.code (Input.next_exn t.input) - Char.code '0')

     

       1067
       1191
        
             done;

     

       1068
       1192
        
             (* Expect . *)

     

       1069
       1193
        
             (match Input.peek t.input with

     

       1070
       1070
       -
              | Some '.' -> ignore (Input.next t.input)

     

       1071
       1071
       -
              | _ -> Error.raise_at (Input.mark t.input) (Invalid_yaml_version "expected '.'"));

     

       1194
       1194
       +
             | Some '.' -> ignore (Input.next t.input)

     

       1195
       1195
       +
             | _ ->

     

       1196
       1196
       +
                 Error.raise_at (Input.mark t.input)

     

       1197
       1197
       +
                   (Invalid_yaml_version "expected '.'"));

     

       1072
       1198
        
             (* Read minor version *)

     

       1073
       1199
        
             while Input.next_is_digit t.input do

     

       1074
       1074
       -
               minor := !minor * 10 + (Char.code (Input.next_exn t.input) - Char.code '0')

     

       1200
       1200
       +
               minor :=

     

       1201
       1201
       +
                 (!minor * 10) + (Char.code (Input.next_exn t.input) - Char.code '0')

     

       1075
       1202
        
             done;

     

       1076
       1203
        
             (* Validate: only whitespace and comments allowed before line break (MUS6) *)

     

       1077
       1204
        
             skip_whitespace_and_comment t;

     

       1078
       1078
       -
             if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then

     

       1079
       1079
       -
               Error.raise_at (Input.mark t.input) (Invalid_directive "expected comment or line break after version");

     

       1205
       1205
       +
             if (not (Input.next_is_break t.input)) && not (Input.is_eof t.input) then

     

       1206
       1206
       +
               Error.raise_at (Input.mark t.input)

     

       1207
       1207
       +
                 (Invalid_directive "expected comment or line break after version");

     

       1080
       1208
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1081
       1081
       -
             Token.Version_directive { major = !major; minor = !minor }, span

     

       1082
       1082
       -
       

     

       1209
       1209
       +
             (Token.Version_directive { major = !major; minor = !minor }, span)

     

       1083
       1210
        
         | "TAG" ->

     

       1084
       1211
        
             (* Tag directive: %TAG !foo! tag:example.com,2000: *)

     

       1085
       1212
        
             let handle = scan_tag_handle t in

     
···

       1096
       1223
        
                   ignore (Input.next t.input);

     

       1097
       1224
        
                   true

     

       1098
       1225
        
               | _ -> false

     

       1099
       1099
       -
             do () done;

     

       1226
       1226
       +
             do

     

       1227
       1227
       +
               ()

     

       1228
       1228
       +
             done;

     

       1100
       1229
        
             let prefix = Buffer.contents prefix_buf in

     

       1101
       1230
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1102
       1102
       -
             Token.Tag_directive { handle; prefix }, span

     

       1103
       1103
       -
       

     

       1231
       1231
       +
             (Token.Tag_directive { handle; prefix }, span)

     

       1104
       1232
        
         | _ ->

     

       1105
       1233
        
             (* Reserved/Unknown directive - skip to end of line and ignore *)

     

       1106
       1234
        
             (* Per YAML spec, reserved directives should be ignored with a warning *)

     

       1107
       1107
       -
             while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do

     

       1235
       1235
       +
             while (not (Input.is_eof t.input)) && not (Input.next_is_break t.input) do

     

       1108
       1236
        
               ignore (Input.next t.input)

     

       1109
       1237
        
             done;

     

       1110
       1238
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1111
       1239
        
             (* Return an empty tag directive token to indicate directive was processed but ignored *)

     

       1112
       1112
       -
             Token.Tag_directive { handle = ""; prefix = "" }, span

     

       1240
       1240
       +
             (Token.Tag_directive { handle = ""; prefix = "" }, span)

     

       1113
       1241
        
       

     

       1114
       1242
        
       (** Fetch the next token(s) into the queue *)

     

       1115
       1243
        
       let rec fetch_next_token t =

     
···

       1123
       1251
        
         (* We're about to process actual content, not leading whitespace *)

     

       1124
       1252
        
         t.leading_whitespace <- false;

     

       1125
       1253
        
       

     

       1126
       1126
       -
         if Input.is_eof t.input then

     

       1127
       1127
       -
           fetch_stream_end t

     

       1128
       1128
       -
         else if Input.at_document_boundary t.input then

     

       1129
       1129
       -
           fetch_document_indicator t

     

       1254
       1254
       +
         if Input.is_eof t.input then fetch_stream_end t

     

       1255
       1255
       +
         else if Input.at_document_boundary t.input then fetch_document_indicator t

     

       1130
       1256
        
         else begin

     

       1131
       1257
        
           match Input.peek t.input with

     

       1132
       1258
        
           | None -> fetch_stream_end t

     

       1133
       1133
       -
           | Some '%' when (Input.position t.input).column = 1 ->

     

       1134
       1134
       -
               fetch_directive t

     

       1259
       1259
       +
           | Some '%' when (Input.position t.input).column = 1 -> fetch_directive t

     

       1135
       1260
        
           | Some '[' -> fetch_flow_collection_start t Token.Flow_sequence_start

     

       1136
       1261
        
           | Some '{' -> fetch_flow_collection_start t Token.Flow_mapping_start

     

       1137
       1262
        
           | Some ']' -> fetch_flow_collection_end t Token.Flow_sequence_end

     
···

       1139
       1264
        
           | Some ',' -> fetch_flow_entry t

     

       1140
       1265
        
           | Some '-' when t.flow_level = 0 && check_block_entry t ->

     

       1141
       1266
        
               fetch_block_entry t

     

       1142
       1142
       -
           | Some '?' when check_key t ->

     

       1143
       1143
       -
               fetch_key t

     

       1144
       1144
       -
           | Some ':' when check_value t ->

     

       1145
       1145
       -
               fetch_value t

     

       1267
       1267
       +
           | Some '?' when check_key t -> fetch_key t

     

       1268
       1268
       +
           | Some ':' when check_value t -> fetch_value t

     

       1146
       1269
        
           | Some '*' -> fetch_alias t

     

       1147
       1270
        
           | Some '&' -> fetch_anchor t

     

       1148
       1271
        
           | Some '!' -> fetch_tag t

     
···

       1150
       1273
        
           | Some '>' when t.flow_level = 0 -> fetch_block_scalar t false

     

       1151
       1274
        
           | Some '\'' -> fetch_single_quoted t

     

       1152
       1275
        
           | Some '"' -> fetch_double_quoted t

     

       1153
       1153
       -
           | Some '-' when can_start_plain t ->

     

       1154
       1154
       -
               fetch_plain_scalar t

     

       1155
       1155
       -
           | Some '?' when can_start_plain t ->

     

       1156
       1156
       -
               fetch_plain_scalar t

     

       1157
       1157
       -
           | Some ':' when can_start_plain t ->

     

       1158
       1158
       -
               fetch_plain_scalar t

     

       1159
       1159
       -
           | Some c when can_start_plain_char c t ->

     

       1160
       1160
       -
               fetch_plain_scalar t

     

       1161
       1161
       -
           | Some c ->

     

       1162
       1162
       -
               Error.raise_at (Input.mark t.input) (Unexpected_character c)

     

       1276
       1276
       +
           | Some '-' when can_start_plain t -> fetch_plain_scalar t

     

       1277
       1277
       +
           | Some '?' when can_start_plain t -> fetch_plain_scalar t

     

       1278
       1278
       +
           | Some ':' when can_start_plain t -> fetch_plain_scalar t

     

       1279
       1279
       +
           | Some c when can_start_plain_char c t -> fetch_plain_scalar t

     

       1280
       1280
       +
           | Some c -> Error.raise_at (Input.mark t.input) (Unexpected_character c)

     

       1163
       1281
        
         end

     

       1164
       1282
        
       

     

       1165
       1283
        
       and fetch_stream_end t =

     
···

       1180
       1298
        
         let indicator = Input.peek_string t.input 3 in

     

       1181
       1299
        
         Input.skip t.input 3;

     

       1182
       1300
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1183
       1183
       -
         let token = if indicator = "---" then Token.Document_start else Token.Document_end in

     

       1301
       1301
       +
         let token =

     

       1302
       1302
       +
           if indicator = "---" then Token.Document_start else Token.Document_end

     

       1303
       1303
       +
         in

     

       1184
       1304
        
         (* Reset document content flag after document end marker *)

     

       1185
       1305
        
         if indicator = "..." then begin

     

       1186
       1306
        
           t.document_has_content <- false;

     

       1187
       1307
        
           (* After document end marker, skip whitespace and check for end of line or comment *)

     

       1188
       1188
       -
           while Input.next_is_blank t.input do ignore (Input.next t.input) done;

     

       1189
       1189
       -
           (match Input.peek t.input with

     

       1190
       1190
       -
            | None -> ()  (* EOF is ok *)

     

       1191
       1191
       -
            | Some c when Input.is_break c -> ()

     

       1192
       1192
       -
            | Some '#' -> ()  (* Comment is ok *)

     

       1193
       1193
       -
            | _ -> Error.raise_at start (Invalid_directive "content not allowed after document end marker on same line"))

     

       1308
       1308
       +
           while Input.next_is_blank t.input do

     

       1309
       1309
       +
             ignore (Input.next t.input)

     

       1310
       1310
       +
           done;

     

       1311
       1311
       +
           match Input.peek t.input with

     

       1312
       1312
       +
           | None -> () (* EOF is ok *)

     

       1313
       1313
       +
           | Some c when Input.is_break c -> ()

     

       1314
       1314
       +
           | Some '#' -> () (* Comment is ok *)

     

       1315
       1315
       +
           | _ ->

     

       1316
       1316
       +
               Error.raise_at start

     

       1317
       1317
       +
                 (Invalid_directive

     

       1318
       1318
       +
                    "content not allowed after document end marker on same line")

     

       1194
       1319
        
         end;

     

       1195
       1320
        
         emit t span token

     

       1196
       1321
        
       

     
···

       1201
       1326
        
            If we've emitted content in the current document, we need a document end marker first *)

     

       1202
       1327
        
         if t.document_has_content then

     

       1203
       1328
        
           Error.raise_at (Input.mark t.input)

     

       1204
       1204
       -
             (Unexpected_token "directives must be separated from document content by document end marker (...)");

     

       1329
       1329
       +
             (Unexpected_token

     

       1330
       1330
       +
                "directives must be separated from document content by document end \

     

       1331
       1331
       +
                 marker (...)");

     

       1205
       1332
        
         unroll_indent t (-1);

     

       1206
       1333
        
         remove_simple_key t;

     

       1207
       1334
        
         t.allow_simple_key <- false;

     
···

       1211
       1338
        
       and fetch_flow_collection_start t token_type =

     

       1212
       1339
        
         save_simple_key t;

     

       1213
       1340
        
         (* Record indent of outermost flow collection *)

     

       1214
       1214
       -
         if t.flow_level = 0 then

     

       1215
       1215
       -
           t.flow_indent <- column t;

     

       1341
       1341
       +
         if t.flow_level = 0 then t.flow_indent <- column t;

     

       1216
       1342
        
         t.flow_level <- t.flow_level + 1;

     

       1217
       1343
        
         (* Track whether this is a mapping or sequence *)

     

       1218
       1218
       -
         let is_mapping = (token_type = Token.Flow_mapping_start) in

     

       1344
       1344
       +
         let is_mapping = token_type = Token.Flow_mapping_start in

     

       1219
       1345
        
         t.flow_mapping_stack <- is_mapping :: t.flow_mapping_stack;

     

       1220
       1346
        
         t.allow_simple_key <- true;

     

       1221
       1347
        
         t.simple_keys <- None :: t.simple_keys;

     
···

       1228
       1354
        
       and fetch_flow_collection_end t token_type =

     

       1229
       1355
        
         remove_simple_key t;

     

       1230
       1356
        
         t.flow_level <- t.flow_level - 1;

     

       1231
       1231
       -
         t.flow_mapping_stack <- (match t.flow_mapping_stack with _ :: rest -> rest | [] -> []);

     

       1357
       1357
       +
         t.flow_mapping_stack <-

     

       1358
       1358
       +
           (match t.flow_mapping_stack with _ :: rest -> rest | [] -> []);

     

       1232
       1359
        
         t.simple_keys <- (match t.simple_keys with _ :: rest -> rest | [] -> []);

     

       1233
       1360
        
         t.allow_simple_key <- false;

     

       1234
       1361
        
         let start = Input.mark t.input in

     
···

       1261
       1388
        
           if not t.allow_simple_key then

     

       1262
       1389
        
             Error.raise_at (Input.mark t.input) Block_sequence_disallowed;

     

       1263
       1390
        
           let col = column t in

     

       1264
       1264
       -
           if roll_indent t col ~sequence:true then begin

     

       1391
       1391
       +
           if roll_indent t col then begin

     

       1265
       1392
        
             let span = Span.point (Input.mark t.input) in

     

       1266
       1393
        
             emit t span Token.Block_sequence_start

     

       1267
       1394
        
           end

     
···

       1273
       1400
        
         ignore (Input.next t.input);

     

       1274
       1401
        
       

     

       1275
       1402
        
         (* Check for tabs after - : pattern like -\t- is invalid *)

     

       1276
       1276
       -
         let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in

     

       1403
       1403
       +
         let found_tabs, _found_spaces = skip_blanks_check_tabs t in

     

       1277
       1404
        
         if found_tabs then begin

     

       1278
       1405
        
           (* If we found tabs and next char is - followed by whitespace, error *)

     

       1279
       1406
        
           match Input.peek t.input with

     

       1280
       1280
       -
           | Some '-' ->

     

       1281
       1281
       -
               (match Input.peek_nth t.input 1 with

     

       1282
       1282
       -
                | None -> Error.raise_at start Tab_in_indentation

     

       1283
       1283
       -
                | Some c when Input.is_whitespace c ->

     

       1284
       1284
       -
                    Error.raise_at start Tab_in_indentation

     

       1285
       1285
       -
                | Some _ -> ())

     

       1407
       1407
       +
           | Some '-' -> (

     

       1408
       1408
       +
               match Input.peek_nth t.input 1 with

     

       1409
       1409
       +
               | None -> Error.raise_at start Tab_in_indentation

     

       1410
       1410
       +
               | Some c when Input.is_whitespace c ->

     

       1411
       1411
       +
                   Error.raise_at start Tab_in_indentation

     

       1412
       1412
       +
               | Some _ -> ())

     

       1286
       1413
        
           | _ -> ()

     

       1287
       1414
        
         end;

     

       1288
       1415
        
       

     
···

       1292
       1419
        
       and check_key t =

     

       1293
       1420
        
         (* ? followed by whitespace or flow indicator in both block and flow *)

     

       1294
       1421
        
         match Input.peek_nth t.input 1 with

     

       1295
       1295
       -
           | None -> true

     

       1296
       1296
       -
           | Some c ->

     

       1297
       1297
       -
               Input.is_whitespace c ||

     

       1298
       1298
       -
               (t.flow_level > 0 && Input.is_flow_indicator c)

     

       1422
       1422
       +
         | None -> true

     

       1423
       1423
       +
         | Some c ->

     

       1424
       1424
       +
             Input.is_whitespace c || (t.flow_level > 0 && Input.is_flow_indicator c)

     

       1299
       1425
        
       

     

       1300
       1426
        
       and fetch_key t =

     

       1301
       1427
        
         if t.flow_level = 0 then begin

     

       1302
       1428
        
           if not t.allow_simple_key then

     

       1303
       1429
        
             Error.raise_at (Input.mark t.input) Expected_key;

     

       1304
       1430
        
           let col = column t in

     

       1305
       1305
       -
           if roll_indent t col ~sequence:false then begin

     

       1431
       1431
       +
           if roll_indent t col then begin

     

       1306
       1432
        
             let span = Span.point (Input.mark t.input) in

     

       1307
       1433
        
             emit t span Token.Block_mapping_start

     

       1308
       1434
        
           end

     
···

       1314
       1440
        
         ignore (Input.next t.input);

     

       1315
       1441
        
       

     

       1316
       1442
        
         (* Check for tabs after ? : pattern like ?\t- or ?\tkey is invalid *)

     

       1317
       1317
       -
         let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in

     

       1443
       1443
       +
         let found_tabs, _found_spaces = skip_blanks_check_tabs t in

     

       1318
       1444
        
         if found_tabs && t.flow_level = 0 then begin

     

       1319
       1445
        
           (* In block context, tabs after ? are not allowed *)

     

       1320
       1446
        
           Error.raise_at start Tab_in_indentation

     

       1321
       1447
        
         end;

     

       1322
       1448
        
       

     

       1323
       1449
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1324
       1324
       -
         emit t span Token.Key;

     

       1325
       1325
       -
         t.pending_value <- true  (* We've emitted a KEY, now waiting for VALUE *)

     

       1450
       1450
       +
         emit t span Token.Key

     

       1326
       1451
        
       

     

       1327
       1452
        
       and check_value t =

     

       1328
       1453
        
         (* : followed by whitespace in block, or whitespace/flow indicator in flow, or adjacent value *)

     

       1329
       1454
        
         match Input.peek_nth t.input 1 with

     

       1330
       1455
        
         | None -> true

     

       1331
       1331
       -
         | Some c ->

     

       1332
       1332
       -
             Input.is_whitespace c ||

     

       1333
       1333
       -
             (t.flow_level > 0 && Input.is_flow_indicator c) ||

     

       1456
       1456
       +
         | Some c -> (

     

       1457
       1457
       +
             Input.is_whitespace c

     

       1458
       1458
       +
             || (t.flow_level > 0 && Input.is_flow_indicator c)

     

       1459
       1459
       +
             ||

     

       1334
       1460
        
             (* Allow adjacent values in flow context at designated positions *)

     

       1335
       1335
       -
             (t.flow_level > 0 &&

     

       1336
       1336
       -
              match t.adjacent_value_allowed_at with

     

       1337
       1337
       -
              | Some pos -> pos.Position.line = (Input.position t.input).Position.line &&

     

       1338
       1338
       -
                            pos.Position.column = (Input.position t.input).Position.column

     

       1339
       1339
       -
              | None -> false)

     

       1461
       1461
       +
             t.flow_level > 0

     

       1462
       1462
       +
             &&

     

       1463
       1463
       +
             match t.adjacent_value_allowed_at with

     

       1464
       1464
       +
             | Some pos ->

     

       1465
       1465
       +
                 pos.Position.line = (Input.position t.input).Position.line

     

       1466
       1466
       +
                 && pos.Position.column = (Input.position t.input).Position.column

     

       1467
       1467
       +
             | None -> false)

     

       1340
       1468
        
       

     

       1341
       1469
        
       and fetch_value t =

     

       1342
       1470
        
         let start = Input.mark t.input in

     
···

       1346
       1474
        
           | Some sk :: _ when sk.sk_possible ->

     

       1347
       1475
        
               (* In implicit flow mapping (inside a flow sequence), key and : must be on the same line.

     

       1348
       1476
        
                  In explicit flow mapping { }, key and : can span lines. *)

     

       1349
       1349
       -
               let is_implicit_flow_mapping = match t.flow_mapping_stack with

     

       1350
       1350
       -
                 | false :: _ -> true  (* false = we're in a sequence, so any mapping is implicit *)

     

       1477
       1477
       +
               let is_implicit_flow_mapping =

     

       1478
       1478
       +
                 match t.flow_mapping_stack with

     

       1479
       1479
       +
                 | false :: _ ->

     

       1480
       1480
       +
                     true (* false = we're in a sequence, so any mapping is implicit *)

     

       1351
       1481
        
                 | _ -> false

     

       1352
       1482
        
               in

     

       1353
       1353
       -
               if is_implicit_flow_mapping && sk.sk_position.line < (Input.position t.input).line then

     

       1354
       1354
       -
                 Error.raise_at start Illegal_flow_key_line;

     

       1483
       1483
       +
               if

     

       1484
       1484
       +
                 is_implicit_flow_mapping

     

       1485
       1485
       +
                 && sk.sk_position.line < (Input.position t.input).line

     

       1486
       1486
       +
               then Error.raise_at start Illegal_flow_key_line;

     

       1355
       1487
        
               (* Insert KEY token before the simple key value *)

     

       1356
       1488
        
               let key_span = Span.point sk.sk_position in

     

       1357
       1489
        
               let key_token = { Token.token = Token.Key; span = key_span } in

     
···

       1359
       1491
        
               let tokens = Queue.to_seq t.tokens |> Array.of_seq in

     

       1360
       1492
        
               Queue.clear t.tokens;

     

       1361
       1493
        
               let insert_pos = sk.sk_token_number - t.tokens_taken in

     

       1362
       1362
       -
               Array.iteri (fun i tok ->

     

       1363
       1363
       -
                 if i = insert_pos then Queue.add key_token t.tokens;

     

       1364
       1364
       -
                 Queue.add tok t.tokens

     

       1365
       1365
       -
               ) tokens;

     

       1366
       1366
       -
               if insert_pos >= Array.length tokens then

     

       1367
       1367
       -
                 Queue.add key_token t.tokens;

     

       1494
       1494
       +
               Array.iteri

     

       1495
       1495
       +
                 (fun i tok ->

     

       1496
       1496
       +
                   if i = insert_pos then Queue.add key_token t.tokens;

     

       1497
       1497
       +
                   Queue.add tok t.tokens)

     

       1498
       1498
       +
                 tokens;

     

       1499
       1499
       +
               if insert_pos >= Array.length tokens then Queue.add key_token t.tokens;

     

       1368
       1500
        
               t.token_number <- t.token_number + 1;

     

       1369
       1369
       -
               t.pending_value <- true;  (* We've inserted a KEY token, now waiting for VALUE *)

     

       1370
       1501
        
               (* Roll indent for implicit block mapping *)

     

       1371
       1502
        
               if t.flow_level = 0 then begin

     

       1372
       1503
        
                 let col = sk.sk_position.column in

     

       1373
       1373
       -
                 if roll_indent t col ~sequence:false then begin

     

       1504
       1504
       +
                 if roll_indent t col then begin

     

       1374
       1505
        
                   let span = Span.point sk.sk_position in

     

       1375
       1506
        
                   (* Insert block mapping start before key *)

     

       1376
       1507
        
                   let bm_token = { Token.token = Token.Block_mapping_start; span } in

     

       1377
       1508
        
                   let tokens = Queue.to_seq t.tokens |> Array.of_seq in

     

       1378
       1509
        
                   Queue.clear t.tokens;

     

       1379
       1379
       -
                   Array.iteri (fun i tok ->

     

       1380
       1380
       -
                     if i = insert_pos then Queue.add bm_token t.tokens;

     

       1381
       1381
       -
                     Queue.add tok t.tokens

     

       1382
       1382
       -
                   ) tokens;

     

       1510
       1510
       +
                   Array.iteri

     

       1511
       1511
       +
                     (fun i tok ->

     

       1512
       1512
       +
                       if i = insert_pos then Queue.add bm_token t.tokens;

     

       1513
       1513
       +
                       Queue.add tok t.tokens)

     

       1514
       1514
       +
                     tokens;

     

       1383
       1515
        
                   if insert_pos >= Array.length tokens then

     

       1384
       1516
        
                     Queue.add bm_token t.tokens;

     

       1385
       1517
        
                   t.token_number <- t.token_number + 1

     

       1386
       1518
        
                 end

     

       1387
       1519
        
               end;

     

       1388
       1388
       -
               t.simple_keys <- None :: (List.tl t.simple_keys);

     

       1520
       1520
       +
               t.simple_keys <- None :: List.tl t.simple_keys;

     

       1389
       1521
        
               true

     

       1390
       1522
        
           | _ ->

     

       1391
       1523
        
               (* No simple key - this is a complex value (or empty key) *)

     
···

       1393
       1525
        
                 if not t.allow_simple_key then

     

       1394
       1526
        
                   Error.raise_at (Input.mark t.input) Expected_key;

     

       1395
       1527
        
                 let col = column t in

     

       1396
       1396
       -
                 if roll_indent t col ~sequence:false then begin

     

       1528
       1528
       +
                 if roll_indent t col then begin

     

       1397
       1529
        
                   let span = Span.point (Input.mark t.input) in

     

       1398
       1530
        
                   emit t span Token.Block_mapping_start

     

       1399
       1531
        
                 end

     
···

       1405
       1537
        
         remove_simple_key t;

     

       1406
       1538
        
         (* In block context without simple key, allow simple keys for compact mappings like ": moon: white"

     

       1407
       1539
        
            In flow context or after using a simple key, disallow simple keys *)

     

       1408
       1408
       -
         t.allow_simple_key <- (not used_simple_key) && (t.flow_level = 0);

     

       1540
       1540
       +
         t.allow_simple_key <- (not used_simple_key) && t.flow_level = 0;

     

       1409
       1541
        
         t.document_has_content <- true;

     

       1410
       1542
        
         let start = Input.mark t.input in

     

       1411
       1543
        
         ignore (Input.next t.input);

     

       1412
       1544
        
       

     

       1413
       1545
        
         (* Check for tabs after : : patterns like :\t- or :\tkey: are invalid in block context (Y79Y/09)

     

       1414
       1546
        
            However, :\t bar (tab followed by space then content) is valid (6BCT) *)

     

       1415
       1415
       -
         let (found_tabs, found_spaces) = skip_blanks_check_tabs t in

     

       1416
       1416
       -
         if found_tabs && not found_spaces && t.flow_level = 0 then begin

     

       1547
       1547
       +
         let found_tabs, found_spaces = skip_blanks_check_tabs t in

     

       1548
       1548
       +
         if found_tabs && (not found_spaces) && t.flow_level = 0 then begin

     

       1417
       1549
        
           (* In block context, tabs-only after : followed by indicator or alphanumeric are not allowed *)

     

       1418
       1550
        
           match Input.peek t.input with

     

       1419
       1419
       -
           | Some ('-' | '?') ->

     

       1420
       1420
       -
               Error.raise_at start Tab_in_indentation

     

       1421
       1421
       -
           | Some c when (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') ->

     

       1551
       1551
       +
           | Some ('-' | '?') -> Error.raise_at start Tab_in_indentation

     

       1552
       1552
       +
           | Some c

     

       1553
       1553
       +
             when (c >= 'a' && c <= 'z')

     

       1554
       1554
       +
                  || (c >= 'A' && c <= 'Z')

     

       1555
       1555
       +
                  || (c >= '0' && c <= '9') ->

     

       1422
       1556
        
               (* Tab-only followed by alphanumeric - likely a key, which is invalid *)

     

       1423
       1557
        
               Error.raise_at start Tab_in_indentation

     

       1424
       1558
        
           | _ -> ()

     
···

       1428
       1562
        
         skip_whitespace_and_comment t;

     

       1429
       1563
        
       

     

       1430
       1564
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1431
       1431
       -
         emit t span Token.Value;

     

       1432
       1432
       -
         t.pending_value <- false  (* We've emitted a VALUE, no longer pending *)

     

       1565
       1565
       +
         emit t span Token.Value

     

       1433
       1566
        
       

     

       1434
       1434
       -
       and fetch_alias t =

     

       1567
       1567
       +
       and fetch_anchor_or_alias t ~is_alias =

     

       1435
       1568
        
         save_simple_key t;

     

       1436
       1569
        
         t.allow_simple_key <- false;

     

       1437
       1570
        
         t.document_has_content <- true;

     

       1438
       1571
        
         let start = Input.mark t.input in

     

       1439
       1439
       -
         ignore (Input.next t.input); (* consume * *)

     

       1572
       1572
       +
         ignore (Input.next t.input);

     

       1573
       1573
       +
         (* consume * or & *)

     

       1440
       1574
        
         let name, span = scan_anchor_alias t in

     

       1441
       1575
        
         let span = Span.make ~start ~stop:span.stop in

     

       1442
       1442
       -
         emit t span (Token.Alias name)

     

       1576
       1576
       +
         let token = if is_alias then Token.Alias name else Token.Anchor name in

     

       1577
       1577
       +
         emit t span token

     

       1443
       1578
        
       

     

       1444
       1444
       -
       and fetch_anchor t =

     

       1445
       1445
       -
         save_simple_key t;

     

       1446
       1446
       -
         t.allow_simple_key <- false;

     

       1447
       1447
       -
         t.document_has_content <- true;

     

       1448
       1448
       -
         let start = Input.mark t.input in

     

       1449
       1449
       -
         ignore (Input.next t.input); (* consume & *)

     

       1450
       1450
       -
         let name, span = scan_anchor_alias t in

     

       1451
       1451
       -
         let span = Span.make ~start ~stop:span.stop in

     

       1452
       1452
       -
         emit t span (Token.Anchor name)

     

       1579
       1579
       +
       and fetch_alias t = fetch_anchor_or_alias t ~is_alias:true

     

       1580
       1580
       +
       and fetch_anchor t = fetch_anchor_or_alias t ~is_alias:false

     

       1453
       1581
        
       

     

       1454
       1582
        
       and fetch_tag t =

     

       1455
       1583
        
         save_simple_key t;

     
···

       1465
       1593
        
         let value, style, span = scan_block_scalar t literal in

     

       1466
       1594
        
         emit t span (Token.Scalar { style; value })

     

       1467
       1595
        
       

     

       1468
       1468
       -
       and fetch_single_quoted t =

     

       1596
       1596
       +
       and fetch_quoted t ~double =

     

       1469
       1597
        
         save_simple_key t;

     

       1470
       1598
        
         t.allow_simple_key <- false;

     

       1471
       1599
        
         t.document_has_content <- true;

     

       1472
       1472
       -
         let value, span = scan_single_quoted t in

     

       1600
       1600
       +
         let value, span =

     

       1601
       1601
       +
           if double then scan_double_quoted t else scan_single_quoted t

     

       1602
       1602
       +
         in

     

       1473
       1603
        
         (* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)

     

       1474
       1604
        
         skip_to_next_token t;

     

       1475
       1605
        
         if t.flow_level > 0 then

     

       1476
       1606
        
           t.adjacent_value_allowed_at <- Some (Input.position t.input);

     

       1477
       1477
       -
         emit t span (Token.Scalar { style = `Single_quoted; value })

     

       1607
       1607
       +
         let style = if double then `Double_quoted else `Single_quoted in

     

       1608
       1608
       +
         emit t span (Token.Scalar { style; value })

     

       1478
       1609
        
       

     

       1479
       1479
       -
       and fetch_double_quoted t =

     

       1480
       1480
       -
         save_simple_key t;

     

       1481
       1481
       -
         t.allow_simple_key <- false;

     

       1482
       1482
       -
         t.document_has_content <- true;

     

       1483
       1483
       -
         let value, span = scan_double_quoted t in

     

       1484
       1484
       -
         (* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)

     

       1485
       1485
       -
         skip_to_next_token t;

     

       1486
       1486
       -
         if t.flow_level > 0 then

     

       1487
       1487
       -
           t.adjacent_value_allowed_at <- Some (Input.position t.input);

     

       1488
       1488
       -
         emit t span (Token.Scalar { style = `Double_quoted; value })

     

       1610
       1610
       +
       and fetch_single_quoted t = fetch_quoted t ~double:false

     

       1611
       1611
       +
       and fetch_double_quoted t = fetch_quoted t ~double:true

     

       1489
       1612
        
       

     

       1490
       1613
        
       and can_start_plain t =

     

       1491
       1614
        
         (* Check if - ? : can start a plain scalar *)

     

       1492
       1615
        
         match Input.peek_nth t.input 1 with

     

       1493
       1616
        
         | None -> false

     

       1494
       1617
        
         | Some c ->

     

       1495
       1495
       -
             not (Input.is_whitespace c) &&

     

       1496
       1496
       -
             (t.flow_level = 0 || not (Input.is_flow_indicator c))

     

       1618
       1618
       +
             (not (Input.is_whitespace c))

     

       1619
       1619
       +
             && (t.flow_level = 0 || not (Input.is_flow_indicator c))

     

       1497
       1620
        
       

     

       1498
       1621
        
       and can_start_plain_char c _t =

     

       1499
       1622
        
         (* Characters that can start a plain scalar *)

     
···

       1509
       1632
        
         (* If the plain scalar ended after crossing a line break (leading_blanks = true),

     

       1510
       1633
        
            allow simple keys. This is important because the scanner already consumed the

     

       1511
       1634
        
            line break and leading whitespace when checking for continuation. *)

     

       1512
       1512
       -
         if ended_with_linebreak then

     

       1513
       1513
       -
           t.allow_simple_key <- true;

     

       1635
       1635
       +
         if ended_with_linebreak then t.allow_simple_key <- true;

     

       1514
       1636
        
         emit t span (Token.Scalar { style = `Plain; value })

     

       1515
       1637
        
       

     

       1516
       1638
        
       (** Check if we need more tokens to resolve simple keys *)

     
···

       1519
       1641
        
         else if Queue.is_empty t.tokens then true

     

       1520
       1642
        
         else

     

       1521
       1643
        
           (* Check if any simple key could affect the first queued token *)

     

       1522
       1522
       -
           List.exists (function

     

       1523
       1523
       -
             | Some sk when sk.sk_possible ->

     

       1524
       1524
       -
                 sk.sk_token_number >= t.tokens_taken

     

       1525
       1525
       -
             | _ -> false

     

       1526
       1526
       -
           ) t.simple_keys

     

       1644
       1644
       +
           List.exists

     

       1645
       1645
       +
             (function

     

       1646
       1646
       +
               | Some sk when sk.sk_possible -> sk.sk_token_number >= t.tokens_taken

     

       1647
       1647
       +
               | _ -> false)

     

       1648
       1648
       +
             t.simple_keys

     

       1527
       1649
        
       

     

       1528
       1650
        
       (** Ensure we have enough tokens to return one safely *)

     

       1529
       1651
        
       let ensure_tokens t =

     
···

       1540
       1662
        
       (** Get next token *)

     

       1541
       1663
        
       let next t =

     

       1542
       1664
        
         ensure_tokens t;

     

       1543
       1543
       -
         if Queue.is_empty t.tokens then

     

       1544
       1544
       -
           None

     

       1665
       1665
       +
         if Queue.is_empty t.tokens then None

     

       1545
       1666
        
         else begin

     

       1546
       1667
        
           t.tokens_taken <- t.tokens_taken + 1;

     

       1547
       1668
        
           Some (Queue.pop t.tokens)

     
···

       1557
       1678
        
         let rec loop () =

     

       1558
       1679
        
           match next t with

     

       1559
       1680
        
           | None -> ()

     

       1560
       1560
       -
           | Some tok -> f tok; loop ()

     

       1681
       1681
       +
           | Some tok ->

     

       1682
       1682
       +
               f tok;

     

       1683
       1683
       +
               loop ()

     

       1561
       1684
        
         in

     

       1562
       1685
        
         loop ()

     

       1563
       1686
        
       

     

       1564
       1687
        
       (** Fold over all tokens *)

     

       1565
       1688
        
       let fold f init t =

     

       1566
       1689
        
         let rec loop acc =

     

       1567
       1567
       -
           match next t with

     

       1568
       1568
       -
           | None -> acc

     

       1569
       1569
       -
           | Some tok -> loop (f acc tok)

     

       1690
       1690
       +
           match next t with None -> acc | Some tok -> loop (f acc tok)

     

       1570
       1691
        
         in

     

       1571
       1692
        
         loop init

     

       1572
       1693
        
       

     

       1573
       1694
        
       (** Convert to list *)

     

       1574
       1574
       -
       let to_list t =

     

       1575
       1575
       -
         fold (fun acc tok -> tok :: acc) [] t |> List.rev

     

       1695
       1695
       +
       let to_list t = fold (fun acc tok -> tok :: acc) [] t |> List.rev

+43

lib/scanner.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML tokenizer/scanner with lookahead for ambiguity resolution *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t

     

       9
       9
       +
       

     

       10
       10
       +
       (** {2 Constructors} *)

     

       11
       11
       +
       

     

       12
       12
       +
       val of_string : string -> t

     

       13
       13
       +
       (** Create scanner from a string *)

     

       14
       14
       +
       

     

       15
       15
       +
       val of_input : Input.t -> t

     

       16
       16
       +
       (** Create scanner from an input source *)

     

       17
       17
       +
       

     

       18
       18
       +
       val of_reader : Bytesrw.Bytes.Reader.t -> t

     

       19
       19
       +
       (** Create scanner from a Bytes.Reader *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** {2 Position} *)

     

       22
       22
       +
       

     

       23
       23
       +
       val position : t -> Position.t

     

       24
       24
       +
       (** Get current position in input *)

     

       25
       25
       +
       

     

       26
       26
       +
       (** {2 Token Access} *)

     

       27
       27
       +
       

     

       28
       28
       +
       val next : t -> Token.spanned option

     

       29
       29
       +
       (** Get next token *)

     

       30
       30
       +
       

     

       31
       31
       +
       val peek : t -> Token.spanned option

     

       32
       32
       +
       (** Peek at next token without consuming *)

     

       33
       33
       +
       

     

       34
       34
       +
       (** {2 Iteration} *)

     

       35
       35
       +
       

     

       36
       36
       +
       val iter : (Token.spanned -> unit) -> t -> unit

     

       37
       37
       +
       (** Iterate over all tokens *)

     

       38
       38
       +
       

     

       39
       39
       +
       val fold : ('a -> Token.spanned -> 'a) -> 'a -> t -> 'a

     

       40
       40
       +
       (** Fold over all tokens *)

     

       41
       41
       +
       

     

       42
       42
       +
       val to_list : t -> Token.spanned list

     

       43
       43
       +
       (** Convert to list of tokens *)

+22 -34

lib/sequence.ml

···

       13
       13
        
         members : 'a list;

     

       14
       14
        
       }

     

       15
       15
        
       

     

       16
       16
       -
       let make

     

       17
       17
       -
           ?(anchor : string option)

     

       18
       18
       -
           ?(tag : string option)

     

       19
       19
       -
           ?(implicit = true)

     

       20
       20
       -
           ?(style = `Any)

     

       21
       21
       -
           members =

     

       16
       16
       +
       let make ?(anchor : string option) ?(tag : string option) ?(implicit = true)

     

       17
       17
       +
           ?(style = `Any) members =

     

       22
       18
        
         { anchor; tag; implicit; style; members }

     

       23
       19
        
       

     

       24
       20
        
       let members t = t.members

     
···

       26
       22
        
       let tag t = t.tag

     

       27
       23
        
       let implicit t = t.implicit

     

       28
       24
        
       let style t = t.style

     

       29
       29
       -
       

     

       30
       25
        
       let with_anchor anchor t = { t with anchor = Some anchor }

     

       31
       26
        
       let with_tag tag t = { t with tag = Some tag }

     

       32
       27
        
       let with_style style t = { t with style }

     

       33
       33
       -
       

     

       34
       28
        
       let map f t = { t with members = List.map f t.members }

     

       35
       35
       -
       

     

       36
       29
        
       let length t = List.length t.members

     

       37
       37
       -
       

     

       38
       30
        
       let is_empty t = t.members = []

     

       39
       39
       -
       

     

       40
       31
        
       let nth t n = List.nth t.members n

     

       41
       41
       -
       

     

       42
       32
        
       let nth_opt t n = List.nth_opt t.members n

     

       43
       43
       -
       

     

       44
       33
        
       let iter f t = List.iter f t.members

     

       45
       45
       -
       

     

       46
       34
        
       let fold f init t = List.fold_left f init t.members

     

       47
       35
        
       

     

       48
       36
        
       let pp pp_elem fmt t =

     

       49
       37
        
         Format.fprintf fmt "@[<hv 2>sequence(@,";

     

       50
       50
       -
         (match t.anchor with

     

       51
       51
       -
          | Some a -> Format.fprintf fmt "anchor=%s,@ " a

     

       52
       52
       -
          | None -> ());

     

       53
       53
       -
         (match t.tag with

     

       54
       54
       -
          | Some tag -> Format.fprintf fmt "tag=%s,@ " tag

     

       55
       55
       -
          | None -> ());

     

       38
       38
       +
         Option.iter (Format.fprintf fmt "anchor=%s,@ ") t.anchor;

     

       39
       39
       +
         Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;

     

       56
       40
        
         Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;

     

       57
       41
        
         Format.fprintf fmt "members=[@,%a@]@,)"

     

       58
       58
       -
           (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") pp_elem)

     

       42
       42
       +
           (Format.pp_print_list

     

       43
       43
       +
              ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")

     

       44
       44
       +
              pp_elem)

     

       59
       45
        
           t.members

     

       60
       46
        
       

     

       61
       47
        
       let equal eq a b =

     

       62
       62
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       63
       63
       -
         Option.equal String.equal a.tag b.tag &&

     

       64
       64
       -
         a.implicit = b.implicit &&

     

       65
       65
       -
         Layout_style.equal a.style b.style &&

     

       66
       66
       -
         List.equal eq a.members b.members

     

       48
       48
       +
         Option.equal String.equal a.anchor b.anchor

     

       49
       49
       +
         && Option.equal String.equal a.tag b.tag

     

       50
       50
       +
         && a.implicit = b.implicit

     

       51
       51
       +
         && Layout_style.equal a.style b.style

     

       52
       52
       +
         && List.equal eq a.members b.members

     

       67
       53
        
       

     

       68
       54
        
       let compare cmp a b =

     

       69
       55
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       70
       70
       -
         if c <> 0 then c else

     

       71
       71
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       72
       72
       -
         if c <> 0 then c else

     

       73
       73
       -
         let c = Bool.compare a.implicit b.implicit in

     

       74
       74
       -
         if c <> 0 then c else

     

       75
       75
       -
         let c = Layout_style.compare a.style b.style in

     

       76
       76
       -
         if c <> 0 then c else

     

       77
       77
       -
         List.compare cmp a.members b.members

     

       56
       56
       +
         if c <> 0 then c

     

       57
       57
       +
         else

     

       58
       58
       +
           let c = Option.compare String.compare a.tag b.tag in

     

       59
       59
       +
           if c <> 0 then c

     

       60
       60
       +
           else

     

       61
       61
       +
             let c = Bool.compare a.implicit b.implicit in

     

       62
       62
       +
             if c <> 0 then c

     

       63
       63
       +
             else

     

       64
       64
       +
               let c = Layout_style.compare a.style b.style in

     

       65
       65
       +
               if c <> 0 then c else List.compare cmp a.members b.members

+46

lib/sequence.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML sequence (array) values with metadata *)

     

       7
       7
       +
       

     

       8
       8
       +
       type 'a t

     

       9
       9
       +
       

     

       10
       10
       +
       val make :

     

       11
       11
       +
         ?anchor:string ->

     

       12
       12
       +
         ?tag:string ->

     

       13
       13
       +
         ?implicit:bool ->

     

       14
       14
       +
         ?style:Layout_style.t ->

     

       15
       15
       +
         'a list -> 'a t

     

       16
       16
       +
       (** Create a sequence *)

     

       17
       17
       +
       

     

       18
       18
       +
       (** {2 Accessors} *)

     

       19
       19
       +
       

     

       20
       20
       +
       val members : 'a t -> 'a list

     

       21
       21
       +
       val anchor : 'a t -> string option

     

       22
       22
       +
       val tag : 'a t -> string option

     

       23
       23
       +
       val implicit : 'a t -> bool

     

       24
       24
       +
       val style : 'a t -> Layout_style.t

     

       25
       25
       +
       

     

       26
       26
       +
       (** {2 Modifiers} *)

     

       27
       27
       +
       

     

       28
       28
       +
       val with_anchor : string -> 'a t -> 'a t

     

       29
       29
       +
       val with_tag : string -> 'a t -> 'a t

     

       30
       30
       +
       val with_style : Layout_style.t -> 'a t -> 'a t

     

       31
       31
       +
       

     

       32
       32
       +
       (** {2 Operations} *)

     

       33
       33
       +
       

     

       34
       34
       +
       val map : ('a -> 'b) -> 'a t -> 'b t

     

       35
       35
       +
       val length : 'a t -> int

     

       36
       36
       +
       val is_empty : 'a t -> bool

     

       37
       37
       +
       val nth : 'a t -> int -> 'a

     

       38
       38
       +
       val nth_opt : 'a t -> int -> 'a option

     

       39
       39
       +
       val iter : ('a -> unit) -> 'a t -> unit

     

       40
       40
       +
       val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b

     

       41
       41
       +
       

     

       42
       42
       +
       (** {2 Comparison} *)

     

       43
       43
       +
       

     

       44
       44
       +
       val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit

     

       45
       45
       +
       val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool

     

       46
       46
       +
       val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int

+176 -159

lib/serialize.ml

···

       10
       10
        
       

     

       11
       11
        
       (** {1 Internal Helpers} *)

     

       12
       12
        
       

     

       13
       13
       -
       (** Emit a YAML node using an emit function.

     

       14
       14
       -
           This is the core implementation used by both Emitter.t and function-based APIs. *)

     

       13
       13
       +
       (** Emit a YAML node using an emit function. This is the core implementation

     

       14
       14
       +
           used by both Emitter.t and function-based APIs. *)

     

       15
       15
        
       let rec emit_yaml_node_impl ~emit (yaml : Yaml.t) =

     

       16
       16
        
         match yaml with

     

       17
       17
        
         | `Scalar s ->

     

       18
       18
       -
             emit (Event.Scalar {

     

       19
       19
       -
               anchor = Scalar.anchor s;

     

       20
       20
       -
               tag = Scalar.tag s;

     

       21
       21
       -
               value = Scalar.value s;

     

       22
       22
       -
               plain_implicit = Scalar.plain_implicit s;

     

       23
       23
       -
               quoted_implicit = Scalar.quoted_implicit s;

     

       24
       24
       -
               style = Scalar.style s;

     

       25
       25
       -
             })

     

       26
       26
       -
       

     

       27
       27
       -
         | `Alias name ->

     

       28
       28
       -
             emit (Event.Alias { anchor = name })

     

       29
       29
       -
       

     

       18
       18
       +
             emit

     

       19
       19
       +
               (Event.Scalar

     

       20
       20
       +
                  {

     

       21
       21
       +
                    anchor = Scalar.anchor s;

     

       22
       22
       +
                    tag = Scalar.tag s;

     

       23
       23
       +
                    value = Scalar.value s;

     

       24
       24
       +
                    plain_implicit = Scalar.plain_implicit s;

     

       25
       25
       +
                    quoted_implicit = Scalar.quoted_implicit s;

     

       26
       26
       +
                    style = Scalar.style s;

     

       27
       27
       +
                  })

     

       28
       28
       +
         | `Alias name -> emit (Event.Alias { anchor = name })

     

       30
       29
        
         | `A seq ->

     

       31
       30
        
             let members = Sequence.members seq in

     

       32
       32
       -
             let style =

     

       33
       33
       -
               (* Force flow style for empty sequences *)

     

       34
       34
       -
               if members = [] then `Flow

     

       35
       35
       -
               else Sequence.style seq

     

       36
       36
       -
             in

     

       37
       37
       -
             emit (Event.Sequence_start {

     

       38
       38
       -
               anchor = Sequence.anchor seq;

     

       39
       39
       -
               tag = Sequence.tag seq;

     

       40
       40
       -
               implicit = Sequence.implicit seq;

     

       41
       41
       -
               style;

     

       42
       42
       -
             });

     

       31
       31
       +
             (* Force flow style for empty sequences *)

     

       32
       32
       +
             let style = if members = [] then `Flow else Sequence.style seq in

     

       33
       33
       +
             emit

     

       34
       34
       +
               (Event.Sequence_start

     

       35
       35
       +
                  {

     

       36
       36
       +
                    anchor = Sequence.anchor seq;

     

       37
       37
       +
                    tag = Sequence.tag seq;

     

       38
       38
       +
                    implicit = Sequence.implicit seq;

     

       39
       39
       +
                    style;

     

       40
       40
       +
                  });

     

       43
       41
        
             List.iter (emit_yaml_node_impl ~emit) members;

     

       44
       42
        
             emit Event.Sequence_end

     

       45
       45
       -
       

     

       46
       43
        
         | `O map ->

     

       47
       44
        
             let members = Mapping.members map in

     

       48
       48
       -
             let style =

     

       49
       49
       -
               (* Force flow style for empty mappings *)

     

       50
       50
       -
               if members = [] then `Flow

     

       51
       51
       -
               else Mapping.style map

     

       52
       52
       -
             in

     

       53
       53
       -
             emit (Event.Mapping_start {

     

       54
       54
       -
               anchor = Mapping.anchor map;

     

       55
       55
       -
               tag = Mapping.tag map;

     

       56
       56
       -
               implicit = Mapping.implicit map;

     

       57
       57
       -
               style;

     

       58
       58
       -
             });

     

       59
       59
       -
             List.iter (fun (k, v) ->

     

       60
       60
       -
               emit_yaml_node_impl ~emit k;

     

       61
       61
       -
               emit_yaml_node_impl ~emit v

     

       62
       62
       -
             ) members;

     

       45
       45
       +
             (* Force flow style for empty mappings *)

     

       46
       46
       +
             let style = if members = [] then `Flow else Mapping.style map in

     

       47
       47
       +
             emit

     

       48
       48
       +
               (Event.Mapping_start

     

       49
       49
       +
                  {

     

       50
       50
       +
                    anchor = Mapping.anchor map;

     

       51
       51
       +
                    tag = Mapping.tag map;

     

       52
       52
       +
                    implicit = Mapping.implicit map;

     

       53
       53
       +
                    style;

     

       54
       54
       +
                  });

     

       55
       55
       +
             List.iter

     

       56
       56
       +
               (fun (k, v) ->

     

       57
       57
       +
                 emit_yaml_node_impl ~emit k;

     

       58
       58
       +
                 emit_yaml_node_impl ~emit v)

     

       59
       59
       +
               members;

     

       63
       60
        
             emit Event.Mapping_end

     

       64
       61
        
       

     

       65
       65
       -
       (** Emit a Value node using an emit function.

     

       66
       66
       -
           This is the core implementation used by both Emitter.t and function-based APIs. *)

     

       62
       62
       +
       (** Emit a Value node using an emit function. This is the core implementation

     

       63
       63
       +
           used by both Emitter.t and function-based APIs. *)

     

       67
       64
        
       let rec emit_value_node_impl ~emit ~config (value : Value.t) =

     

       68
       65
        
         match value with

     

       69
       66
        
         | `Null ->

     

       70
       70
       -
             emit (Event.Scalar {

     

       71
       71
       -
               anchor = None; tag = None;

     

       72
       72
       -
               value = "null";

     

       73
       73
       -
               plain_implicit = true; quoted_implicit = false;

     

       74
       74
       -
               style = `Plain;

     

       75
       75
       -
             })

     

       76
       76
       -
       

     

       67
       67
       +
             emit

     

       68
       68
       +
               (Event.Scalar

     

       69
       69
       +
                  {

     

       70
       70
       +
                    anchor = None;

     

       71
       71
       +
                    tag = None;

     

       72
       72
       +
                    value = "null";

     

       73
       73
       +
                    plain_implicit = true;

     

       74
       74
       +
                    quoted_implicit = false;

     

       75
       75
       +
                    style = `Plain;

     

       76
       76
       +
                  })

     

       77
       77
        
         | `Bool b ->

     

       78
       78
       -
             emit (Event.Scalar {

     

       79
       79
       -
               anchor = None; tag = None;

     

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

     

       81
       81
       -
               plain_implicit = true; quoted_implicit = false;

     

       82
       82
       -
               style = `Plain;

     

       83
       83
       -
             })

     

       84
       84
       -
       

     

       78
       78
       +
             emit

     

       79
       79
       +
               (Event.Scalar

     

       80
       80
       +
                  {

     

       81
       81
       +
                    anchor = None;

     

       82
       82
       +
                    tag = None;

     

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

     

       84
       84
       +
                    plain_implicit = true;

     

       85
       85
       +
                    quoted_implicit = false;

     

       86
       86
       +
                    style = `Plain;

     

       87
       87
       +
                  })

     

       85
       88
        
         | `Float f ->

     

       86
       89
        
             let value =

     

       87
       90
        
               match Float.classify_float f with

     
···

       90
       93
        
               | _ ->

     

       91
       94
        
                   if Float.is_integer f && Float.abs f < 1e15 then

     

       92
       95
        
                     Printf.sprintf "%.0f" f

     

       93
       93
       -
                   else

     

       94
       94
       -
                     Printf.sprintf "%g" f

     

       96
       96
       +
                   else Printf.sprintf "%g" f

     

       95
       97
        
             in

     

       96
       96
       -
             emit (Event.Scalar {

     

       97
       97
       -
               anchor = None; tag = None;

     

       98
       98
       -
               value;

     

       99
       99
       -
               plain_implicit = true; quoted_implicit = false;

     

       100
       100
       -
               style = `Plain;

     

       101
       101
       -
             })

     

       102
       102
       -
       

     

       98
       98
       +
             emit

     

       99
       99
       +
               (Event.Scalar

     

       100
       100
       +
                  {

     

       101
       101
       +
                    anchor = None;

     

       102
       102
       +
                    tag = None;

     

       103
       103
       +
                    value;

     

       104
       104
       +
                    plain_implicit = true;

     

       105
       105
       +
                    quoted_implicit = false;

     

       106
       106
       +
                    style = `Plain;

     

       107
       107
       +
                  })

     

       103
       108
        
         | `String s ->

     

       104
       109
        
             let style = Quoting.choose_style s in

     

       105
       105
       -
             emit (Event.Scalar {

     

       106
       106
       -
               anchor = None; tag = None;

     

       107
       107
       -
               value = s;

     

       108
       108
       -
               plain_implicit = style = `Plain;

     

       109
       109
       -
               quoted_implicit = style <> `Plain;

     

       110
       110
       -
               style;

     

       111
       111
       -
             })

     

       112
       112
       -
       

     

       110
       110
       +
             emit

     

       111
       111
       +
               (Event.Scalar

     

       112
       112
       +
                  {

     

       113
       113
       +
                    anchor = None;

     

       114
       114
       +
                    tag = None;

     

       115
       115
       +
                    value = s;

     

       116
       116
       +
                    plain_implicit = style = `Plain;

     

       117
       117
       +
                    quoted_implicit = style <> `Plain;

     

       118
       118
       +
                    style;

     

       119
       119
       +
                  })

     

       113
       120
        
         | `A items ->

     

       121
       121
       +
             (* Force flow style for empty sequences, otherwise use config *)

     

       114
       122
        
             let style =

     

       115
       115
       -
               (* Force flow style for empty sequences *)

     

       116
       116
       -
               if items = [] then `Flow

     

       117
       117
       -
               else if config.Emitter.layout_style = `Flow then `Flow

     

       118
       118
       -
               else `Block

     

       123
       123
       +
               if items = [] || config.Emitter.layout_style = `Flow then `Flow else `Block

     

       119
       124
        
             in

     

       120
       120
       -
             emit (Event.Sequence_start {

     

       121
       121
       -
               anchor = None; tag = None;

     

       122
       122
       -
               implicit = true;

     

       123
       123
       -
               style;

     

       124
       124
       -
             });

     

       125
       125
       +
             emit

     

       126
       126
       +
               (Event.Sequence_start

     

       127
       127
       +
                  { anchor = None; tag = None; implicit = true; style });

     

       125
       128
        
             List.iter (emit_value_node_impl ~emit ~config) items;

     

       126
       129
        
             emit Event.Sequence_end

     

       127
       127
       -
       

     

       128
       130
        
         | `O pairs ->

     

       131
       131
       +
             (* Force flow style for empty mappings, otherwise use config *)

     

       129
       132
        
             let style =

     

       130
       130
       -
               (* Force flow style for empty mappings *)

     

       131
       131
       -
               if pairs = [] then `Flow

     

       132
       132
       -
               else if config.Emitter.layout_style = `Flow then `Flow

     

       133
       133
       -
               else `Block

     

       133
       133
       +
               if pairs = [] || config.Emitter.layout_style = `Flow then `Flow else `Block

     

       134
       134
        
             in

     

       135
       135
       -
             emit (Event.Mapping_start {

     

       136
       136
       -
               anchor = None; tag = None;

     

       137
       137
       -
               implicit = true;

     

       138
       138
       -
               style;

     

       139
       139
       -
             });

     

       140
       140
       -
             List.iter (fun (k, v) ->

     

       141
       141
       -
               let style = Quoting.choose_style k in

     

       142
       142
       -
               emit (Event.Scalar {

     

       143
       143
       -
                 anchor = None; tag = None;

     

       144
       144
       -
                 value = k;

     

       145
       145
       -
                 plain_implicit = style = `Plain;

     

       146
       146
       -
                 quoted_implicit = style <> `Plain;

     

       147
       147
       -
                 style;

     

       148
       148
       -
               });

     

       149
       149
       -
               emit_value_node_impl ~emit ~config v

     

       150
       150
       -
             ) pairs;

     

       135
       135
       +
             emit

     

       136
       136
       +
               (Event.Mapping_start

     

       137
       137
       +
                  { anchor = None; tag = None; implicit = true; style });

     

       138
       138
       +
             List.iter

     

       139
       139
       +
               (fun (k, v) ->

     

       140
       140
       +
                 let style = Quoting.choose_style k in

     

       141
       141
       +
                 emit

     

       142
       142
       +
                   (Event.Scalar

     

       143
       143
       +
                      {

     

       144
       144
       +
                        anchor = None;

     

       145
       145
       +
                        tag = None;

     

       146
       146
       +
                        value = k;

     

       147
       147
       +
                        plain_implicit = style = `Plain;

     

       148
       148
       +
                        quoted_implicit = style <> `Plain;

     

       149
       149
       +
                        style;

     

       150
       150
       +
                      });

     

       151
       151
       +
                 emit_value_node_impl ~emit ~config v)

     

       152
       152
       +
               pairs;

     

       151
       153
        
             emit Event.Mapping_end

     

       152
       154
        
       

     

       153
       155
        
       (** Strip anchors from a YAML tree (used when resolving aliases for output) *)

     
···

       156
       158
        
         | `Scalar s ->

     

       157
       159
        
             if Option.is_none (Scalar.anchor s) then yaml

     

       158
       160
        
             else

     

       159
       159
       -
               `Scalar (Scalar.make

     

       160
       160
       -
                 ?tag:(Scalar.tag s)

     

       161
       161
       -
                 ~plain_implicit:(Scalar.plain_implicit s)

     

       162
       162
       -
                 ~quoted_implicit:(Scalar.quoted_implicit s)

     

       163
       163
       -
                 ~style:(Scalar.style s)

     

       164
       164
       -
                 (Scalar.value s))

     

       161
       161
       +
               `Scalar

     

       162
       162
       +
                 (Scalar.make ?tag:(Scalar.tag s)

     

       163
       163
       +
                    ~plain_implicit:(Scalar.plain_implicit s)

     

       164
       164
       +
                    ~quoted_implicit:(Scalar.quoted_implicit s) ~style:(Scalar.style s)

     

       165
       165
       +
                    (Scalar.value s))

     

       165
       166
        
         | `Alias _ -> yaml

     

       166
       167
        
         | `A seq ->

     

       167
       167
       -
             `A (Sequence.make

     

       168
       168
       -
               ?tag:(Sequence.tag seq)

     

       169
       169
       -
               ~implicit:(Sequence.implicit seq)

     

       170
       170
       -
               ~style:(Sequence.style seq)

     

       171
       171
       -
               (List.map strip_anchors (Sequence.members seq)))

     

       168
       168
       +
             `A

     

       169
       169
       +
               (Sequence.make ?tag:(Sequence.tag seq) ~implicit:(Sequence.implicit seq)

     

       170
       170
       +
                  ~style:(Sequence.style seq)

     

       171
       171
       +
                  (List.map strip_anchors (Sequence.members seq)))

     

       172
       172
        
         | `O map ->

     

       173
       173
       -
             `O (Mapping.make

     

       174
       174
       -
               ?tag:(Mapping.tag map)

     

       175
       175
       -
               ~implicit:(Mapping.implicit map)

     

       176
       176
       -
               ~style:(Mapping.style map)

     

       177
       177
       -
               (List.map (fun (k, v) -> (strip_anchors k, strip_anchors v)) (Mapping.members map)))

     

       173
       173
       +
             `O

     

       174
       174
       +
               (Mapping.make ?tag:(Mapping.tag map) ~implicit:(Mapping.implicit map)

     

       175
       175
       +
                  ~style:(Mapping.style map)

     

       176
       176
       +
                  (List.map

     

       177
       177
       +
                     (fun (k, v) -> (strip_anchors k, strip_anchors v))

     

       178
       178
       +
                     (Mapping.members map)))

     

       178
       179
        
       

     

       179
       180
        
       (** Emit a document using an emit function *)

     

       180
       181
        
       let emit_document_impl ?(resolve_aliases = true) ~emit doc =

     

       181
       181
       -
         emit (Event.Document_start {

     

       182
       182
       -
           version = Document.version doc;

     

       183
       183
       -
           implicit = Document.implicit_start doc;

     

       184
       184
       -
         });

     

       182
       182
       +
         emit

     

       183
       183
       +
           (Event.Document_start

     

       184
       184
       +
              {

     

       185
       185
       +
                version = Document.version doc;

     

       186
       186
       +
                implicit = Document.implicit_start doc;

     

       187
       187
       +
              });

     

       185
       188
        
         (match Document.root doc with

     

       186
       186
       -
          | Some yaml ->

     

       187
       187
       -
              let yaml = if resolve_aliases then

     

       188
       188
       -
                yaml |> Yaml.resolve_aliases |> strip_anchors

     

       189
       189
       -
              else yaml in

     

       190
       190
       -
              emit_yaml_node_impl ~emit yaml

     

       191
       191
       -
          | None ->

     

       192
       192
       -
              emit (Event.Scalar {

     

       193
       193
       -
                anchor = None; tag = None;

     

       194
       194
       -
                value = "";

     

       195
       195
       -
                plain_implicit = true; quoted_implicit = false;

     

       196
       196
       -
                style = `Plain;

     

       197
       197
       -
              }));

     

       189
       189
       +
         | Some yaml ->

     

       190
       190
       +
             let yaml =

     

       191
       191
       +
               if resolve_aliases then yaml |> Yaml.resolve_aliases |> strip_anchors

     

       192
       192
       +
               else yaml

     

       193
       193
       +
             in

     

       194
       194
       +
             emit_yaml_node_impl ~emit yaml

     

       195
       195
       +
         | None ->

     

       196
       196
       +
             emit

     

       197
       197
       +
               (Event.Scalar

     

       198
       198
       +
                  {

     

       199
       199
       +
                    anchor = None;

     

       200
       200
       +
                    tag = None;

     

       201
       201
       +
                    value = "";

     

       202
       202
       +
                    plain_implicit = true;

     

       203
       203
       +
                    quoted_implicit = false;

     

       204
       204
       +
                    style = `Plain;

     

       205
       205
       +
                  }));

     

       198
       206
        
         emit (Event.Document_end { implicit = Document.implicit_end doc })

     

       199
       207
        
       

     

       200
       208
        
       (** {1 Emitter.t-based API} *)

     

       201
       209
        
       

     

       202
       210
        
       (** Emit a YAML node to an emitter *)

     

       203
       203
       -
       let emit_yaml_node t yaml =

     

       204
       204
       -
         emit_yaml_node_impl ~emit:(Emitter.emit t) yaml

     

       211
       211
       +
       let emit_yaml_node t yaml = emit_yaml_node_impl ~emit:(Emitter.emit t) yaml

     

       205
       212
        
       

     

       206
       213
        
       (** Emit a complete YAML document to an emitter *)

     

       207
       214
        
       let emit_yaml t yaml =

     
···

       259
       266
        
       (** Serialize documents to a buffer.

     

       260
       267
        
       

     

       261
       268
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       262
       262
       -
           @param resolve_aliases Whether to resolve aliases before emission (default: true)

     

       269
       269
       +
           @param resolve_aliases

     

       270
       270
       +
             Whether to resolve aliases before emission (default: true)

     

       263
       271
        
           @param buffer Optional buffer to append to; creates new one if not provided

     

       264
       272
        
           @return The buffer containing serialized YAML *)

     

       265
       265
       -
       let documents_to_buffer ?(config = Emitter.default_config) ?(resolve_aliases = true) ?buffer documents =

     

       273
       273
       +
       let documents_to_buffer ?(config = Emitter.default_config)

     

       274
       274
       +
           ?(resolve_aliases = true) ?buffer documents =

     

       266
       275
        
         let buf = Option.value buffer ~default:(Buffer.create 1024) in

     

       267
       276
        
         let t = Emitter.create ~config () in

     

       268
       277
        
         Emitter.emit t (Event.Stream_start { encoding = config.encoding });

     
···

       288
       297
        
       (** Serialize documents to a string.

     

       289
       298
        
       

     

       290
       299
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       291
       291
       -
           @param resolve_aliases Whether to resolve aliases before emission (default: true) *)

     

       292
       292
       -
       let documents_to_string ?(config = Emitter.default_config) ?(resolve_aliases = true) documents =

     

       300
       300
       +
           @param resolve_aliases

     

       301
       301
       +
             Whether to resolve aliases before emission (default: true) *)

     

       302
       302
       +
       let documents_to_string ?(config = Emitter.default_config)

     

       303
       303
       +
           ?(resolve_aliases = true) documents =

     

       293
       304
        
         Buffer.contents (documents_to_buffer ~config ~resolve_aliases documents)

     

       294
       305
        
       

     

       295
       306
        
       (** {1 Writer-based API}

     

       296
       307
        
       

     

       297
       297
       -
           These functions write directly to a bytesrw [Bytes.Writer.t],

     

       298
       298
       -
           enabling true streaming output without intermediate string allocation.

     

       299
       299
       -
           Uses the emitter's native Writer support for efficiency. *)

     

       308
       308
       +
           These functions write directly to a bytesrw [Bytes.Writer.t], enabling true

     

       309
       309
       +
           streaming output without intermediate string allocation. Uses the emitter's

     

       310
       310
       +
           native Writer support for efficiency. *)

     

       300
       311
        
       

     

       301
       312
        
       (** Serialize a Value directly to a Bytes.Writer.

     

       302
       313
        
       

     

       303
       314
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       304
       304
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

       305
       305
       -
       let value_to_writer ?(config = Emitter.default_config) ?(eod = true) writer value =

     

       315
       315
       +
           @param eod Whether to write end-of-data after serialization (default: true)

     

       316
       316
       +
       *)

     

       317
       317
       +
       let value_to_writer ?(config = Emitter.default_config) ?(eod = true) writer

     

       318
       318
       +
           value =

     

       306
       319
        
         let t = Emitter.of_writer ~config writer in

     

       307
       320
        
         emit_value t value;

     

       308
       321
        
         if eod then Emitter.flush t

     
···

       310
       323
        
       (** Serialize a Yaml.t directly to a Bytes.Writer.

     

       311
       324
        
       

     

       312
       325
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       313
       313
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

       314
       314
       -
       let yaml_to_writer ?(config = Emitter.default_config) ?(eod = true) writer yaml =

     

       326
       326
       +
           @param eod Whether to write end-of-data after serialization (default: true)

     

       327
       327
       +
       *)

     

       328
       328
       +
       let yaml_to_writer ?(config = Emitter.default_config) ?(eod = true) writer yaml

     

       329
       329
       +
           =

     

       315
       330
        
         let t = Emitter.of_writer ~config writer in

     

       316
       331
        
         emit_yaml t yaml;

     

       317
       332
        
         if eod then Emitter.flush t

     
···

       319
       334
        
       (** Serialize documents directly to a Bytes.Writer.

     

       320
       335
        
       

     

       321
       336
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       322
       322
       -
           @param resolve_aliases Whether to resolve aliases before emission (default: true)

     

       323
       323
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

       324
       324
       -
       let documents_to_writer ?(config = Emitter.default_config) ?(resolve_aliases = true) ?(eod = true) writer documents =

     

       337
       337
       +
           @param resolve_aliases

     

       338
       338
       +
             Whether to resolve aliases before emission (default: true)

     

       339
       339
       +
           @param eod Whether to write end-of-data after serialization (default: true)

     

       340
       340
       +
       *)

     

       341
       341
       +
       let documents_to_writer ?(config = Emitter.default_config)

     

       342
       342
       +
           ?(resolve_aliases = true) ?(eod = true) writer documents =

     

       325
       343
        
         let t = Emitter.of_writer ~config writer in

     

       326
       344
        
         Emitter.emit t (Event.Stream_start { encoding = config.encoding });

     

       327
       345
        
         List.iter (emit_document ~resolve_aliases t) documents;

     
···

       330
       348
        
       

     

       331
       349
        
       (** {1 Function-based API}

     

       332
       350
        
       

     

       333
       333
       -
           These functions accept an emit function [Event.t -> unit] instead of

     

       334
       334
       -
           an {!Emitter.t}, allowing them to work with any event sink

     

       335
       335
       -
           (e.g., streaming writers, custom processors). *)

     

       351
       351
       +
           These functions accept an emit function [Event.t -> unit] instead of an

     

       352
       352
       +
           {!Emitter.t}, allowing them to work with any event sink (e.g., streaming

     

       353
       353
       +
           writers, custom processors). *)

     

       336
       354
        
       

     

       337
       355
        
       (** Emit a YAML node using an emitter function *)

     

       338
       338
       -
       let emit_yaml_node_fn ~emitter yaml =

     

       339
       339
       -
         emit_yaml_node_impl ~emit:emitter yaml

     

       356
       356
       +
       let emit_yaml_node_fn ~emitter yaml = emit_yaml_node_impl ~emit:emitter yaml

     

       340
       357
        
       

     

       341
       358
        
       (** Emit a complete YAML stream using an emitter function *)

     

       342
       342
       -
       let emit_yaml ~emitter ~config yaml =

     

       359
       359
       +
       let emit_yaml_fn ~emitter ~config yaml =

     

       343
       360
        
         emitter (Event.Stream_start { encoding = config.Emitter.encoding });

     

       344
       361
        
         emitter (Event.Document_start { version = None; implicit = true });

     

       345
       362
        
         emit_yaml_node_fn ~emitter yaml;

     
···

       351
       368
        
         emit_value_node_impl ~emit:emitter ~config value

     

       352
       369
        
       

     

       353
       370
        
       (** Emit a complete Value stream using an emitter function *)

     

       354
       354
       -
       let emit_value ~emitter ~config value =

     

       371
       371
       +
       let emit_value_fn ~emitter ~config value =

     

       355
       372
        
         emitter (Event.Stream_start { encoding = config.Emitter.encoding });

     

       356
       373
        
         emitter (Event.Document_start { version = None; implicit = true });

     

       357
       374
        
         emit_value_node_fn ~emitter ~config value;

+133

lib/serialize.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Serialize - high-level serialization to buffers and event streams

     

       7
       7
       +
       

     

       8
       8
       +
           This module provides functions to convert YAML values to events and strings.

     

       9
       9
       +
           Both {!Emitter.t}-based and function-based emission APIs are provided. *)

     

       10
       10
       +
       

     

       11
       11
       +
       (** {1 Emitter.t-based API} *)

     

       12
       12
       +
       

     

       13
       13
       +
       val emit_yaml_node : Emitter.t -> Yaml.t -> unit

     

       14
       14
       +
       (** Emit a YAML node to an emitter *)

     

       15
       15
       +
       

     

       16
       16
       +
       val emit_yaml : Emitter.t -> Yaml.t -> unit

     

       17
       17
       +
       (** Emit a complete YAML document to an emitter (includes stream/document markers) *)

     

       18
       18
       +
       

     

       19
       19
       +
       val emit_value_node : Emitter.t -> Value.t -> unit

     

       20
       20
       +
       (** Emit a Value node to an emitter *)

     

       21
       21
       +
       

     

       22
       22
       +
       val emit_value : Emitter.t -> Value.t -> unit

     

       23
       23
       +
       (** Emit a complete Value document to an emitter (includes stream/document markers) *)

     

       24
       24
       +
       

     

       25
       25
       +
       val emit_document : ?resolve_aliases:bool -> Emitter.t -> Document.t -> unit

     

       26
       26
       +
       (** Emit a document to an emitter

     

       27
       27
       +
       

     

       28
       28
       +
           @param resolve_aliases Whether to resolve aliases before emission (default true) *)

     

       29
       29
       +
       

     

       30
       30
       +
       (** {1 Buffer-based API} *)

     

       31
       31
       +
       

     

       32
       32
       +
       val value_to_buffer :

     

       33
       33
       +
         ?config:Emitter.config ->

     

       34
       34
       +
         ?buffer:Buffer.t ->

     

       35
       35
       +
         Value.t -> Buffer.t

     

       36
       36
       +
       (** Serialize a Value to a buffer

     

       37
       37
       +
       

     

       38
       38
       +
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       39
       39
       +
           @param buffer Optional buffer to append to; creates new one if not provided *)

     

       40
       40
       +
       

     

       41
       41
       +
       val yaml_to_buffer :

     

       42
       42
       +
         ?config:Emitter.config ->

     

       43
       43
       +
         ?buffer:Buffer.t ->

     

       44
       44
       +
         Yaml.t -> Buffer.t

     

       45
       45
       +
       (** Serialize a Yaml.t to a buffer *)

     

       46
       46
       +
       

     

       47
       47
       +
       val documents_to_buffer :

     

       48
       48
       +
         ?config:Emitter.config ->

     

       49
       49
       +
         ?resolve_aliases:bool ->

     

       50
       50
       +
         ?buffer:Buffer.t ->

     

       51
       51
       +
         Document.t list -> Buffer.t

     

       52
       52
       +
       (** Serialize documents to a buffer

     

       53
       53
       +
       

     

       54
       54
       +
           @param resolve_aliases Whether to resolve aliases before emission (default true) *)

     

       55
       55
       +
       

     

       56
       56
       +
       (** {1 String-based API} *)

     

       57
       57
       +
       

     

       58
       58
       +
       val value_to_string : ?config:Emitter.config -> Value.t -> string

     

       59
       59
       +
       (** Serialize a Value to a string *)

     

       60
       60
       +
       

     

       61
       61
       +
       val yaml_to_string : ?config:Emitter.config -> Yaml.t -> string

     

       62
       62
       +
       (** Serialize a Yaml.t to a string *)

     

       63
       63
       +
       

     

       64
       64
       +
       val documents_to_string :

     

       65
       65
       +
         ?config:Emitter.config ->

     

       66
       66
       +
         ?resolve_aliases:bool ->

     

       67
       67
       +
         Document.t list -> string

     

       68
       68
       +
       (** Serialize documents to a string *)

     

       69
       69
       +
       

     

       70
       70
       +
       (** {1 Writer-based API}

     

       71
       71
       +
       

     

       72
       72
       +
           These functions write directly to a bytesrw [Bytes.Writer.t],

     

       73
       73
       +
           enabling true streaming output without intermediate string allocation. *)

     

       74
       74
       +
       

     

       75
       75
       +
       val value_to_writer :

     

       76
       76
       +
         ?config:Emitter.config ->

     

       77
       77
       +
         ?eod:bool ->

     

       78
       78
       +
         Bytesrw.Bytes.Writer.t -> Value.t -> unit

     

       79
       79
       +
       (** Serialize a Value directly to a Bytes.Writer

     

       80
       80
       +
       

     

       81
       81
       +
           @param eod Whether to write end-of-data after serialization (default true) *)

     

       82
       82
       +
       

     

       83
       83
       +
       val yaml_to_writer :

     

       84
       84
       +
         ?config:Emitter.config ->

     

       85
       85
       +
         ?eod:bool ->

     

       86
       86
       +
         Bytesrw.Bytes.Writer.t -> Yaml.t -> unit

     

       87
       87
       +
       (** Serialize a Yaml.t directly to a Bytes.Writer *)

     

       88
       88
       +
       

     

       89
       89
       +
       val documents_to_writer :

     

       90
       90
       +
         ?config:Emitter.config ->

     

       91
       91
       +
         ?resolve_aliases:bool ->

     

       92
       92
       +
         ?eod:bool ->

     

       93
       93
       +
         Bytesrw.Bytes.Writer.t -> Document.t list -> unit

     

       94
       94
       +
       (** Serialize documents directly to a Bytes.Writer *)

     

       95
       95
       +
       

     

       96
       96
       +
       (** {1 Function-based API}

     

       97
       97
       +
       

     

       98
       98
       +
           These functions accept an emit function [Event.t -> unit] instead of

     

       99
       99
       +
           an {!Emitter.t}, allowing them to work with any event sink. *)

     

       100
       100
       +
       

     

       101
       101
       +
       val emit_yaml_node_fn : emitter:(Event.t -> unit) -> Yaml.t -> unit

     

       102
       102
       +
       (** Emit a YAML node using an emitter function *)

     

       103
       103
       +
       

     

       104
       104
       +
       val emit_yaml_fn :

     

       105
       105
       +
         emitter:(Event.t -> unit) ->

     

       106
       106
       +
         config:Emitter.config ->

     

       107
       107
       +
         Yaml.t -> unit

     

       108
       108
       +
       (** Emit a complete YAML stream using an emitter function *)

     

       109
       109
       +
       

     

       110
       110
       +
       val emit_value_node_fn :

     

       111
       111
       +
         emitter:(Event.t -> unit) ->

     

       112
       112
       +
         config:Emitter.config ->

     

       113
       113
       +
         Value.t -> unit

     

       114
       114
       +
       (** Emit a Value node using an emitter function *)

     

       115
       115
       +
       

     

       116
       116
       +
       val emit_value_fn :

     

       117
       117
       +
         emitter:(Event.t -> unit) ->

     

       118
       118
       +
         config:Emitter.config ->

     

       119
       119
       +
         Value.t -> unit

     

       120
       120
       +
       (** Emit a complete Value stream using an emitter function *)

     

       121
       121
       +
       

     

       122
       122
       +
       val emit_document_fn :

     

       123
       123
       +
         ?resolve_aliases:bool ->

     

       124
       124
       +
         emitter:(Event.t -> unit) ->

     

       125
       125
       +
         Document.t -> unit

     

       126
       126
       +
       (** Emit a document using an emitter function *)

     

       127
       127
       +
       

     

       128
       128
       +
       val emit_documents :

     

       129
       129
       +
         emitter:(Event.t -> unit) ->

     

       130
       130
       +
         config:Emitter.config ->

     

       131
       131
       +
         ?resolve_aliases:bool ->

     

       132
       132
       +
         Document.t list -> unit

     

       133
       133
       +
       (** Emit multiple documents using an emitter function *)

+10 -16

lib/span.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Source spans representing ranges in input *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = {

     

       9
       9
       -
         start : Position.t;

     

       10
       10
       -
         stop : Position.t;

     

       11
       11
       -
       }

     

       8
       8
       +
       type t = { start : Position.t; stop : Position.t }

     

       12
       9
        
       

     

       13
       10
        
       let make ~start ~stop = { start; stop }

     

       14
       14
       -
       

     

       15
       11
        
       let point pos = { start = pos; stop = pos }

     

       16
       12
        
       

     

       17
       13
        
       let merge a b =

     

       18
       18
       -
         let start = if Position.compare a.start b.start <= 0 then a.start else b.start in

     

       14
       14
       +
         let start =

     

       15
       15
       +
           if Position.compare a.start b.start <= 0 then a.start else b.start

     

       16
       16
       +
         in

     

       19
       17
        
         let stop = if Position.compare a.stop b.stop >= 0 then a.stop else b.stop in

     

       20
       18
        
         { start; stop }

     

       21
       19
        
       

     

       22
       22
       -
       let extend span pos =

     

       23
       23
       -
         { span with stop = pos }

     

       20
       20
       +
       let extend span pos = { span with stop = pos }

     

       24
       21
        
       

     

       25
       22
        
       let pp fmt t =

     

       26
       23
        
         if t.start.line = t.stop.line then

     

       27
       27
       -
           Format.fprintf fmt "line %d, columns %d-%d"

     

       28
       28
       -
             t.start.line t.start.column t.stop.column

     

       29
       29
       -
         else

     

       30
       30
       -
           Format.fprintf fmt "lines %d-%d" t.start.line t.stop.line

     

       24
       24
       +
           Format.fprintf fmt "line %d, columns %d-%d" t.start.line t.start.column

     

       25
       25
       +
             t.stop.column

     

       26
       26
       +
         else Format.fprintf fmt "lines %d-%d" t.start.line t.stop.line

     

       31
       27
        
       

     

       32
       32
       -
       let to_string t =

     

       33
       33
       -
         Format.asprintf "%a" pp t

     

       28
       28
       +
       let to_string t = Format.asprintf "%a" pp t

     

       34
       29
        
       

     

       35
       30
        
       let compare a b =

     

       36
       31
        
         let c = Position.compare a.start b.start in

     

       37
       32
        
         if c <> 0 then c else Position.compare a.stop b.stop

     

       38
       33
        
       

     

       39
       39
       -
       let equal a b =

     

       40
       40
       -
         Position.equal a.start b.start && Position.equal a.stop b.stop

     

       34
       34
       +
       let equal a b = Position.equal a.start b.start && Position.equal a.stop b.stop

+35

lib/span.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Source spans representing ranges in input *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = {

     

       9
       9
       +
         start : Position.t;

     

       10
       10
       +
         stop : Position.t;

     

       11
       11
       +
       }

     

       12
       12
       +
       

     

       13
       13
       +
       val make : start:Position.t -> stop:Position.t -> t

     

       14
       14
       +
       (** Create a span from start and stop positions *)

     

       15
       15
       +
       

     

       16
       16
       +
       val point : Position.t -> t

     

       17
       17
       +
       (** Create a zero-width span at a single position *)

     

       18
       18
       +
       

     

       19
       19
       +
       val merge : t -> t -> t

     

       20
       20
       +
       (** Merge two spans into one covering both *)

     

       21
       21
       +
       

     

       22
       22
       +
       val extend : t -> Position.t -> t

     

       23
       23
       +
       (** Extend a span to a new stop position *)

     

       24
       24
       +
       

     

       25
       25
       +
       val pp : Format.formatter -> t -> unit

     

       26
       26
       +
       (** Pretty-print a span *)

     

       27
       27
       +
       

     

       28
       28
       +
       val to_string : t -> string

     

       29
       29
       +
       (** Convert span to string *)

     

       30
       30
       +
       

     

       31
       31
       +
       val compare : t -> t -> int

     

       32
       32
       +
       (** Compare two spans *)

     

       33
       33
       +
       

     

       34
       34
       +
       val equal : t -> t -> bool

     

       35
       35
       +
       (** Test equality of two spans *)

+12 -14

lib/tag.ml

···

       18
       18
        
         | 0 -> None

     

       19
       19
        
         | _ when s.[0] <> '!' -> None

     

       20
       20
        
         | 1 -> Some { handle = "!"; suffix = "" }

     

       21
       21
       -
         | _ ->

     

       21
       21
       +
         | _ -> (

     

       22
       22
        
             match s.[1] with

     

       23
       23
       -
             | '!' -> (* !! handle *)

     

       23
       23
       +
             | '!' ->

     

       24
       24
       +
                 (* !! handle *)

     

       24
       25
        
                 Some { handle = "!!"; suffix = String.sub s 2 (len - 2) }

     

       25
       25
       -
             | '<' -> (* Verbatim tag !<...> *)

     

       26
       26
       +
             | '<' ->

     

       27
       27
       +
                 (* Verbatim tag !<...> *)

     

       26
       28
        
                 if len > 2 && s.[len - 1] = '>' then

     

       27
       29
        
                   Some { handle = "!"; suffix = String.sub s 2 (len - 3) }

     

       28
       28
       -
                 else

     

       29
       29
       -
                   None

     

       30
       30
       -
             | _ -> (* Primary handle or local tag *)

     

       31
       31
       -
                 Some { handle = "!"; suffix = String.sub s 1 (len - 1) }

     

       30
       30
       +
                 else None

     

       31
       31
       +
             | _ ->

     

       32
       32
       +
                 (* Primary handle or local tag *)

     

       33
       33
       +
                 Some { handle = "!"; suffix = String.sub s 1 (len - 1) })

     

       32
       34
        
       

     

       33
       35
        
       let to_string t =

     

       34
       34
       -
         if t.handle = "!" && t.suffix = "" then "!"

     

       35
       35
       -
         else t.handle ^ t.suffix

     

       36
       36
       +
         if t.handle = "!" && t.suffix = "" then "!" else t.handle ^ t.suffix

     

       36
       37
        
       

     

       37
       38
        
       let to_uri t =

     

       38
       39
        
         match t.handle with

     
···

       40
       41
        
         | "!" -> "!" ^ t.suffix

     

       41
       42
        
         | h -> h ^ t.suffix

     

       42
       43
        
       

     

       43
       43
       -
       let pp fmt t =

     

       44
       44
       -
         Format.pp_print_string fmt (to_string t)

     

       45
       45
       -
       

     

       46
       46
       -
       let equal a b =

     

       47
       47
       -
         String.equal a.handle b.handle && String.equal a.suffix b.suffix

     

       44
       44
       +
       let pp fmt t = Format.pp_print_string fmt (to_string t)

     

       45
       45
       +
       let equal a b = String.equal a.handle b.handle && String.equal a.suffix b.suffix

     

       48
       46
        
       

     

       49
       47
        
       let compare a b =

     

       50
       48
        
         let c = String.compare a.handle b.handle in

+54

lib/tag.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML tags for type information *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = {

     

       9
       9
       +
         handle : string;  (** e.g., "!" or "!!" or "!foo!" *)

     

       10
       10
       +
         suffix : string;  (** e.g., "str", "int", "custom/type" *)

     

       11
       11
       +
       }

     

       12
       12
       +
       

     

       13
       13
       +
       val make : handle:string -> suffix:string -> t

     

       14
       14
       +
       (** Create a tag from handle and suffix *)

     

       15
       15
       +
       

     

       16
       16
       +
       val of_string : string -> t option

     

       17
       17
       +
       (** Parse a tag string *)

     

       18
       18
       +
       

     

       19
       19
       +
       val to_string : t -> string

     

       20
       20
       +
       (** Convert tag to string representation *)

     

       21
       21
       +
       

     

       22
       22
       +
       val to_uri : t -> string

     

       23
       23
       +
       (** Convert tag to full URI representation *)

     

       24
       24
       +
       

     

       25
       25
       +
       val pp : Format.formatter -> t -> unit

     

       26
       26
       +
       (** Pretty-print a tag *)

     

       27
       27
       +
       

     

       28
       28
       +
       val equal : t -> t -> bool

     

       29
       29
       +
       (** Test equality of two tags *)

     

       30
       30
       +
       

     

       31
       31
       +
       val compare : t -> t -> int

     

       32
       32
       +
       (** Compare two tags *)

     

       33
       33
       +
       

     

       34
       34
       +
       (** {2 Standard Tags} *)

     

       35
       35
       +
       

     

       36
       36
       +
       val null : t

     

       37
       37
       +
       val bool : t

     

       38
       38
       +
       val int : t

     

       39
       39
       +
       val float : t

     

       40
       40
       +
       val str : t

     

       41
       41
       +
       val seq : t

     

       42
       42
       +
       val map : t

     

       43
       43
       +
       val binary : t

     

       44
       44
       +
       val timestamp : t

     

       45
       45
       +
       

     

       46
       46
       +
       (** {2 Tag Predicates} *)

     

       47
       47
       +
       

     

       48
       48
       +
       val is_null : t -> bool

     

       49
       49
       +
       val is_bool : t -> bool

     

       50
       50
       +
       val is_int : t -> bool

     

       51
       51
       +
       val is_float : t -> bool

     

       52
       52
       +
       val is_str : t -> bool

     

       53
       53
       +
       val is_seq : t -> bool

     

       54
       54
       +
       val is_map : t -> bool

+30 -51

lib/token.ml

···

       10
       10
        
         | Stream_end

     

       11
       11
        
         | Version_directive of { major : int; minor : int }

     

       12
       12
        
         | Tag_directive of { handle : string; prefix : string }

     

       13
       13
       -
         | Document_start    (** --- *)

     

       14
       14
       -
         | Document_end      (** ... *)

     

       13
       13
       +
         | Document_start  (** --- *)

     

       14
       14
       +
         | Document_end  (** ... *)

     

       15
       15
        
         | Block_sequence_start

     

       16
       16
        
         | Block_mapping_start

     

       17
       17
       -
         | Block_entry       (** [-] *)

     

       18
       18
       -
         | Block_end         (** implicit, from dedent *)

     

       17
       17
       +
         | Block_entry  (** [-] *)

     

       18
       18
       +
         | Block_end  (** implicit, from dedent *)

     

       19
       19
        
         | Flow_sequence_start  (** \[ *)

     

       20
       20
       -
         | Flow_sequence_end    (** \] *)

     

       21
       21
       -
         | Flow_mapping_start   (** \{ *)

     

       22
       22
       -
         | Flow_mapping_end     (** \} *)

     

       23
       23
       -
         | Flow_entry        (** [,] *)

     

       24
       24
       -
         | Key               (** ? or implicit key *)

     

       25
       25
       -
         | Value             (** : *)

     

       20
       20
       +
         | Flow_sequence_end  (** \] *)

     

       21
       21
       +
         | Flow_mapping_start  (** \{ *)

     

       22
       22
       +
         | Flow_mapping_end  (** \} *)

     

       23
       23
       +
         | Flow_entry  (** [,] *)

     

       24
       24
       +
         | Key  (** ? or implicit key *)

     

       25
       25
       +
         | Value  (** : *)

     

       26
       26
        
         | Anchor of string  (** &name *)

     

       27
       27
       -
         | Alias of string   (** *name *)

     

       27
       27
       +
         | Alias of string  (** *name *)

     

       28
       28
        
         | Tag of { handle : string; suffix : string }

     

       29
       29
        
         | Scalar of { style : Scalar_style.t; value : string }

     

       30
       30
        
       

     

       31
       31
       -
       type spanned = {

     

       32
       32
       -
         token : t;

     

       33
       33
       -
         span : Span.t;

     

       34
       34
       -
       }

     

       31
       31
       +
       type spanned = { token : t; span : Span.t }

     

       35
       32
        
       

     

       36
       33
        
       let pp_token fmt = function

     

       37
       37
       -
         | Stream_start enc ->

     

       38
       38
       -
             Format.fprintf fmt "STREAM-START(%a)" Encoding.pp enc

     

       39
       39
       -
         | Stream_end ->

     

       40
       40
       -
             Format.fprintf fmt "STREAM-END"

     

       34
       34
       +
         | Stream_start enc -> Format.fprintf fmt "STREAM-START(%a)" Encoding.pp enc

     

       35
       35
       +
         | Stream_end -> Format.fprintf fmt "STREAM-END"

     

       41
       36
        
         | Version_directive { major; minor } ->

     

       42
       37
        
             Format.fprintf fmt "VERSION-DIRECTIVE(%d.%d)" major minor

     

       43
       38
        
         | Tag_directive { handle; prefix } ->

     

       44
       39
        
             Format.fprintf fmt "TAG-DIRECTIVE(%s, %s)" handle prefix

     

       45
       45
       -
         | Document_start ->

     

       46
       46
       -
             Format.fprintf fmt "DOCUMENT-START"

     

       47
       47
       -
         | Document_end ->

     

       48
       48
       -
             Format.fprintf fmt "DOCUMENT-END"

     

       49
       49
       -
         | Block_sequence_start ->

     

       50
       50
       -
             Format.fprintf fmt "BLOCK-SEQUENCE-START"

     

       51
       51
       -
         | Block_mapping_start ->

     

       52
       52
       -
             Format.fprintf fmt "BLOCK-MAPPING-START"

     

       53
       53
       -
         | Block_entry ->

     

       54
       54
       -
             Format.fprintf fmt "BLOCK-ENTRY"

     

       55
       55
       -
         | Block_end ->

     

       56
       56
       -
             Format.fprintf fmt "BLOCK-END"

     

       57
       57
       -
         | Flow_sequence_start ->

     

       58
       58
       -
             Format.fprintf fmt "FLOW-SEQUENCE-START"

     

       59
       59
       -
         | Flow_sequence_end ->

     

       60
       60
       -
             Format.fprintf fmt "FLOW-SEQUENCE-END"

     

       61
       61
       -
         | Flow_mapping_start ->

     

       62
       62
       -
             Format.fprintf fmt "FLOW-MAPPING-START"

     

       63
       63
       -
         | Flow_mapping_end ->

     

       64
       64
       -
             Format.fprintf fmt "FLOW-MAPPING-END"

     

       65
       65
       -
         | Flow_entry ->

     

       66
       66
       -
             Format.fprintf fmt "FLOW-ENTRY"

     

       67
       67
       -
         | Key ->

     

       68
       68
       -
             Format.fprintf fmt "KEY"

     

       69
       69
       -
         | Value ->

     

       70
       70
       -
             Format.fprintf fmt "VALUE"

     

       71
       71
       -
         | Anchor name ->

     

       72
       72
       -
             Format.fprintf fmt "ANCHOR(%s)" name

     

       73
       73
       -
         | Alias name ->

     

       74
       74
       -
             Format.fprintf fmt "ALIAS(%s)" name

     

       75
       75
       -
         | Tag { handle; suffix } ->

     

       76
       76
       -
             Format.fprintf fmt "TAG(%s, %s)" handle suffix

     

       40
       40
       +
         | Document_start -> Format.fprintf fmt "DOCUMENT-START"

     

       41
       41
       +
         | Document_end -> Format.fprintf fmt "DOCUMENT-END"

     

       42
       42
       +
         | Block_sequence_start -> Format.fprintf fmt "BLOCK-SEQUENCE-START"

     

       43
       43
       +
         | Block_mapping_start -> Format.fprintf fmt "BLOCK-MAPPING-START"

     

       44
       44
       +
         | Block_entry -> Format.fprintf fmt "BLOCK-ENTRY"

     

       45
       45
       +
         | Block_end -> Format.fprintf fmt "BLOCK-END"

     

       46
       46
       +
         | Flow_sequence_start -> Format.fprintf fmt "FLOW-SEQUENCE-START"

     

       47
       47
       +
         | Flow_sequence_end -> Format.fprintf fmt "FLOW-SEQUENCE-END"

     

       48
       48
       +
         | Flow_mapping_start -> Format.fprintf fmt "FLOW-MAPPING-START"

     

       49
       49
       +
         | Flow_mapping_end -> Format.fprintf fmt "FLOW-MAPPING-END"

     

       50
       50
       +
         | Flow_entry -> Format.fprintf fmt "FLOW-ENTRY"

     

       51
       51
       +
         | Key -> Format.fprintf fmt "KEY"

     

       52
       52
       +
         | Value -> Format.fprintf fmt "VALUE"

     

       53
       53
       +
         | Anchor name -> Format.fprintf fmt "ANCHOR(%s)" name

     

       54
       54
       +
         | Alias name -> Format.fprintf fmt "ALIAS(%s)" name

     

       55
       55
       +
         | Tag { handle; suffix } -> Format.fprintf fmt "TAG(%s, %s)" handle suffix

     

       77
       56
        
         | Scalar { style; value } ->

     

       78
       57
        
             Format.fprintf fmt "SCALAR(%a, %S)" Scalar_style.pp style value

     

       79
       58

+43

lib/token.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** YAML token types produced by the scanner *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t =

     

       9
       9
       +
         | Stream_start of Encoding.t

     

       10
       10
       +
         | Stream_end

     

       11
       11
       +
         | Version_directive of { major : int; minor : int }

     

       12
       12
       +
         | Tag_directive of { handle : string; prefix : string }

     

       13
       13
       +
         | Document_start    (** --- *)

     

       14
       14
       +
         | Document_end      (** ... *)

     

       15
       15
       +
         | Block_sequence_start

     

       16
       16
       +
         | Block_mapping_start

     

       17
       17
       +
         | Block_entry       (** - *)

     

       18
       18
       +
         | Block_end         (** implicit, from dedent *)

     

       19
       19
       +
         | Flow_sequence_start  (** \[ *)

     

       20
       20
       +
         | Flow_sequence_end    (** \] *)

     

       21
       21
       +
         | Flow_mapping_start   (** \{ *)

     

       22
       22
       +
         | Flow_mapping_end     (** \} *)

     

       23
       23
       +
         | Flow_entry        (** , *)

     

       24
       24
       +
         | Key               (** ? or implicit key *)

     

       25
       25
       +
         | Value             (** : *)

     

       26
       26
       +
         | Anchor of string  (** &name *)

     

       27
       27
       +
         | Alias of string   (** *name *)

     

       28
       28
       +
         | Tag of { handle : string; suffix : string }

     

       29
       29
       +
         | Scalar of { style : Scalar_style.t; value : string }

     

       30
       30
       +
       

     

       31
       31
       +
       type spanned = {

     

       32
       32
       +
         token : t;

     

       33
       33
       +
         span : Span.t;

     

       34
       34
       +
       }

     

       35
       35
       +
       

     

       36
       36
       +
       val pp_token : Format.formatter -> t -> unit

     

       37
       37
       +
       (** Pretty-print a token *)

     

       38
       38
       +
       

     

       39
       39
       +
       val pp : Format.formatter -> t -> unit

     

       40
       40
       +
       (** Pretty-print a token (alias for pp_token) *)

     

       41
       41
       +
       

     

       42
       42
       +
       val pp_spanned : Format.formatter -> spanned -> unit

     

       43
       43
       +
       (** Pretty-print a spanned token *)

+38 -66

lib/unix/yamlrw_unix.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Yamlrw Unix - Channel and file I/O for YAML

     

       7
       7
        
       

     

       8
       8
       -
           This module provides channel and file operations for parsing

     

       9
       9
       -
           and emitting YAML using bytesrw for efficient streaming I/O. *)

     

       8
       8
       +
           This module provides channel and file operations for parsing and emitting

     

       9
       9
       +
           YAML using bytesrw for efficient streaming I/O. *)

     

       10
       10
        
       

     

       11
       11
        
       open Bytesrw

     

       12
       12
        
       open Yamlrw

     
···

       19
       19
        
       

     

       20
       20
        
       (** {1 Channel Input} *)

     

       21
       21
        
       

     

       22
       22
       -
       let value_of_channel

     

       23
       23
       -
           ?(resolve_aliases = true)

     

       22
       22
       +
       let value_of_channel ?(resolve_aliases = true)

     

       24
       23
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       25
       25
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       26
       26
       -
           ic =

     

       24
       24
       +
           ?(max_depth = Yaml.default_max_alias_depth) ic =

     

       27
       25
        
         let reader = Bytes.Reader.of_in_channel ic in

     

       28
       26
        
         Loader.value_of_reader ~resolve_aliases ~max_nodes ~max_depth reader

     

       29
       27
        
       

     

       30
       30
       -
       let yaml_of_channel

     

       31
       31
       -
           ?(resolve_aliases = false)

     

       28
       28
       +
       let yaml_of_channel ?(resolve_aliases = false)

     

       32
       29
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       33
       33
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       34
       34
       -
           ic =

     

       30
       30
       +
           ?(max_depth = Yaml.default_max_alias_depth) ic =

     

       35
       31
        
         let reader = Bytes.Reader.of_in_channel ic in

     

       36
       32
        
         Loader.yaml_of_reader ~resolve_aliases ~max_nodes ~max_depth reader

     

       37
       33
        
       

     
···

       41
       37
        
       

     

       42
       38
        
       (** {1 Channel Output} *)

     

       43
       39
        
       

     

       44
       44
       -
       let value_to_channel

     

       45
       45
       -
           ?(encoding = `Utf8)

     

       46
       46
       -
           ?(scalar_style = `Any)

     

       47
       47
       -
           ?(layout_style = `Any)

     

       48
       48
       -
           oc

     

       49
       49
       -
           (v : value) =

     

       50
       50
       -
         let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       40
       40
       +
       let value_to_channel ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       41
       41
       +
           ?(layout_style = `Any) oc (v : value) =

     

       42
       42
       +
         let config =

     

       43
       43
       +
           { Emitter.default_config with encoding; scalar_style; layout_style }

     

       44
       44
       +
         in

     

       51
       45
        
         let writer = Bytes.Writer.of_out_channel oc in

     

       52
       46
        
         Serialize.value_to_writer ~config writer v

     

       53
       47
        
       

     

       54
       54
       -
       let yaml_to_channel

     

       55
       55
       -
           ?(encoding = `Utf8)

     

       56
       56
       -
           ?(scalar_style = `Any)

     

       57
       57
       -
           ?(layout_style = `Any)

     

       58
       58
       -
           oc

     

       59
       59
       -
           (v : yaml) =

     

       60
       60
       -
         let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       48
       48
       +
       let yaml_to_channel ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       49
       49
       +
           ?(layout_style = `Any) oc (v : yaml) =

     

       50
       50
       +
         let config =

     

       51
       51
       +
           { Emitter.default_config with encoding; scalar_style; layout_style }

     

       52
       52
       +
         in

     

       61
       53
        
         let writer = Bytes.Writer.of_out_channel oc in

     

       62
       54
        
         Serialize.yaml_to_writer ~config writer v

     

       63
       55
        
       

     

       64
       64
       -
       let documents_to_channel

     

       65
       65
       -
           ?(encoding = `Utf8)

     

       66
       66
       -
           ?(scalar_style = `Any)

     

       67
       67
       -
           ?(layout_style = `Any)

     

       68
       68
       -
           ?(resolve_aliases = true)

     

       69
       69
       -
           oc

     

       70
       70
       -
           docs =

     

       71
       71
       -
         let config = { Emitter.default_config with encoding; scalar_style; layout_style } in

     

       56
       56
       +
       let documents_to_channel ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       57
       57
       +
           ?(layout_style = `Any) ?(resolve_aliases = true) oc docs =

     

       58
       58
       +
         let config =

     

       59
       59
       +
           { Emitter.default_config with encoding; scalar_style; layout_style }

     

       60
       60
       +
         in

     

       72
       61
        
         let writer = Bytes.Writer.of_out_channel oc in

     

       73
       62
        
         Serialize.documents_to_writer ~config ~resolve_aliases writer docs

     

       74
       63
        
       

     

       75
       64
        
       (** {1 File Input} *)

     

       76
       65
        
       

     

       77
       77
       -
       let value_of_file

     

       78
       78
       -
           ?(resolve_aliases = true)

     

       66
       66
       +
       let value_of_file ?(resolve_aliases = true)

     

       79
       67
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       80
       80
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       81
       81
       -
           path =

     

       68
       68
       +
           ?(max_depth = Yaml.default_max_alias_depth) path =

     

       82
       69
        
         In_channel.with_open_bin path (fun ic ->

     

       83
       83
       -
           value_of_channel ~resolve_aliases ~max_nodes ~max_depth ic)

     

       70
       70
       +
             value_of_channel ~resolve_aliases ~max_nodes ~max_depth ic)

     

       84
       71
        
       

     

       85
       85
       -
       let yaml_of_file

     

       86
       86
       -
           ?(resolve_aliases = false)

     

       72
       72
       +
       let yaml_of_file ?(resolve_aliases = false)

     

       87
       73
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       88
       88
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       89
       89
       -
           path =

     

       74
       74
       +
           ?(max_depth = Yaml.default_max_alias_depth) path =

     

       90
       75
        
         In_channel.with_open_bin path (fun ic ->

     

       91
       91
       -
           yaml_of_channel ~resolve_aliases ~max_nodes ~max_depth ic)

     

       76
       76
       +
             yaml_of_channel ~resolve_aliases ~max_nodes ~max_depth ic)

     

       92
       77
        
       

     

       93
       93
       -
       let documents_of_file path =

     

       94
       94
       -
         In_channel.with_open_bin path documents_of_channel

     

       78
       78
       +
       let documents_of_file path = In_channel.with_open_bin path documents_of_channel

     

       95
       79
        
       

     

       96
       80
        
       (** {1 File Output} *)

     

       97
       81
        
       

     

       98
       98
       -
       let value_to_file

     

       99
       99
       -
           ?(encoding = `Utf8)

     

       100
       100
       -
           ?(scalar_style = `Any)

     

       101
       101
       -
           ?(layout_style = `Any)

     

       102
       102
       -
           path

     

       103
       103
       -
           v =

     

       82
       82
       +
       let value_to_file ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       83
       83
       +
           ?(layout_style = `Any) path v =

     

       104
       84
        
         Out_channel.with_open_bin path (fun oc ->

     

       105
       105
       -
           value_to_channel ~encoding ~scalar_style ~layout_style oc v)

     

       85
       85
       +
             value_to_channel ~encoding ~scalar_style ~layout_style oc v)

     

       106
       86
        
       

     

       107
       107
       -
       let yaml_to_file

     

       108
       108
       -
           ?(encoding = `Utf8)

     

       109
       109
       -
           ?(scalar_style = `Any)

     

       110
       110
       -
           ?(layout_style = `Any)

     

       111
       111
       -
           path

     

       112
       112
       -
           v =

     

       87
       87
       +
       let yaml_to_file ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       88
       88
       +
           ?(layout_style = `Any) path v =

     

       113
       89
        
         Out_channel.with_open_bin path (fun oc ->

     

       114
       114
       -
           yaml_to_channel ~encoding ~scalar_style ~layout_style oc v)

     

       90
       90
       +
             yaml_to_channel ~encoding ~scalar_style ~layout_style oc v)

     

       115
       91
        
       

     

       116
       116
       -
       let documents_to_file

     

       117
       117
       -
           ?(encoding = `Utf8)

     

       118
       118
       -
           ?(scalar_style = `Any)

     

       119
       119
       -
           ?(layout_style = `Any)

     

       120
       120
       -
           ?(resolve_aliases = true)

     

       121
       121
       -
           path

     

       122
       122
       -
           docs =

     

       92
       92
       +
       let documents_to_file ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       93
       93
       +
           ?(layout_style = `Any) ?(resolve_aliases = true) path docs =

     

       123
       94
        
         Out_channel.with_open_bin path (fun oc ->

     

       124
       124
       -
           documents_to_channel ~encoding ~scalar_style ~layout_style ~resolve_aliases oc docs)

     

       95
       95
       +
             documents_to_channel ~encoding ~scalar_style ~layout_style

     

       96
       96
       +
               ~resolve_aliases oc docs)

+4 -12

lib/unix/yamlrw_unix.mli

···

       5
       5
        
       

     

       6
       6
        
       (** Yamlrw Unix - Channel and file I/O for YAML

     

       7
       7
        
       

     

       8
       8
       -
           This module provides channel and file operations for parsing

     

       9
       9
       -
           and emitting YAML using bytesrw for efficient streaming I/O. *)

     

       8
       8
       +
           This module provides channel and file operations for parsing and emitting

     

       9
       9
       +
           YAML using bytesrw for efficient streaming I/O. *)

     

       10
       10
        
       

     

       11
       11
        
       (** {1 Types} *)

     

       12
       12
        
       

     
···

       76
       76
        
       (** {1 File Input} *)

     

       77
       77
        
       

     

       78
       78
        
       val value_of_file :

     

       79
       79
       -
         ?resolve_aliases:bool ->

     

       80
       80
       -
         ?max_nodes:int ->

     

       81
       81
       -
         ?max_depth:int ->

     

       82
       82
       -
         string ->

     

       83
       83
       -
         value

     

       79
       79
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> string -> value

     

       84
       80
        
       (** Parse a JSON-compatible value from a file. *)

     

       85
       81
        
       

     

       86
       82
        
       val yaml_of_file :

     

       87
       87
       -
         ?resolve_aliases:bool ->

     

       88
       88
       -
         ?max_nodes:int ->

     

       89
       89
       -
         ?max_depth:int ->

     

       90
       90
       -
         string ->

     

       91
       91
       -
         yaml

     

       83
       83
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> string -> yaml

     

       92
       84
        
       (** Parse a full YAML value from a file. *)

     

       93
       85
        
       

     

       94
       86
        
       val documents_of_file : string -> document list

+16 -20

lib/value.ml

···

       5
       5
        
       

     

       6
       6
        
       (** JSON-compatible YAML value representation *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = [

     

       9
       9
       -
         | `Null

     

       8
       8
       +
       type t =

     

       9
       9
       +
         [ `Null

     

       10
       10
        
         | `Bool of bool

     

       11
       11
        
         | `Float of float

     

       12
       12
        
         | `String of string

     

       13
       13
        
         | `A of t list

     

       14
       14
       -
         | `O of (string * t) list

     

       15
       15
       -
       ]

     

       14
       14
       +
         | `O of (string * t) list ]

     

       16
       15
        
       

     

       17
       16
        
       (* Type equality is ensured by structural compatibility with Yamlrw.value *)

     

       18
       17
        
       

     
···

       23
       22
        
       let int n : t = `Float (Float.of_int n)

     

       24
       23
        
       let float f : t = `Float f

     

       25
       24
        
       let string s : t = `String s

     

       26
       26
       -
       

     

       27
       25
        
       let list f xs : t = `A (List.map f xs)

     

       28
       26
        
       let obj pairs : t = `O pairs

     

       29
       27
        
       

     
···

       72
       70
        
         | `O pairs -> List.exists (fun (k, _) -> k = key) pairs

     

       73
       71
        
         | _ -> false

     

       74
       72
        
       

     

       75
       75
       -
       let find key = function

     

       76
       76
       -
         | `O pairs -> List.assoc_opt key pairs

     

       77
       77
       -
         | _ -> None

     

       73
       73
       +
       let find key = function `O pairs -> List.assoc_opt key pairs | _ -> None

     

       78
       74
        
       

     

       79
       75
        
       let get key v =

     

       80
       80
       -
         match find key v with

     

       81
       81
       -
         | Some v -> v

     

       82
       82
       -
         | None -> Error.raise (Key_not_found key)

     

       76
       76
       +
         match find key v with Some v -> v | None -> Error.raise (Key_not_found key)

     

       83
       77
        
       

     

       84
       78
        
       let keys = function

     

       85
       79
        
         | `O pairs -> List.map fst pairs

     
···

       92
       86
        
       (** Combinators *)

     

       93
       87
        
       

     

       94
       88
        
       let combine v1 v2 =

     

       95
       95
       -
         match v1, v2 with

     

       89
       89
       +
         match (v1, v2) with

     

       96
       90
        
         | `O o1, `O o2 -> `O (o1 @ o2)

     

       97
       91
        
         | v1, _ -> Error.raise (Type_mismatch ("object", type_name v1))

     

       98
       92
        
       

     
···

       113
       107
        
         | `Float f ->

     

       114
       108
        
             if Float.is_integer f && Float.abs f < 1e15 then

     

       115
       109
        
               Format.fprintf fmt "%.0f" f

     

       116
       116
       -
             else

     

       117
       117
       -
               Format.fprintf fmt "%g" f

     

       110
       110
       +
             else Format.fprintf fmt "%g" f

     

       118
       111
        
         | `String s -> Format.fprintf fmt "%S" s

     

       119
       112
        
         | `A [] -> Format.pp_print_string fmt "[]"

     

       120
       113
        
         | `A items ->

     

       121
       114
        
             Format.fprintf fmt "@[<hv 2>[@,%a@]@,]"

     

       122
       122
       -
               (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") pp)

     

       115
       115
       +
               (Format.pp_print_list

     

       116
       116
       +
                  ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")

     

       117
       117
       +
                  pp)

     

       123
       118
        
               items

     

       124
       119
        
         | `O [] -> Format.pp_print_string fmt "{}"

     

       125
       120
        
         | `O pairs ->

     

       126
       121
        
             Format.fprintf fmt "@[<hv 2>{@,%a@]@,}"

     

       127
       127
       -
               (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")

     

       122
       122
       +
               (Format.pp_print_list

     

       123
       123
       +
                  ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")

     

       128
       124
        
                  (fun fmt (k, v) -> Format.fprintf fmt "@[<hv 2>%S:@ %a@]" k pp v))

     

       129
       125
        
               pairs

     

       130
       126
        
       

     

       131
       127
        
       (** Equality and comparison *)

     

       132
       128
        
       

     

       133
       129
        
       let rec equal (a : t) (b : t) =

     

       134
       134
       -
         match a, b with

     

       130
       130
       +
         match (a, b) with

     

       135
       131
        
         | `Null, `Null -> true

     

       136
       132
        
         | `Bool a, `Bool b -> a = b

     

       137
       133
        
         | `Float a, `Float b -> Float.equal a b

     

       138
       134
        
         | `String a, `String b -> String.equal a b

     

       139
       135
        
         | `A a, `A b -> List.equal equal a b

     

       140
       136
        
         | `O a, `O b ->

     

       141
       141
       -
             List.length a = List.length b &&

     

       142
       142
       -
             List.for_all2 (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2) a b

     

       137
       137
       +
             List.length a = List.length b

     

       138
       138
       +
             && List.for_all2 (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2) a b

     

       143
       139
        
         | _ -> false

     

       144
       140
        
       

     

       145
       141
        
       let rec compare (a : t) (b : t) =

     

       146
       146
       -
         match a, b with

     

       142
       142
       +
         match (a, b) with

     

       147
       143
        
         | `Null, `Null -> 0

     

       148
       144
        
         | `Null, _ -> -1

     

       149
       145
        
         | _, `Null -> 1

+70

lib/value.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** JSON-compatible YAML value representation *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = [

     

       9
       9
       +
         | `Null

     

       10
       10
       +
         | `Bool of bool

     

       11
       11
       +
         | `Float of float

     

       12
       12
       +
         | `String of string

     

       13
       13
       +
         | `A of t list

     

       14
       14
       +
         | `O of (string * t) list

     

       15
       15
       +
       ]

     

       16
       16
       +
       

     

       17
       17
       +
       (** {2 Constructors} *)

     

       18
       18
       +
       

     

       19
       19
       +
       val null : t

     

       20
       20
       +
       val bool : bool -> t

     

       21
       21
       +
       val int : int -> t

     

       22
       22
       +
       val float : float -> t

     

       23
       23
       +
       val string : string -> t

     

       24
       24
       +
       val list : ('a -> t) -> 'a list -> t

     

       25
       25
       +
       val obj : (string * t) list -> t

     

       26
       26
       +
       

     

       27
       27
       +
       (** {2 Type Name} *)

     

       28
       28
       +
       

     

       29
       29
       +
       val type_name : t -> string

     

       30
       30
       +
       (** Get the type name for error messages *)

     

       31
       31
       +
       

     

       32
       32
       +
       (** {2 Safe Accessors} *)

     

       33
       33
       +
       

     

       34
       34
       +
       val as_null : t -> unit option

     

       35
       35
       +
       val as_bool : t -> bool option

     

       36
       36
       +
       val as_float : t -> float option

     

       37
       37
       +
       val as_string : t -> string option

     

       38
       38
       +
       val as_list : t -> t list option

     

       39
       39
       +
       val as_assoc : t -> (string * t) list option

     

       40
       40
       +
       val as_int : t -> int option

     

       41
       41
       +
       

     

       42
       42
       +
       (** {2 Unsafe Accessors} *)

     

       43
       43
       +
       

     

       44
       44
       +
       val to_null : t -> unit

     

       45
       45
       +
       val to_bool : t -> bool

     

       46
       46
       +
       val to_float : t -> float

     

       47
       47
       +
       val to_string : t -> string

     

       48
       48
       +
       val to_list : t -> t list

     

       49
       49
       +
       val to_assoc : t -> (string * t) list

     

       50
       50
       +
       val to_int : t -> int

     

       51
       51
       +
       

     

       52
       52
       +
       (** {2 Object Access} *)

     

       53
       53
       +
       

     

       54
       54
       +
       val mem : string -> t -> bool

     

       55
       55
       +
       val find : string -> t -> t option

     

       56
       56
       +
       val get : string -> t -> t

     

       57
       57
       +
       val keys : t -> string list

     

       58
       58
       +
       val values : t -> t list

     

       59
       59
       +
       

     

       60
       60
       +
       (** {2 Combinators} *)

     

       61
       61
       +
       

     

       62
       62
       +
       val combine : t -> t -> t

     

       63
       63
       +
       val map : (t -> t) -> t -> t

     

       64
       64
       +
       val filter : (t -> bool) -> t -> t

     

       65
       65
       +
       

     

       66
       66
       +
       (** {2 Comparison} *)

     

       67
       67
       +
       

     

       68
       68
       +
       val pp : Format.formatter -> t -> unit

     

       69
       69
       +
       val equal : t -> t -> bool

     

       70
       70
       +
       val compare : t -> t -> int

+118 -111

lib/yaml.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Full YAML representation with anchors, tags, and aliases *)

     

       7
       7
        
       

     

       8
       8
       -
       type t = [

     

       9
       9
       -
         | `Scalar of Scalar.t

     

       8
       8
       +
       type t =

     

       9
       9
       +
         [ `Scalar of Scalar.t

     

       10
       10
        
         | `Alias of string

     

       11
       11
        
         | `A of t Sequence.t

     

       12
       12
       -
         | `O of (t, t) Mapping.t

     

       13
       13
       -
       ]

     

       12
       12
       +
         | `O of (t, t) Mapping.t ]

     

       14
       13
        
       

     

       15
       14
        
       (** Pretty printing *)

     

       16
       15
        
       

     
···

       24
       23
        
       (** Equality *)

     

       25
       24
        
       

     

       26
       25
        
       let rec equal (a : t) (b : t) =

     

       27
       27
       -
         match a, b with

     

       26
       26
       +
         match (a, b) with

     

       28
       27
        
         | `Scalar a, `Scalar b -> Scalar.equal a b

     

       29
       28
        
         | `Alias a, `Alias b -> String.equal a b

     

       30
       29
        
         | `A a, `A b -> Sequence.equal equal a b

     
···

       40
       39
        
         | `Bool false -> `Scalar (Scalar.make "false")

     

       41
       40
        
         | `Float f ->

     

       42
       41
        
             let s =

     

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

     

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

     

       45
       45
       -
               else

     

       46
       46
       -
                 Printf.sprintf "%g" f

     

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

     

       43
       43
       +
               else Printf.sprintf "%g" f

     

       47
       44
        
             in

     

       48
       45
        
             `Scalar (Scalar.make s)

     

       49
       49
       -
         | `String s ->

     

       50
       50
       -
             `Scalar (Scalar.make s ~style:`Double_quoted)

     

       51
       51
       -
         | `A items ->

     

       52
       52
       -
             `A (Sequence.make (List.map of_value items))

     

       46
       46
       +
         | `String s -> `Scalar (Scalar.make s ~style:`Double_quoted)

     

       47
       47
       +
         | `A items -> `A (Sequence.make (List.map of_value items))

     

       53
       48
        
         | `O pairs ->

     

       54
       54
       -
             `O (Mapping.make (List.map (fun (k, v) ->

     

       55
       55
       -
               (`Scalar (Scalar.make k), of_value v)

     

       56
       56
       -
             ) pairs))

     

       49
       49
       +
             `O

     

       50
       50
       +
               (Mapping.make

     

       51
       51
       +
                  (List.map

     

       52
       52
       +
                     (fun (k, v) -> (`Scalar (Scalar.make k), of_value v))

     

       53
       53
       +
                     pairs))

     

       57
       54
        
       

     

       58
       58
       -
       (** Default limits for alias expansion (protection against billion laughs attack) *)

     

       55
       55
       +
       (** Default limits for alias expansion (protection against billion laughs

     

       56
       56
       +
           attack) *)

     

       59
       57
        
       let default_max_alias_nodes = 10_000_000

     

       58
       58
       +
       

     

       60
       59
        
       let default_max_alias_depth = 100

     

       61
       60
        
       

     

       62
       61
        
       (** Resolve aliases by replacing them with referenced nodes.

     

       63
       62
        
       

     

       64
       64
       -
           Processes the tree in document order so that aliases resolve to the

     

       65
       65
       -
           anchor value that was defined at the point the alias was encountered.

     

       63
       63
       +
           Processes the tree in document order so that aliases resolve to the anchor

     

       64
       64
       +
           value that was defined at the point the alias was encountered.

     

       66
       65
        
       

     

       67
       67
       -
           See {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2

     

       68
       68
       -
           (Anchors and Aliases)} of the YAML 1.2.2 specification for details on

     

       69
       69
       -
           how anchors and aliases work in YAML.

     

       66
       66
       +
           See

     

       67
       67
       +
           {{:https://yaml.org/spec/1.2.2/#3222-anchors-and-aliases}Section 3.2.2.2

     

       68
       68
       +
            (Anchors and Aliases)} of the YAML 1.2.2 specification for details on how

     

       69
       69
       +
           anchors and aliases work in YAML.

     

       70
       70
        
       

     

       71
       71
       -
           This implements protection against the "billion laughs attack"

     

       72
       72
       -
           (see {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1 (Processes)})

     

       73
       73
       -
           by limiting both the total number of nodes and the nesting depth during expansion.

     

       71
       71
       +
           This implements protection against the "billion laughs attack" (see

     

       72
       72
       +
           {{:https://yaml.org/spec/1.2.2/#321-processes}Section 3.2.1 (Processes)}) by

     

       73
       73
       +
           limiting both the total number of nodes and the nesting depth during

     

       74
       74
       +
           expansion.

     

       74
       75
        
       

     

       75
       75
       -
           @param max_nodes Maximum number of nodes to create during expansion (default 10M)

     

       76
       76
       -
           @param max_depth Maximum depth of alias-within-alias resolution (default 100)

     

       77
       77
       -
           @raise Error.Yamlrw_error with {!type:Error.kind} [Alias_expansion_node_limit] if max_nodes is exceeded

     

       78
       78
       -
           @raise Error.Yamlrw_error with {!type:Error.kind} [Alias_expansion_depth_limit] if max_depth is exceeded

     

       79
       79
       -
       *)

     

       80
       80
       -
       let resolve_aliases ?(max_nodes = default_max_alias_nodes) ?(max_depth = default_max_alias_depth) (root : t) : t =

     

       76
       76
       +
           @param max_nodes

     

       77
       77
       +
             Maximum number of nodes to create during expansion (default 10M)

     

       78
       78
       +
           @param max_depth

     

       79
       79
       +
             Maximum depth of alias-within-alias resolution (default 100)

     

       80
       80
       +
           @raise Error.Yamlrw_error

     

       81
       81
       +
             with {!type:Error.kind} [Alias_expansion_node_limit] if max_nodes is

     

       82
       82
       +
             exceeded

     

       83
       83
       +
           @raise Error.Yamlrw_error

     

       84
       84
       +
             with {!type:Error.kind} [Alias_expansion_depth_limit] if max_depth is

     

       85
       85
       +
             exceeded *)

     

       86
       86
       +
       let resolve_aliases ?(max_nodes = default_max_alias_nodes)

     

       87
       87
       +
           ?(max_depth = default_max_alias_depth) (root : t) : t =

     

       81
       88
        
         let anchors = Hashtbl.create 16 in

     

       82
       89
        
         let node_count = ref 0 in

     

       83
       90
        
       

     
···

       103
       110
        
                  need expansion if it was registered before those anchors existed *)

     

       104
       111
        
               resolve ~depth:(depth + 1) target

     

       105
       112
        
           | None -> Error.raise (Undefined_alias name)

     

       106
       106
       -
       

     

       107
       113
        
         (* Single pass: process in document order, registering anchors and resolving aliases *)

     

       108
       114
        
         and resolve ~depth (v : t) : t =

     

       109
       115
        
           check_node_limit ();

     

       110
       116
        
           match v with

     

       111
       117
        
           | `Scalar s ->

     

       112
       118
        
               (* Register anchor after we have the resolved node *)

     

       113
       113
       -
               (match Scalar.anchor s with

     

       114
       114
       -
                | Some name -> register_anchor name v

     

       115
       115
       -
                | None -> ());

     

       119
       119
       +
               Option.iter (fun name -> register_anchor name v) (Scalar.anchor s);

     

       116
       120
        
               v

     

       117
       117
       -
           | `Alias name ->

     

       118
       118
       -
               expand_alias ~depth name

     

       121
       121
       +
           | `Alias name -> expand_alias ~depth name

     

       119
       122
        
           | `A seq ->

     

       120
       123
        
               (* First resolve all members in order *)

     

       121
       121
       -
               let resolved_members = List.map (resolve ~depth) (Sequence.members seq) in

     

       122
       122
       -
               let resolved = `A (Sequence.make

     

       123
       123
       -
                 ?anchor:(Sequence.anchor seq)

     

       124
       124
       -
                 ?tag:(Sequence.tag seq)

     

       125
       125
       -
                 ~implicit:(Sequence.implicit seq)

     

       126
       126
       -
                 ~style:(Sequence.style seq)

     

       127
       127
       -
                 resolved_members) in

     

       124
       124
       +
               let resolved_members =

     

       125
       125
       +
                 List.map (resolve ~depth) (Sequence.members seq)

     

       126
       126
       +
               in

     

       127
       127
       +
               let resolved =

     

       128
       128
       +
                 `A

     

       129
       129
       +
                   (Sequence.make ?anchor:(Sequence.anchor seq) ?tag:(Sequence.tag seq)

     

       130
       130
       +
                      ~implicit:(Sequence.implicit seq) ~style:(Sequence.style seq)

     

       131
       131
       +
                      resolved_members)

     

       132
       132
       +
               in

     

       128
       133
        
               (* Register anchor with resolved node *)

     

       129
       129
       -
               (match Sequence.anchor seq with

     

       130
       130
       -
                | Some name -> register_anchor name resolved

     

       131
       131
       -
                | None -> ());

     

       134
       134
       +
               Option.iter (fun name -> register_anchor name resolved) (Sequence.anchor seq);

     

       132
       135
        
               resolved

     

       133
       136
        
           | `O map ->

     

       134
       137
        
               (* Process key-value pairs in document order *)

     

       135
       135
       -
               let resolved_pairs = List.map (fun (k, v) ->

     

       136
       136
       -
                 let resolved_k = resolve ~depth k in

     

       137
       137
       -
                 let resolved_v = resolve ~depth v in

     

       138
       138
       -
                 (resolved_k, resolved_v)

     

       139
       139
       -
               ) (Mapping.members map) in

     

       140
       140
       -
               let resolved = `O (Mapping.make

     

       141
       141
       -
                 ?anchor:(Mapping.anchor map)

     

       142
       142
       -
                 ?tag:(Mapping.tag map)

     

       143
       143
       -
                 ~implicit:(Mapping.implicit map)

     

       144
       144
       -
                 ~style:(Mapping.style map)

     

       145
       145
       -
                 resolved_pairs) in

     

       138
       138
       +
               let resolved_pairs =

     

       139
       139
       +
                 List.map

     

       140
       140
       +
                   (fun (k, v) ->

     

       141
       141
       +
                     let resolved_k = resolve ~depth k in

     

       142
       142
       +
                     let resolved_v = resolve ~depth v in

     

       143
       143
       +
                     (resolved_k, resolved_v))

     

       144
       144
       +
                   (Mapping.members map)

     

       145
       145
       +
               in

     

       146
       146
       +
               let resolved =

     

       147
       147
       +
                 `O

     

       148
       148
       +
                   (Mapping.make ?anchor:(Mapping.anchor map) ?tag:(Mapping.tag map)

     

       149
       149
       +
                      ~implicit:(Mapping.implicit map) ~style:(Mapping.style map)

     

       150
       150
       +
                      resolved_pairs)

     

       151
       151
       +
               in

     

       146
       152
        
               (* Register anchor with resolved node *)

     

       147
       147
       -
               (match Mapping.anchor map with

     

       148
       148
       -
                | Some name -> register_anchor name resolved

     

       149
       149
       -
                | None -> ());

     

       153
       153
       +
               Option.iter (fun name -> register_anchor name resolved) (Mapping.anchor map);

     

       150
       154
        
               resolved

     

       151
       155
        
         in

     

       152
       156
        
         resolve ~depth:0 root

     
···

       159
       163
        
       

     

       160
       164
        
         (* If explicitly tagged, respect the tag *)

     

       161
       165
        
         match tag with

     

       162
       162
       -
         | Some "tag:yaml.org,2002:null" | Some "!!null" ->

     

       163
       163
       -
             `Null

     

       164
       164
       -
         | Some "tag:yaml.org,2002:bool" | Some "!!bool" ->

     

       165
       165
       -
             (match String.lowercase_ascii value with

     

       166
       166
       -
              | "true" | "yes" | "on" -> `Bool true

     

       167
       167
       -
              | "false" | "no" | "off" -> `Bool false

     

       168
       168
       -
              | _ -> Error.raise (Invalid_scalar_conversion (value, "bool")))

     

       169
       169
       -
         | Some "tag:yaml.org,2002:int" | Some "!!int" ->

     

       170
       170
       -
             (try `Float (Float.of_string value)

     

       171
       171
       -
              with _ -> Error.raise (Invalid_scalar_conversion (value, "int")))

     

       172
       172
       -
         | Some "tag:yaml.org,2002:float" | Some "!!float" ->

     

       173
       173
       -
             (try `Float (Float.of_string value)

     

       174
       174
       -
              with _ -> Error.raise (Invalid_scalar_conversion (value, "float")))

     

       175
       175
       -
         | Some "tag:yaml.org,2002:str" | Some "!!str" ->

     

       176
       176
       -
             `String value

     

       166
       166
       +
         | Some "tag:yaml.org,2002:null" | Some "!!null" -> `Null

     

       167
       167
       +
         | Some "tag:yaml.org,2002:bool" | Some "!!bool" -> (

     

       168
       168
       +
             match String.lowercase_ascii value with

     

       169
       169
       +
             | "true" | "yes" | "on" -> `Bool true

     

       170
       170
       +
             | "false" | "no" | "off" -> `Bool false

     

       171
       171
       +
             | _ -> Error.raise (Invalid_scalar_conversion (value, "bool")))

     

       172
       172
       +
         | Some "tag:yaml.org,2002:int" | Some "!!int" -> (

     

       173
       173
       +
             try `Float (Float.of_string value)

     

       174
       174
       +
             with _ -> Error.raise (Invalid_scalar_conversion (value, "int")))

     

       175
       175
       +
         | Some "tag:yaml.org,2002:float" | Some "!!float" -> (

     

       176
       176
       +
             try `Float (Float.of_string value)

     

       177
       177
       +
             with _ -> Error.raise (Invalid_scalar_conversion (value, "float")))

     

       178
       178
       +
         | Some "tag:yaml.org,2002:str" | Some "!!str" -> `String value

     

       177
       179
        
         | Some _ ->

     

       178
       180
        
             (* Unknown tag - treat as string *)

     

       179
       181
        
             `String value

     

       180
       182
        
         | None ->

     

       181
       183
        
             (* Implicit type resolution for plain scalars *)

     

       182
       182
       -
             if style <> `Plain then

     

       183
       183
       -
               `String value

     

       184
       184
       -
             else

     

       185
       185
       -
               infer_scalar_type value

     

       184
       184
       +
             if style <> `Plain then `String value else infer_scalar_type value

     

       186
       185
        
       

     

       187
       186
        
       (** Infer type from plain scalar value *)

     

       188
       187
        
       and infer_scalar_type value =

     
···

       214
       213
        
             else if (first = '-' || first = '+') && len >= 2 then

     

       215
       214
        
               let second = value.[1] in

     

       216
       215
        
               (* After sign, must be digit or dot-digit (for +.5, -.5) *)

     

       217
       217
       -
               second >= '0' && second <= '9' ||

     

       218
       218
       -
               (second = '.' && len >= 3 && value.[2] >= '0' && value.[2] <= '9')

     

       216
       216
       +
               (second >= '0' && second <= '9')

     

       217
       217
       +
               || (second = '.' && len >= 3 && value.[2] >= '0' && value.[2] <= '9')

     

       219
       218
        
             else false

     

       220
       219
        
         in

     

       221
       220
        
         (* Try integer/float *)

     
···

       237
       236
        
                 | _ ->

     

       238
       237
        
                     (* Decimal with leading zero or octal in YAML 1.1 *)

     

       239
       238
        
                     Some (`Float (Float.of_string value))

     

       240
       240
       -
               else

     

       241
       241
       -
                 Some (`Float (Float.of_string value))

     

       239
       239
       +
               else Some (`Float (Float.of_string value))

     

       242
       240
        
             with _ -> None

     

       243
       241
        
           else None

     

       244
       242
        
         in

     
···

       250
       248
        
                OCaml accepts "nan", "inf", "infinity" which are NOT valid YAML floats.

     

       251
       249
        
                YAML requires the leading dot: .nan, .inf, -.inf

     

       252
       250
        
                See: https://github.com/avsm/ocaml-yaml/issues/82 *)

     

       253
       253
       -
             if String.length value >= 2 && value.[0] = '.' &&

     

       254
       254
       -
                value.[1] >= '0' && value.[1] <= '9' then

     

       255
       255
       -
               try `Float (Float.of_string value)

     

       256
       256
       -
               with _ -> `String value

     

       257
       257
       -
             else

     

       258
       258
       -
               `String value

     

       251
       251
       +
             if

     

       252
       252
       +
               String.length value >= 2

     

       253
       253
       +
               && value.[0] = '.'

     

       254
       254
       +
               && value.[1] >= '0'

     

       255
       255
       +
               && value.[1] <= '9'

     

       256
       256
       +
             then try `Float (Float.of_string value) with _ -> `String value

     

       257
       257
       +
             else `String value

     

       259
       258
        
       

     

       260
       259
        
       (** Convert to JSON-compatible Value.

     

       261
       260
        
       

     

       262
       262
       -
           Converts a full YAML representation to a simplified JSON-compatible value type.

     

       263
       263
       -
           This process implements the representation graph to serialization tree conversion

     

       264
       264
       -
           described in {{:https://yaml.org/spec/1.2.2/#32-processes}Section 3.2 (Processes)}

     

       265
       265
       -
           of the YAML 1.2.2 specification.

     

       261
       261
       +
           Converts a full YAML representation to a simplified JSON-compatible value

     

       262
       262
       +
           type. This process implements the representation graph to serialization tree

     

       263
       263
       +
           conversion described in

     

       264
       264
       +
           {{:https://yaml.org/spec/1.2.2/#32-processes}Section 3.2 (Processes)} of the

     

       265
       265
       +
           YAML 1.2.2 specification.

     

       266
       266
        
       

     

       267
       267
       -
           See also {{:https://yaml.org/spec/1.2.2/#10212-json-schema}Section 10.2.1.2

     

       268
       268
       -
           (JSON Schema)} for the tag resolution used during conversion.

     

       267
       267
       +
           See also

     

       268
       268
       +
           {{:https://yaml.org/spec/1.2.2/#10212-json-schema}Section 10.2.1.2 (JSON

     

       269
       269
       +
            Schema)} for the tag resolution used during conversion.

     

       269
       270
        
       

     

       270
       270
       -
           @param resolve_aliases_first Whether to resolve aliases before conversion (default true)

     

       271
       271
       +
           @param resolve_aliases_first

     

       272
       272
       +
             Whether to resolve aliases before conversion (default true)

     

       271
       273
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       272
       274
        
           @param max_depth Maximum alias nesting depth (default 100)

     

       273
       273
       -
           @raise Error.Yamlrw_error with {!type:Error.kind} [Unresolved_alias] if resolve_aliases_first is false and an alias is encountered

     

       274
       274
       -
       *)

     

       275
       275
       -
       let to_value

     

       276
       276
       -
           ?(resolve_aliases_first = true)

     

       275
       275
       +
           @raise Error.Yamlrw_error

     

       276
       276
       +
             with {!type:Error.kind} [Unresolved_alias] if resolve_aliases_first is

     

       277
       277
       +
             false and an alias is encountered *)

     

       278
       278
       +
       let to_value ?(resolve_aliases_first = true)

     

       277
       279
        
           ?(max_nodes = default_max_alias_nodes)

     

       278
       278
       -
           ?(max_depth = default_max_alias_depth)

     

       279
       279
       -
           (v : t) : Value.t =

     

       280
       280
       -
         let v = if resolve_aliases_first then resolve_aliases ~max_nodes ~max_depth v else v in

     

       280
       280
       +
           ?(max_depth = default_max_alias_depth) (v : t) : Value.t =

     

       281
       281
       +
         let v =

     

       282
       282
       +
           if resolve_aliases_first then resolve_aliases ~max_nodes ~max_depth v else v

     

       283
       283
       +
         in

     

       281
       284
        
         let rec convert (v : t) : Value.t =

     

       282
       285
        
           match v with

     

       283
       286
        
           | `Scalar s -> scalar_to_value s

     

       284
       287
        
           | `Alias name -> Error.raise (Unresolved_alias name)

     

       285
       288
        
           | `A seq -> `A (List.map convert (Sequence.members seq))

     

       286
       289
        
           | `O map ->

     

       287
       287
       -
               `O (List.map (fun (k, v) ->

     

       288
       288
       -
                 let key = match k with

     

       289
       289
       -
                   | `Scalar s -> Scalar.value s

     

       290
       290
       -
                   | _ -> Error.raise (Type_mismatch ("string key", "complex key"))

     

       291
       291
       -
                 in

     

       292
       292
       -
                 (key, convert v)

     

       293
       293
       -
               ) (Mapping.members map))

     

       290
       290
       +
               `O

     

       291
       291
       +
                 (List.map

     

       292
       292
       +
                    (fun (k, v) ->

     

       293
       293
       +
                      let key =

     

       294
       294
       +
                        match k with

     

       295
       295
       +
                        | `Scalar s -> Scalar.value s

     

       296
       296
       +
                        | _ ->

     

       297
       297
       +
                            Error.raise (Type_mismatch ("string key", "complex key"))

     

       298
       298
       +
                      in

     

       299
       299
       +
                      (key, convert v))

     

       300
       300
       +
                    (Mapping.members map))

     

       294
       301
        
         in

     

       295
       302
        
         convert v

     

       296
       303

+63

lib/yaml.mli

···

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

     

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

     

       3
       3
       +
         SPDX-License-Identifier: ISC

     

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

     

       5
       5
       +
       

     

       6
       6
       +
       (** Full YAML representation with anchors, tags, and aliases *)

     

       7
       7
       +
       

     

       8
       8
       +
       type t = [

     

       9
       9
       +
         | `Scalar of Scalar.t

     

       10
       10
       +
         | `Alias of string

     

       11
       11
       +
         | `A of t Sequence.t

     

       12
       12
       +
         | `O of (t, t) Mapping.t

     

       13
       13
       +
       ]

     

       14
       14
       +
       

     

       15
       15
       +
       (** {2 Pretty Printing} *)

     

       16
       16
       +
       

     

       17
       17
       +
       val pp : Format.formatter -> t -> unit

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Equality} *)

     

       20
       20
       +
       

     

       21
       21
       +
       val equal : t -> t -> bool

     

       22
       22
       +
       

     

       23
       23
       +
       (** {2 Conversion from Value} *)

     

       24
       24
       +
       

     

       25
       25
       +
       val of_value : Value.t -> t

     

       26
       26
       +
       (** Construct from JSON-compatible Value *)

     

       27
       27
       +
       

     

       28
       28
       +
       (** {2 Alias Resolution} *)

     

       29
       29
       +
       

     

       30
       30
       +
       val default_max_alias_nodes : int

     

       31
       31
       +
       (** Default maximum nodes during alias expansion (10 million) *)

     

       32
       32
       +
       

     

       33
       33
       +
       val default_max_alias_depth : int

     

       34
       34
       +
       (** Default maximum alias nesting depth (100) *)

     

       35
       35
       +
       

     

       36
       36
       +
       val resolve_aliases : ?max_nodes:int -> ?max_depth:int -> t -> t

     

       37
       37
       +
       (** Resolve aliases by replacing them with referenced nodes.

     

       38
       38
       +
       

     

       39
       39
       +
           @param max_nodes Maximum number of nodes to create during expansion

     

       40
       40
       +
           @param max_depth Maximum depth of alias-within-alias resolution

     

       41
       41
       +
           @raise Error.Yamlrw_error if limits exceeded or undefined alias found *)

     

       42
       42
       +
       

     

       43
       43
       +
       (** {2 Conversion to Value} *)

     

       44
       44
       +
       

     

       45
       45
       +
       val to_value :

     

       46
       46
       +
         ?resolve_aliases_first:bool ->

     

       47
       47
       +
         ?max_nodes:int ->

     

       48
       48
       +
         ?max_depth:int ->

     

       49
       49
       +
         t -> Value.t

     

       50
       50
       +
       (** Convert to JSON-compatible Value.

     

       51
       51
       +
       

     

       52
       52
       +
           @param resolve_aliases_first Whether to resolve aliases before conversion (default true)

     

       53
       53
       +
           @param max_nodes Maximum nodes during alias expansion

     

       54
       54
       +
           @param max_depth Maximum alias nesting depth

     

       55
       55
       +
           @raise Error.Yamlrw_error if unresolved aliases encountered *)

     

       56
       56
       +
       

     

       57
       57
       +
       (** {2 Node Accessors} *)

     

       58
       58
       +
       

     

       59
       59
       +
       val anchor : t -> string option

     

       60
       60
       +
       (** Get anchor from any node *)

     

       61
       61
       +
       

     

       62
       62
       +
       val tag : t -> string option

     

       63
       63
       +
       (** Get tag from any node *)

+183 -253

lib/yamlrw.ml

···

       11
       11
        
       

     

       12
       12
        
       exception Yamlrw_error = Error.Yamlrw_error

     

       13
       13
        
       

     

       14
       14
       -
       

     

       15
       14
        
       (** {2 Core Types} *)

     

       16
       15
        
       

     

       16
       16
       +
       type value =

     

       17
       17
       +
         [ `Null  (** YAML null, ~, or empty values *)

     

       18
       18
       +
         | `Bool of bool  (** YAML booleans (true, false, yes, no, on, off) *)

     

       19
       19
       +
         | `Float of float  (** All YAML numbers (integers stored as floats) *)

     

       20
       20
       +
         | `String of string  (** YAML strings *)

     

       21
       21
       +
         | `A of value list  (** YAML sequences/arrays *)

     

       22
       22
       +
         | `O of (string * value) list  (** YAML mappings/objects with string keys *)

     

       23
       23
       +
         ]

     

       17
       24
        
       (** JSON-compatible YAML representation. Use this for simple data interchange.

     

       18
       25
        
       

     

       19
       26
        
           This type is structurally equivalent to {!Value.t} and compatible with the

     

       20
       20
       -
           ezjsonm representation. For additional operations, see {!Value} and {!Util}. *)

     

       21
       21
       -
       type value = [

     

       22
       22
       -
         | `Null                      (** YAML null, ~, or empty values *)

     

       23
       23
       -
         | `Bool of bool              (** YAML booleans (true, false, yes, no, on, off) *)

     

       24
       24
       -
         | `Float of float            (** All YAML numbers (integers stored as floats) *)

     

       25
       25
       -
         | `String of string          (** YAML strings *)

     

       26
       26
       -
         | `A of value list           (** YAML sequences/arrays *)

     

       27
       27
       -
         | `O of (string * value) list (** YAML mappings/objects with string keys *)

     

       28
       28
       -
       ]

     

       27
       27
       +
           ezjsonm representation. For additional operations, see {!Value} and {!Util}.

     

       28
       28
       +
       *)

     

       29
       29
        
       

     

       30
       30
       +
       type yaml =

     

       31
       31
       +
         [ `Scalar of Scalar.t  (** YAML scalar value with style and metadata *)

     

       32
       32
       +
         | `Alias of string  (** Alias reference to an anchored node *)

     

       33
       33
       +
         | `A of yaml Sequence.t  (** YAML sequence with style and metadata *)

     

       34
       34
       +
         | `O of (yaml, yaml) Mapping.t  (** YAML mapping with style and metadata *)

     

       35
       35
       +
         ]

     

       30
       36
        
       (** Full YAML representation preserving anchors, tags, and aliases.

     

       31
       37
        
       

     

       32
       38
        
           This type is structurally equivalent to {!Yaml.t}. Use this when you need

     
···

       34
       40
        
           type tags for custom types, scalar styles (plain, quoted, literal, folded),

     

       35
       41
        
           and collection styles (block vs flow).

     

       36
       42
        
       

     

       37
       37
       -
           For additional operations, see {!Yaml}, {!Scalar}, {!Sequence}, and {!Mapping}. *)

     

       38
       38
       -
       type yaml = [

     

       39
       39
       -
         | `Scalar of Scalar.t      (** YAML scalar value with style and metadata *)

     

       40
       40
       -
         | `Alias of string         (** Alias reference to an anchored node *)

     

       41
       41
       -
         | `A of yaml Sequence.t    (** YAML sequence with style and metadata *)

     

       42
       42
       -
         | `O of (yaml, yaml) Mapping.t (** YAML mapping with style and metadata *)

     

       43
       43
       -
       ]

     

       43
       43
       +
           For additional operations, see {!Yaml}, {!Scalar}, {!Sequence}, and

     

       44
       44
       +
           {!Mapping}. *)

     

       44
       45
        
       

     

       46
       46
       +
       type document = {

     

       47
       47
       +
         version : (int * int) option;

     

       48
       48
       +
             (** Optional YAML version directive (e.g., (1, 2) for YAML 1.2) *)

     

       49
       49
       +
         tags : (string * string) list;

     

       50
       50
       +
             (** TAG directives mapping handles to prefixes *)

     

       51
       51
       +
         root : yaml option;  (** Root content of the document *)

     

       52
       52
       +
         implicit_start : bool;

     

       53
       53
       +
             (** Whether the document start marker (---) is implicit *)

     

       54
       54
       +
         implicit_end : bool;  (** Whether the document end marker (...) is implicit *)

     

       55
       55
       +
       }

     

       45
       56
        
       (** A YAML document with directives and metadata.

     

       46
       57
        
       

     

       47
       58
        
           This type is structurally equivalent to {!Document.t}. A YAML stream can

     

       48
       59
        
           contain multiple documents, each separated by document markers.

     

       49
       60
        
       

     

       50
       61
        
           For additional operations, see {!Document}. *)

     

       51
       51
       -
       type document = {

     

       52
       52
       -
         version : (int * int) option;        (** Optional YAML version directive (e.g., (1, 2) for YAML 1.2) *)

     

       53
       53
       -
         tags : (string * string) list;       (** TAG directives mapping handles to prefixes *)

     

       54
       54
       -
         root : yaml option;                  (** Root content of the document *)

     

       55
       55
       -
         implicit_start : bool;               (** Whether the document start marker (---) is implicit *)

     

       56
       56
       -
         implicit_end : bool;                 (** Whether the document end marker (...) is implicit *)

     

       57
       57
       -
       }

     

       58
       58
       -
       

     

       59
       62
        
       

     

       60
       63
        
       (** {2 Character Encoding} *)

     

       61
       64
        
       

     

       62
       65
        
       module Encoding = Encoding

     

       63
       63
       -
       

     

       64
       66
        
       

     

       65
       67
        
       (** {2 Parsing} *)

     

       66
       68
        
       

     
···

       72
       74
        
       (** Default maximum alias nesting depth (100). *)

     

       73
       75
        
       let default_max_alias_depth = Yaml.default_max_alias_depth

     

       74
       76
        
       

     

       75
       75
       -
       let of_string

     

       76
       76
       -
           ?(resolve_aliases = true)

     

       77
       77
       -
           ?(max_nodes = default_max_alias_nodes)

     

       78
       78
       -
           ?(max_depth = default_max_alias_depth)

     

       79
       79
       -
           s : value =

     

       80
       80
       -
         (Loader.value_of_string ~resolve_aliases ~max_nodes ~max_depth s :> value)

     

       81
       77
        
       (** Parse a YAML string into a JSON-compatible value.

     

       82
       78
        
       

     

       83
       79
        
           @param resolve_aliases Whether to expand aliases (default: true)

     

       84
       80
        
           @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       85
       81
        
           @param max_depth Maximum alias nesting depth (default: 100)

     

       86
       82
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       83
       83
       +
       let of_string ?(resolve_aliases = true) ?(max_nodes = default_max_alias_nodes)

     

       84
       84
       +
           ?(max_depth = default_max_alias_depth) s : value =

     

       85
       85
       +
         (Loader.value_of_string ~resolve_aliases ~max_nodes ~max_depth s :> value)

     

       87
       86
        
       

     

       88
       88
       -
       let yaml_of_string

     

       89
       89
       -
           ?(resolve_aliases = false)

     

       90
       90
       -
           ?(max_nodes = default_max_alias_nodes)

     

       91
       91
       -
           ?(max_depth = default_max_alias_depth)

     

       92
       92
       -
           s : yaml =

     

       93
       93
       -
         (Loader.yaml_of_string ~resolve_aliases ~max_nodes ~max_depth s :> yaml)

     

       94
       87
        
       (** Parse a YAML string preserving full YAML metadata (anchors, tags, etc).

     

       95
       88
        
       

     

       96
       89
        
           By default, aliases are NOT resolved, preserving the document structure.

     
···

       99
       92
        
           @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       100
       93
        
           @param max_depth Maximum alias nesting depth (default: 100)

     

       101
       94
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       95
       95
       +
       let yaml_of_string ?(resolve_aliases = false)

     

       96
       96
       +
           ?(max_nodes = default_max_alias_nodes)

     

       97
       97
       +
           ?(max_depth = default_max_alias_depth) s : yaml =

     

       98
       98
       +
         (Loader.yaml_of_string ~resolve_aliases ~max_nodes ~max_depth s :> yaml)

     

       102
       99
        
       

     

       103
       103
       -
       let documents_of_string s : document list =

     

       104
       104
       -
         let docs = Loader.documents_of_string s in

     

       105
       105
       -
         List.map (fun (d : Document.t) : document -> {

     

       106
       106
       -
           version = d.version;

     

       107
       107
       -
           tags = d.tags;

     

       108
       108
       -
           root = (d.root :> yaml option);

     

       109
       109
       -
           implicit_start = d.implicit_start;

     

       110
       110
       -
           implicit_end = d.implicit_end;

     

       111
       111
       -
         }) docs

     

       112
       100
        
       (** Parse a multi-document YAML stream.

     

       113
       101
        
       

     

       114
       114
       -
           Use this when your YAML input contains multiple documents separated

     

       115
       115
       -
           by document markers (---).

     

       102
       102
       +
           Use this when your YAML input contains multiple documents separated by

     

       103
       103
       +
           document markers (---).

     

       116
       104
        
       

     

       117
       105
        
           @raise Yamlrw_error on parse error *)

     

       118
       118
       -
       

     

       106
       106
       +
       let documents_of_string s : document list =

     

       107
       107
       +
         let docs = Loader.documents_of_string s in

     

       108
       108
       +
         List.map

     

       109
       109
       +
           (fun (d : Document.t) : document ->

     

       110
       110
       +
             {

     

       111
       111
       +
               version = d.version;

     

       112
       112
       +
               tags = d.tags;

     

       113
       113
       +
               root = (d.root :> yaml option);

     

       114
       114
       +
               implicit_start = d.implicit_start;

     

       115
       115
       +
               implicit_end = d.implicit_end;

     

       116
       116
       +
             })

     

       117
       117
       +
           docs

     

       119
       118
        
       

     

       120
       119
        
       (** {2 Formatting Styles} *)

     

       121
       120
        
       

     

       122
       121
        
       module Scalar_style = Scalar_style

     

       123
       123
       -
       

     

       124
       122
        
       module Layout_style = Layout_style

     

       125
       123
        
       

     

       126
       126
       -
       

     

       127
       124
        
       (** {2 Serialization} *)

     

       128
       125
        
       

     

       129
       126
        
       let make_config ~encoding ~scalar_style ~layout_style =

     

       130
       127
        
         { Emitter.default_config with encoding; scalar_style; layout_style }

     

       131
       128
        
       

     

       132
       132
       -
       let to_buffer

     

       133
       133
       -
           ?(encoding = `Utf8)

     

       134
       134
       -
           ?(scalar_style = `Any)

     

       135
       135
       -
           ?(layout_style = `Any)

     

       136
       136
       -
           ?buffer

     

       137
       137
       -
           (value : value) =

     

       138
       138
       -
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       139
       139
       -
         Serialize.value_to_buffer ~config ?buffer (value :> Value.t)

     

       140
       129
        
       (** Serialize a value to a buffer.

     

       141
       130
        
       

     

       142
       131
        
           @param encoding Output encoding (default: UTF-8)

     

       143
       132
        
           @param scalar_style Preferred scalar style (default: Any)

     

       144
       133
        
           @param layout_style Preferred layout style (default: Any)

     

       145
       145
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       134
       134
       +
           @param buffer

     

       135
       135
       +
             Optional buffer to append to (allocates new one if not provided)

     

       146
       136
        
           @return The buffer containing the serialized YAML *)

     

       137
       137
       +
       let to_buffer ?(encoding = `Utf8) ?(scalar_style = `Any) ?(layout_style = `Any)

     

       138
       138
       +
           ?buffer (value : value) =

     

       139
       139
       +
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       140
       140
       +
         Serialize.value_to_buffer ~config ?buffer (value :> Value.t)

     

       147
       141
        
       

     

       148
       148
       -
       let to_string

     

       149
       149
       -
           ?(encoding = `Utf8)

     

       150
       150
       -
           ?(scalar_style = `Any)

     

       151
       151
       -
           ?(layout_style = `Any)

     

       152
       152
       -
           (value : value) =

     

       153
       153
       -
         Buffer.contents (to_buffer ~encoding ~scalar_style ~layout_style value)

     

       154
       142
        
       (** Serialize a value to a YAML string.

     

       155
       143
        
       

     

       156
       144
        
           @param encoding Output encoding (default: UTF-8)

     

       157
       145
        
           @param scalar_style Preferred scalar style (default: Any)

     

       158
       146
        
           @param layout_style Preferred layout style (default: Any) *)

     

       147
       147
       +
       let to_string ?(encoding = `Utf8) ?(scalar_style = `Any) ?(layout_style = `Any)

     

       148
       148
       +
           (value : value) =

     

       149
       149
       +
         Buffer.contents (to_buffer ~encoding ~scalar_style ~layout_style value)

     

       159
       150
        
       

     

       160
       160
       -
       let yaml_to_buffer

     

       161
       161
       -
           ?(encoding = `Utf8)

     

       162
       162
       -
           ?(scalar_style = `Any)

     

       163
       163
       -
           ?(layout_style = `Any)

     

       164
       164
       -
           ?buffer

     

       165
       165
       -
           (yaml : yaml) =

     

       166
       166
       -
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       167
       167
       -
         Serialize.yaml_to_buffer ~config ?buffer (yaml :> Yaml.t)

     

       168
       151
        
       (** Serialize a full YAML value to a buffer.

     

       169
       152
        
       

     

       170
       153
        
           @param encoding Output encoding (default: UTF-8)

     

       171
       154
        
           @param scalar_style Preferred scalar style (default: Any)

     

       172
       155
        
           @param layout_style Preferred layout style (default: Any)

     

       173
       173
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       156
       156
       +
           @param buffer

     

       157
       157
       +
             Optional buffer to append to (allocates new one if not provided)

     

       174
       158
        
           @return The buffer containing the serialized YAML *)

     

       159
       159
       +
       let yaml_to_buffer ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       160
       160
       +
           ?(layout_style = `Any) ?buffer (yaml : yaml) =

     

       161
       161
       +
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       162
       162
       +
         Serialize.yaml_to_buffer ~config ?buffer (yaml :> Yaml.t)

     

       175
       163
        
       

     

       176
       176
       -
       let yaml_to_string

     

       177
       177
       -
           ?(encoding = `Utf8)

     

       178
       178
       -
           ?(scalar_style = `Any)

     

       179
       179
       -
           ?(layout_style = `Any)

     

       180
       180
       -
           (yaml : yaml) =

     

       181
       181
       -
         Buffer.contents (yaml_to_buffer ~encoding ~scalar_style ~layout_style yaml)

     

       182
       164
        
       (** Serialize a full YAML value to a string.

     

       183
       165
        
       

     

       184
       166
        
           @param encoding Output encoding (default: UTF-8)

     

       185
       167
        
           @param scalar_style Preferred scalar style (default: Any)

     

       186
       168
        
           @param layout_style Preferred layout style (default: Any) *)

     

       169
       169
       +
       let yaml_to_string ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       170
       170
       +
           ?(layout_style = `Any) (yaml : yaml) =

     

       171
       171
       +
         Buffer.contents (yaml_to_buffer ~encoding ~scalar_style ~layout_style yaml)

     

       187
       172
        
       

     

       188
       188
       -
       let documents_to_buffer

     

       189
       189
       -
           ?(encoding = `Utf8)

     

       190
       190
       -
           ?(scalar_style = `Any)

     

       191
       191
       -
           ?(layout_style = `Any)

     

       192
       192
       -
           ?(resolve_aliases = true)

     

       193
       193
       -
           ?buffer

     

       194
       194
       -
           (documents : document list) =

     

       195
       195
       -
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       196
       196
       -
         let docs' = List.map (fun (d : document) : Document.t -> {

     

       197
       197
       -
           Document.version = d.version;

     

       198
       198
       -
           Document.tags = d.tags;

     

       199
       199
       -
           Document.root = (d.root :> Yaml.t option);

     

       200
       200
       -
           Document.implicit_start = d.implicit_start;

     

       201
       201
       -
           Document.implicit_end = d.implicit_end;

     

       202
       202
       -
         }) documents in

     

       203
       203
       -
         Serialize.documents_to_buffer ~config ~resolve_aliases ?buffer docs'

     

       204
       173
        
       (** Serialize multiple documents to a buffer.

     

       205
       174
        
       

     

       206
       175
        
           @param encoding Output encoding (default: UTF-8)

     

       207
       176
        
           @param scalar_style Preferred scalar style (default: Any)

     

       208
       177
        
           @param layout_style Preferred layout style (default: Any)

     

       209
       178
        
           @param resolve_aliases Whether to expand aliases (default: true)

     

       210
       210
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       179
       179
       +
           @param buffer

     

       180
       180
       +
             Optional buffer to append to (allocates new one if not provided)

     

       211
       181
        
           @return The buffer containing the serialized YAML *)

     

       212
       212
       -
       

     

       213
       213
       -
       let documents_to_string

     

       214
       214
       -
           ?(encoding = `Utf8)

     

       215
       215
       -
           ?(scalar_style = `Any)

     

       216
       216
       -
           ?(layout_style = `Any)

     

       217
       217
       -
           ?(resolve_aliases = true)

     

       182
       182
       +
       let documents_to_buffer ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       183
       183
       +
           ?(layout_style = `Any) ?(resolve_aliases = true) ?buffer

     

       218
       184
        
           (documents : document list) =

     

       219
       219
       -
         Buffer.contents (documents_to_buffer ~encoding ~scalar_style ~layout_style ~resolve_aliases documents)

     

       185
       185
       +
         let config = make_config ~encoding ~scalar_style ~layout_style in

     

       186
       186
       +
         let docs' =

     

       187
       187
       +
           List.map

     

       188
       188
       +
             (fun (d : document) : Document.t ->

     

       189
       189
       +
               {

     

       190
       190
       +
                 Document.version = d.version;

     

       191
       191
       +
                 Document.tags = d.tags;

     

       192
       192
       +
                 Document.root = (d.root :> Yaml.t option);

     

       193
       193
       +
                 Document.implicit_start = d.implicit_start;

     

       194
       194
       +
                 Document.implicit_end = d.implicit_end;

     

       195
       195
       +
               })

     

       196
       196
       +
             documents

     

       197
       197
       +
         in

     

       198
       198
       +
         Serialize.documents_to_buffer ~config ~resolve_aliases ?buffer docs'

     

       199
       199
       +
       

     

       220
       200
        
       (** Serialize multiple documents to a YAML stream.

     

       221
       201
        
       

     

       222
       202
        
           @param encoding Output encoding (default: UTF-8)

     

       223
       203
        
           @param scalar_style Preferred scalar style (default: Any)

     

       224
       204
        
           @param layout_style Preferred layout style (default: Any)

     

       225
       205
        
           @param resolve_aliases Whether to expand aliases (default: true) *)

     

       206
       206
       +
       let documents_to_string ?(encoding = `Utf8) ?(scalar_style = `Any)

     

       207
       207
       +
           ?(layout_style = `Any) ?(resolve_aliases = true) (documents : document list)

     

       208
       208
       +
           =

     

       209
       209
       +
         Buffer.contents

     

       210
       210
       +
           (documents_to_buffer ~encoding ~scalar_style ~layout_style ~resolve_aliases

     

       211
       211
       +
              documents)

     

       226
       212
        
       

     

       227
       213
        
       (** {2 Buffer Parsing} *)

     

       228
       214
        
       

     

       229
       229
       -
       let of_buffer

     

       230
       230
       -
           ?(resolve_aliases = true)

     

       231
       231
       -
           ?(max_nodes = default_max_alias_nodes)

     

       232
       232
       -
           ?(max_depth = default_max_alias_depth)

     

       233
       233
       -
           buffer : value =

     

       234
       234
       -
         of_string ~resolve_aliases ~max_nodes ~max_depth (Buffer.contents buffer)

     

       235
       215
        
       (** Parse YAML from a buffer into a JSON-compatible value.

     

       236
       216
        
       

     

       237
       217
        
           @param resolve_aliases Whether to expand aliases (default: true)

     

       238
       218
        
           @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       239
       219
        
           @param max_depth Maximum alias nesting depth (default: 100)

     

       240
       220
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       221
       221
       +
       let of_buffer ?(resolve_aliases = true) ?(max_nodes = default_max_alias_nodes)

     

       222
       222
       +
           ?(max_depth = default_max_alias_depth) buffer : value =

     

       223
       223
       +
         of_string ~resolve_aliases ~max_nodes ~max_depth (Buffer.contents buffer)

     

       241
       224
        
       

     

       242
       242
       -
       let yaml_of_buffer

     

       243
       243
       -
           ?(resolve_aliases = false)

     

       244
       244
       -
           ?(max_nodes = default_max_alias_nodes)

     

       245
       245
       -
           ?(max_depth = default_max_alias_depth)

     

       246
       246
       -
           buffer : yaml =

     

       247
       247
       -
         yaml_of_string ~resolve_aliases ~max_nodes ~max_depth (Buffer.contents buffer)

     

       248
       225
        
       (** Parse YAML from a buffer preserving full YAML metadata.

     

       249
       226
        
       

     

       250
       227
        
           @param resolve_aliases Whether to expand aliases (default: false)

     

       251
       228
        
           @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       252
       229
        
           @param max_depth Maximum alias nesting depth (default: 100)

     

       253
       230
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       231
       231
       +
       let yaml_of_buffer ?(resolve_aliases = false)

     

       232
       232
       +
           ?(max_nodes = default_max_alias_nodes)

     

       233
       233
       +
           ?(max_depth = default_max_alias_depth) buffer : yaml =

     

       234
       234
       +
         yaml_of_string ~resolve_aliases ~max_nodes ~max_depth (Buffer.contents buffer)

     

       254
       235
        
       

     

       255
       255
       -
       let documents_of_buffer buffer : document list =

     

       256
       256
       -
         documents_of_string (Buffer.contents buffer)

     

       257
       236
        
       (** Parse a multi-document YAML stream from a buffer.

     

       258
       237
        
       

     

       259
       238
        
           @raise Yamlrw_error on parse error *)

     

       260
       260
       -
       

     

       239
       239
       +
       let documents_of_buffer buffer : document list =

     

       240
       240
       +
         documents_of_string (Buffer.contents buffer)

     

       261
       241
        
       

     

       262
       242
        
       (** {2 Conversion} *)

     

       263
       243
        
       

     

       264
       264
       -
       let to_json

     

       265
       265
       -
           ?(resolve_aliases = true)

     

       266
       266
       -
           ?(max_nodes = default_max_alias_nodes)

     

       267
       267
       -
           ?(max_depth = default_max_alias_depth)

     

       268
       268
       -
           (yaml : yaml) : value =

     

       269
       269
       -
         (Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth (yaml :> Yaml.t) :> value)

     

       270
       244
        
       (** Convert full YAML to JSON-compatible value.

     

       271
       245
        
       

     

       272
       246
        
           @param resolve_aliases Whether to expand aliases (default: true)

     

       273
       247
        
           @param max_nodes Maximum nodes during alias expansion (default: 10M)

     

       274
       248
        
           @param max_depth Maximum alias nesting depth (default: 100)

     

       275
       249
        
           @raise Yamlrw_error if alias limits exceeded or complex keys found *)

     

       250
       250
       +
       let to_json ?(resolve_aliases = true) ?(max_nodes = default_max_alias_nodes)

     

       251
       251
       +
           ?(max_depth = default_max_alias_depth) (yaml : yaml) : value =

     

       252
       252
       +
         (Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth

     

       253
       253
       +
            (yaml :> Yaml.t)

     

       254
       254
       +
           :> value)

     

       276
       255
        
       

     

       277
       277
       -
       let of_json (value : value) : yaml =

     

       278
       278
       -
         (Yaml.of_value (value :> Value.t) :> yaml)

     

       279
       256
        
       (** Convert JSON-compatible value to full YAML representation. *)

     

       280
       280
       -
       

     

       257
       257
       +
       let of_json (value : value) : yaml = (Yaml.of_value (value :> Value.t) :> yaml)

     

       281
       258
        
       

     

       282
       259
        
       (** {2 Pretty Printing & Equality} *)

     

       283
       260
        
       

     

       261
       261
       +
       (** Pretty-print a value. *)

     

       284
       262
        
       let pp = Value.pp

     

       285
       285
       -
       (** Pretty-print a value. *)

     

       286
       263
        
       

     

       287
       287
       -
       let equal = Value.equal

     

       288
       264
        
       (** Test equality of two values. *)

     

       289
       289
       -
       

     

       265
       265
       +
       let equal = Value.equal

     

       290
       266
        
       

     

       291
       267
        
       (** {2 Util - Value Combinators} *)

     

       292
       268
        
       

     

       293
       269
        
       module Util = struct

     

       294
       270
        
         (** Combinators for working with {!type:value} values.

     

       295
       271
        
       

     

       296
       296
       -
             This module provides constructors, accessors, and transformations

     

       297
       297
       -
             for JSON-compatible YAML values. *)

     

       272
       272
       +
             This module provides constructors, accessors, and transformations for

     

       273
       273
       +
             JSON-compatible YAML values. *)

     

       298
       274
        
       

     

       299
       275
        
         type t = Value.t

     

       300
       276
        
       

     
···

       349
       325
        
         let get_string v = match v with `String s -> s | _ -> type_error "string" v

     

       350
       326
        
         let get_list v = match v with `A l -> l | _ -> type_error "list" v

     

       351
       327
        
         let get_obj v = match v with `O o -> o | _ -> type_error "object" v

     

       352
       352
       -
       

     

       353
       353
       -
         let get_int v =

     

       354
       354
       -
           match as_int v with

     

       355
       355
       -
           | Some i -> i

     

       356
       356
       -
           | None -> type_error "int" v

     

       328
       328
       +
         let get_int v = match as_int v with Some i -> i | None -> type_error "int" v

     

       357
       329
        
       

     

       358
       330
        
         (** {3 Object Operations} *)

     

       359
       331
        
       

     
···

       361
       333
        
           | `O pairs -> List.exists (fun (k, _) -> k = key) pairs

     

       362
       334
        
           | _ -> false

     

       363
       335
        
       

     

       364
       364
       -
         let find key = function

     

       365
       365
       -
           | `O pairs -> List.assoc_opt key pairs

     

       366
       366
       -
           | _ -> None

     

       336
       336
       +
         let find key = function `O pairs -> List.assoc_opt key pairs | _ -> None

     

       337
       337
       +
         let get key v = match find key v with Some v -> v | None -> raise Not_found

     

       367
       338
        
       

     

       368
       368
       -
         let get key v =

     

       369
       369
       -
           match find key v with

     

       370
       370
       -
           | Some v -> v

     

       371
       371
       -
           | None -> raise Not_found

     

       339
       339
       +
         let keys v =

     

       340
       340
       +
           match v with `O pairs -> List.map fst pairs | _ -> type_error "object" v

     

       372
       341
        
       

     

       373
       373
       -
         let keys v = match v with

     

       374
       374
       -
           | `O pairs -> List.map fst pairs

     

       375
       375
       -
           | _ -> type_error "object" v

     

       376
       376
       -
       

     

       377
       377
       -
         let values v = match v with

     

       378
       378
       -
           | `O pairs -> List.map snd pairs

     

       379
       379
       -
           | _ -> type_error "object" v

     

       342
       342
       +
         let values v =

     

       343
       343
       +
           match v with `O pairs -> List.map snd pairs | _ -> type_error "object" v

     

       380
       344
        
       

     

       381
       345
        
         let update key value = function

     

       382
       346
        
           | `O pairs ->

     

       383
       347
        
               let rec go = function

     

       384
       384
       -
                 | [] -> [(key, value)]

     

       348
       348
       +
                 | [] -> [ (key, value) ]

     

       385
       349
        
                 | (k, _) :: rest when k = key -> (key, value) :: rest

     

       386
       350
        
                 | kv :: rest -> kv :: go rest

     

       387
       351
        
               in

     
···

       393
       357
        
           | v -> type_error "object" v

     

       394
       358
        
       

     

       395
       359
        
         let combine v1 v2 =

     

       396
       396
       -
           match v1, v2 with

     

       360
       360
       +
           match (v1, v2) with

     

       397
       361
        
           | `O o1, `O o2 -> `O (o1 @ o2)

     

       398
       362
        
           | `O _, _ -> type_error "object" v2

     

       399
       363
        
           | _, _ -> type_error "object" v1

     

       400
       364
        
       

     

       401
       365
        
         (** {3 List Operations} *)

     

       402
       366
        
       

     

       403
       403
       -
         let map f = function

     

       404
       404
       -
           | `A l -> `A (List.map f l)

     

       405
       405
       -
           | v -> type_error "list" v

     

       406
       406
       -
       

     

       407
       407
       -
         let mapi f = function

     

       408
       408
       -
           | `A l -> `A (List.mapi f l)

     

       409
       409
       -
           | v -> type_error "list" v

     

       367
       367
       +
         let map f = function `A l -> `A (List.map f l) | v -> type_error "list" v

     

       368
       368
       +
         let mapi f = function `A l -> `A (List.mapi f l) | v -> type_error "list" v

     

       410
       369
        
       

     

       411
       370
        
         let filter pred = function

     

       412
       371
        
           | `A l -> `A (List.filter pred l)

     
···

       416
       375
        
           | `A l -> List.fold_left f init l

     

       417
       376
        
           | v -> type_error "list" v

     

       418
       377
        
       

     

       419
       419
       -
         let nth n = function

     

       420
       420
       -
           | `A l -> List.nth_opt l n

     

       421
       421
       -
           | _ -> None

     

       422
       422
       -
       

     

       423
       423
       -
         let length = function

     

       424
       424
       -
           | `A l -> List.length l

     

       425
       425
       -
           | `O o -> List.length o

     

       426
       426
       -
           | _ -> 0

     

       378
       378
       +
         let nth n = function `A l -> List.nth_opt l n | _ -> None

     

       379
       379
       +
         let length = function `A l -> List.length l | `O o -> List.length o | _ -> 0

     

       427
       380
        
       

     

       428
       381
        
         let flatten = function

     

       429
       429
       -
           | `A l ->

     

       430
       430
       -
               `A (List.concat_map (function `A inner -> inner | v -> [v]) l)

     

       382
       382
       +
           | `A l -> `A (List.concat_map (function `A inner -> inner | v -> [ v ]) l)

     

       431
       383
        
           | v -> type_error "list" v

     

       432
       384
        
       

     

       433
       385
        
         (** {3 Path Operations} *)

     
···

       435
       387
        
         let rec get_path path v =

     

       436
       388
        
           match path with

     

       437
       389
        
           | [] -> Some v

     

       438
       438
       -
           | key :: rest ->

     

       439
       439
       -
               match find key v with

     

       440
       440
       -
               | Some child -> get_path rest child

     

       441
       441
       -
               | None -> None

     

       390
       390
       +
           | key :: rest -> (

     

       391
       391
       +
               match find key v with Some child -> get_path rest child | None -> None)

     

       442
       392
        
       

     

       443
       393
        
         let get_path_exn path v =

     

       444
       444
       -
           match get_path path v with

     

       445
       445
       -
           | Some v -> v

     

       446
       446
       -
           | None -> raise Not_found

     

       394
       394
       +
           match get_path path v with Some v -> v | None -> raise Not_found

     

       447
       395
        
       

     

       448
       396
        
         (** {3 Iteration} *)

     

       449
       397
        
       

     
···

       451
       399
        
           | `O pairs -> List.iter (fun (k, v) -> f k v) pairs

     

       452
       400
        
           | v -> type_error "object" v

     

       453
       401
        
       

     

       454
       454
       -
         let iter_list f = function

     

       455
       455
       -
           | `A l -> List.iter f l

     

       456
       456
       -
           | v -> type_error "list" v

     

       402
       402
       +
         let iter_list f = function `A l -> List.iter f l | v -> type_error "list" v

     

       457
       403
        
       

     

       458
       404
        
         let fold_obj f init = function

     

       459
       405
        
           | `O pairs -> List.fold_left (fun acc (k, v) -> f acc k v) init pairs

     
···

       472
       418
        
         (** {3 Conversion Helpers} *)

     

       473
       419
        
       

     

       474
       420
        
         let to_bool ?default v =

     

       475
       475
       -
           match as_bool v, default with

     

       421
       421
       +
           match (as_bool v, default) with

     

       476
       422
        
           | Some b, _ -> b

     

       477
       423
        
           | None, Some d -> d

     

       478
       424
        
           | None, None -> type_error "bool" v

     

       479
       425
        
       

     

       480
       426
        
         let to_int ?default v =

     

       481
       481
       -
           match as_int v, default with

     

       427
       427
       +
           match (as_int v, default) with

     

       482
       428
        
           | Some i, _ -> i

     

       483
       429
        
           | None, Some d -> d

     

       484
       430
        
           | None, None -> type_error "int" v

     

       485
       431
        
       

     

       486
       432
        
         let to_float ?default v =

     

       487
       487
       -
           match as_float v, default with

     

       433
       433
       +
           match (as_float v, default) with

     

       488
       434
        
           | Some f, _ -> f

     

       489
       435
        
           | None, Some d -> d

     

       490
       436
        
           | None, None -> type_error "float" v

     

       491
       437
        
       

     

       492
       438
        
         let to_string ?default v =

     

       493
       493
       -
           match as_string v, default with

     

       439
       439
       +
           match (as_string v, default) with

     

       494
       440
        
           | Some s, _ -> s

     

       495
       441
        
           | None, Some d -> d

     

       496
       442
        
           | None, None -> type_error "string" v

     

       497
       443
        
       

     

       498
       444
        
         let to_list ?default v =

     

       499
       499
       -
           match as_list v, default with

     

       445
       445
       +
           match (as_list v, default) with

     

       500
       446
        
           | Some l, _ -> l

     

       501
       447
        
           | None, Some d -> d

     

       502
       448
        
           | None, None -> type_error "list" v

     

       503
       449
        
       end

     

       504
       504
       -
       

     

       505
       450
        
       

     

       506
       451
        
       (** {2 Stream - Low-Level Event API} *)

     

       507
       452
        
       

     
···

       521
       466
        
         type position = Position.t

     

       522
       467
        
         (** A position in the source (line, column, byte offset). *)

     

       523
       468
        
       

     

       524
       524
       -
         (** Result of parsing an event. *)

     

       525
       469
        
         type event_result = {

     

       526
       470
        
           event : event;

     

       527
       471
        
           start_pos : position;

     

       528
       472
        
           end_pos : position;

     

       529
       473
        
         }

     

       474
       474
       +
         (** Result of parsing an event. *)

     

       530
       475
        
       

     

       531
       476
        
         (** {3 Parsing} *)

     

       532
       477
        
       

     

       533
       478
        
         type parser = Parser.t

     

       534
       479
        
         (** A streaming YAML parser. *)

     

       535
       480
        
       

     

       536
       536
       -
         let parser s = Parser.of_string s

     

       537
       481
        
         (** Create a parser from a string. *)

     

       482
       482
       +
         let parser s = Parser.of_string s

     

       538
       483
        
       

     

       484
       484
       +
         (** Get the next event from the parser. Returns [None] when parsing is

     

       485
       485
       +
             complete. *)

     

       539
       486
        
         let next p =

     

       540
       487
        
           match Parser.next p with

     

       541
       488
        
           | Some { event; span } ->

     

       542
       542
       -
               Some {

     

       543
       543
       -
                 event;

     

       544
       544
       -
                 start_pos = span.start;

     

       545
       545
       -
                 end_pos = span.stop;

     

       546
       546
       -
               }

     

       489
       489
       +
               Some { event; start_pos = span.start; end_pos = span.stop }

     

       547
       490
        
           | None -> None

     

       548
       548
       -
         (** Get the next event from the parser.

     

       549
       549
       -
             Returns [None] when parsing is complete. *)

     

       550
       491
        
       

     

       492
       492
       +
         (** Iterate over all events from the parser. *)

     

       551
       493
        
         let iter f p =

     

       552
       494
        
           let rec go () =

     

       553
       495
        
             match next p with

     
···

       557
       499
        
             | None -> ()

     

       558
       500
        
           in

     

       559
       501
        
           go ()

     

       560
       560
       -
         (** Iterate over all events from the parser. *)

     

       561
       502
        
       

     

       503
       503
       +
         (** Fold over all events from the parser. *)

     

       562
       504
        
         let fold f init p =

     

       563
       505
        
           let rec go acc =

     

       564
       506
        
             match Parser.next p with

     
···

       566
       508
        
             | None -> acc

     

       567
       509
        
           in

     

       568
       510
        
           go init

     

       569
       569
       -
         (** Fold over all events from the parser. *)

     

       570
       511
        
       

     

       571
       512
        
         (** {3 Emitting} *)

     

       572
       513
        
       

     

       573
       514
        
         type emitter = Emitter.t

     

       574
       515
        
         (** A streaming YAML emitter. *)

     

       575
       516
        
       

     

       576
       576
       -
         let emitter ?len:_ () = Emitter.create ()

     

       577
       517
        
         (** Create a new emitter. *)

     

       518
       518
       +
         let emitter ?len:_ () = Emitter.create ()

     

       578
       519
        
       

     

       579
       579
       -
         let contents e = Emitter.contents e

     

       580
       520
        
         (** Get the emitted YAML string. *)

     

       521
       521
       +
         let contents e = Emitter.contents e

     

       581
       522
        
       

     

       582
       582
       -
         let emit e ev = Emitter.emit e ev

     

       583
       523
        
         (** Emit an event. *)

     

       524
       524
       +
         let emit e ev = Emitter.emit e ev

     

       584
       525
        
       

     

       585
       526
        
         (** {3 Event Emission Helpers} *)

     

       586
       527
        
       

     

       587
       528
        
         let stream_start e enc =

     

       588
       529
        
           Emitter.emit e (Event.Stream_start { encoding = enc })

     

       589
       530
        
       

     

       590
       590
       -
         let stream_end e =

     

       591
       591
       -
           Emitter.emit e Event.Stream_end

     

       531
       531
       +
         let stream_end e = Emitter.emit e Event.Stream_end

     

       592
       532
        
       

     

       593
       533
        
         let document_start e ?version ?(implicit = true) () =

     

       594
       594
       -
           let version = match version with

     

       534
       534
       +
           let version =

     

       535
       535
       +
             match version with

     

       595
       536
        
             | Some `V1_1 -> Some (1, 1)

     

       596
       537
        
             | Some `V1_2 -> Some (1, 2)

     

       597
       538
        
             | None -> None

     
···

       602
       543
        
           Emitter.emit e (Event.Document_end { implicit })

     

       603
       544
        
       

     

       604
       545
        
         let scalar e ?anchor ?tag ?(style = `Any) value =

     

       605
       605
       -
           Emitter.emit e (Event.Scalar {

     

       606
       606
       -
             anchor;

     

       607
       607
       -
             tag;

     

       608
       608
       -
             value;

     

       609
       609
       -
             plain_implicit = true;

     

       610
       610
       -
             quoted_implicit = true;

     

       611
       611
       -
             style;

     

       612
       612
       -
           })

     

       546
       546
       +
           Emitter.emit e

     

       547
       547
       +
             (Event.Scalar

     

       548
       548
       +
                {

     

       549
       549
       +
                  anchor;

     

       550
       550
       +
                  tag;

     

       551
       551
       +
                  value;

     

       552
       552
       +
                  plain_implicit = true;

     

       553
       553
       +
                  quoted_implicit = true;

     

       554
       554
       +
                  style;

     

       555
       555
       +
                })

     

       613
       556
        
       

     

       614
       614
       -
         let alias e name =

     

       615
       615
       -
           Emitter.emit e (Event.Alias { anchor = name })

     

       557
       557
       +
         let alias e name = Emitter.emit e (Event.Alias { anchor = name })

     

       616
       558
        
       

     

       617
       559
        
         let sequence_start e ?anchor ?tag ?(style = `Any) () =

     

       618
       618
       -
           Emitter.emit e (Event.Sequence_start {

     

       619
       619
       -
             anchor;

     

       620
       620
       -
             tag;

     

       621
       621
       -
             implicit = true;

     

       622
       622
       -
             style;

     

       623
       623
       -
           })

     

       560
       560
       +
           Emitter.emit e

     

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

     

       624
       562
        
       

     

       625
       625
       -
         let sequence_end e =

     

       626
       626
       -
           Emitter.emit e Event.Sequence_end

     

       563
       563
       +
         let sequence_end e = Emitter.emit e Event.Sequence_end

     

       627
       564
        
       

     

       628
       565
        
         let mapping_start e ?anchor ?tag ?(style = `Any) () =

     

       629
       629
       -
           Emitter.emit e (Event.Mapping_start {

     

       630
       630
       -
             anchor;

     

       631
       631
       -
             tag;

     

       632
       632
       -
             implicit = true;

     

       633
       633
       -
             style;

     

       634
       634
       -
           })

     

       566
       566
       +
           Emitter.emit e (Event.Mapping_start { anchor; tag; implicit = true; style })

     

       635
       567
        
       

     

       636
       636
       -
         let mapping_end e =

     

       637
       637
       -
           Emitter.emit e Event.Mapping_end

     

       568
       568
       +
         let mapping_end e = Emitter.emit e Event.Mapping_end

     

       638
       569
        
       end

     

       639
       639
       -
       

     

       640
       570
        
       

     

       641
       571
        
       (** {2 Internal Modules} *)

     

       642
       572
        
       

     

       643
       643
       -
       (** These modules are exposed for advanced use cases requiring

     

       644
       644
       -
           fine-grained control over parsing, emission, or data structures.

     

       573
       573
       +
       (** These modules are exposed for advanced use cases requiring fine-grained

     

       574
       574
       +
           control over parsing, emission, or data structures.

     

       645
       575
        
       

     

       646
       576
        
           For typical usage, prefer the top-level functions and {!Util}. *)

     

       647
       577
        
       

     

       648
       648
       -
       (** Source position tracking. *)

     

       649
       578
        
       module Position = Position

     

       579
       579
       +
       (** Source position tracking. *)

     

       650
       580
        
       

     

       581
       581
       +
       module Span = Span

     

       651
       582
        
       (** Source span (range of positions). *)

     

       652
       652
       -
       module Span = Span

     

       653
       583
        
       

     

       584
       584
       +
       module Chomping = Chomping

     

       654
       585
        
       (** Block scalar chomping modes. *)

     

       655
       655
       -
       module Chomping = Chomping

     

       656
       586
        
       

     

       657
       657
       -
       (** YAML type tags. *)

     

       658
       587
        
       module Tag = Tag

     

       588
       588
       +
       (** YAML type tags. *)

     

       659
       589
        
       

     

       660
       660
       -
       (** JSON-compatible value type and operations. *)

     

       661
       590
        
       module Value = Value

     

       591
       591
       +
       (** JSON-compatible value type and operations. *)

     

       662
       592
        
       

     

       663
       663
       -
       (** YAML scalar with metadata. *)

     

       664
       593
        
       module Scalar = Scalar

     

       594
       594
       +
       (** YAML scalar with metadata. *)

     

       665
       595
        
       

     

       596
       596
       +
       module Sequence = Sequence

     

       666
       597
        
       (** YAML sequence with metadata. *)

     

       667
       667
       -
       module Sequence = Sequence

     

       668
       598
        
       

     

       599
       599
       +
       module Mapping = Mapping

     

       669
       600
        
       (** YAML mapping with metadata. *)

     

       670
       670
       -
       module Mapping = Mapping

     

       671
       601
        
       

     

       672
       672
       -
       (** Full YAML value type. *)

     

       673
       602
        
       module Yaml = Yaml

     

       603
       603
       +
       (** Full YAML value type. *)

     

       674
       604
        
       

     

       675
       675
       -
       (** YAML document with directives. *)

     

       676
       605
        
       module Document = Document

     

       606
       606
       +
       (** YAML document with directives. *)

     

       677
       607
        
       

     

       678
       678
       -
       (** Lexical tokens. *)

     

       679
       608
        
       module Token = Token

     

       609
       609
       +
       (** Lexical tokens. *)

     

       680
       610
        
       

     

       611
       611
       +
       module Scanner = Scanner

     

       681
       612
        
       (** Lexical scanner. *)

     

       682
       682
       -
       module Scanner = Scanner

     

       683
       613
        
       

     

       684
       684
       -
       (** Parser events. *)

     

       685
       614
        
       module Event = Event

     

       615
       615
       +
       (** Parser events. *)

     

       686
       616
        
       

     

       617
       617
       +
       module Parser = Parser

     

       687
       618
        
       (** Event-based parser. *)

     

       688
       688
       -
       module Parser = Parser

     

       689
       619
        
       

     

       620
       620
       +
       module Loader = Loader

     

       690
       621
        
       (** Document loader. *)

     

       691
       691
       -
       module Loader = Loader

     

       692
       622
        
       

     

       693
       693
       -
       (** Event-based emitter. *)

     

       694
       623
        
       module Emitter = Emitter

     

       624
       624
       +
       (** Event-based emitter. *)

     

       695
       625
        
       

     

       696
       696
       -
       (** Input stream utilities. *)

     

       697
       626
        
       module Input = Input

     

       627
       627
       +
       (** Input stream utilities. *)

     

       698
       628
        
       

     

       629
       629
       +
       module Serialize = Serialize

     

       699
       630
        
       (** Buffer serialization utilities. *)

     

       700
       700
       -
       module Serialize = Serialize

+96 -90

lib/yamlrw.mli

···

       32
       32
        
             let age = Yamlrw.Util.(get_int (get "age" value)) in

     

       33
       33
        
           ]} *)

     

       34
       34
        
       

     

       35
       35
       -
       

     

       36
       35
        
       (** {2 Error Handling} *)

     

       37
       36
        
       

     

       38
       37
        
       module Error = Error

     
···

       40
       39
        
       exception Yamlrw_error of Error.t

     

       41
       40
        
       (** Raised on parse or emit errors. *)

     

       42
       41
        
       

     

       43
       43
       -
       

     

       44
       42
        
       (** {2 Core Types} *)

     

       45
       43
        
       

     

       46
       46
       -
       type value = [

     

       47
       47
       -
         | `Null                      (** YAML null, ~, or empty values *)

     

       48
       48
       -
         | `Bool of bool              (** YAML booleans (true, false, yes, no, on, off) *)

     

       49
       49
       -
         | `Float of float            (** All YAML numbers (integers stored as floats) *)

     

       50
       50
       -
         | `String of string          (** YAML strings *)

     

       51
       51
       -
         | `A of value list           (** YAML sequences/arrays *)

     

       52
       52
       -
         | `O of (string * value) list (** YAML mappings/objects with string keys *)

     

       53
       53
       -
       ]

     

       44
       44
       +
       type value =

     

       45
       45
       +
         [ `Null  (** YAML null, ~, or empty values *)

     

       46
       46
       +
         | `Bool of bool  (** YAML booleans (true, false, yes, no, on, off) *)

     

       47
       47
       +
         | `Float of float  (** All YAML numbers (integers stored as floats) *)

     

       48
       48
       +
         | `String of string  (** YAML strings *)

     

       49
       49
       +
         | `A of value list  (** YAML sequences/arrays *)

     

       50
       50
       +
         | `O of (string * value) list  (** YAML mappings/objects with string keys *)

     

       51
       51
       +
         ]

     

       54
       52
        
       (** JSON-compatible YAML representation. Use this for simple data interchange.

     

       55
       53
        
       

     

       56
       54
        
           This type is structurally equivalent to {!Value.t} and compatible with the

     

       57
       57
       -
           ezjsonm representation. For additional operations, see {!Value} and {!Util}. *)

     

       55
       55
       +
           ezjsonm representation. For additional operations, see {!Value} and {!Util}.

     

       56
       56
       +
       *)

     

       58
       57
        
       

     

       59
       59
       -
       type yaml = [

     

       60
       60
       -
         | `Scalar of Scalar.t      (** YAML scalar value with style and metadata *)

     

       61
       61
       -
         | `Alias of string         (** Alias reference to an anchored node *)

     

       62
       62
       -
         | `A of yaml Sequence.t    (** YAML sequence with style and metadata *)

     

       63
       63
       -
         | `O of (yaml, yaml) Mapping.t (** YAML mapping with style and metadata *)

     

       64
       64
       -
       ]

     

       58
       58
       +
       type yaml =

     

       59
       59
       +
         [ `Scalar of Scalar.t  (** YAML scalar value with style and metadata *)

     

       60
       60
       +
         | `Alias of string  (** Alias reference to an anchored node *)

     

       61
       61
       +
         | `A of yaml Sequence.t  (** YAML sequence with style and metadata *)

     

       62
       62
       +
         | `O of (yaml, yaml) Mapping.t  (** YAML mapping with style and metadata *)

     

       63
       63
       +
         ]

     

       65
       64
        
       (** Full YAML representation preserving anchors, tags, and aliases.

     

       66
       65
        
       

     

       67
       66
        
           This type is structurally equivalent to {!Yaml.t}. Use this when you need

     
···

       69
       68
        
           type tags for custom types, scalar styles (plain, quoted, literal, folded),

     

       70
       69
        
           and collection styles (block vs flow).

     

       71
       70
        
       

     

       72
       72
       -
           For additional operations, see {!Yaml}, {!Scalar}, {!Sequence}, and {!Mapping}. *)

     

       71
       71
       +
           For additional operations, see {!Yaml}, {!Scalar}, {!Sequence}, and

     

       72
       72
       +
           {!Mapping}. *)

     

       73
       73
        
       

     

       74
       74
        
       type document = {

     

       75
       75
       -
         version : (int * int) option;        (** Optional YAML version directive (e.g., (1, 2) for YAML 1.2) *)

     

       76
       76
       -
         tags : (string * string) list;       (** TAG directives mapping handles to prefixes *)

     

       77
       77
       -
         root : yaml option;                  (** Root content of the document *)

     

       78
       78
       -
         implicit_start : bool;               (** Whether the document start marker (---) is implicit *)

     

       79
       79
       -
         implicit_end : bool;                 (** Whether the document end marker (...) is implicit *)

     

       75
       75
       +
         version : (int * int) option;

     

       76
       76
       +
             (** Optional YAML version directive (e.g., (1, 2) for YAML 1.2) *)

     

       77
       77
       +
         tags : (string * string) list;

     

       78
       78
       +
             (** TAG directives mapping handles to prefixes *)

     

       79
       79
       +
         root : yaml option;  (** Root content of the document *)

     

       80
       80
       +
         implicit_start : bool;

     

       81
       81
       +
             (** Whether the document start marker (---) is implicit *)

     

       82
       82
       +
         implicit_end : bool;  (** Whether the document end marker (...) is implicit *)

     

       80
       83
        
       }

     

       81
       84
        
       (** A YAML document with directives and metadata.

     

       82
       85
        
       

     
···

       84
       87
        
           contain multiple documents, each separated by document markers.

     

       85
       88
        
       

     

       86
       89
        
           For additional operations, see {!Document}. *)

     

       87
       87
       -
       

     

       88
       90
        
       

     

       89
       91
        
       (** {2 Character Encoding} *)

     

       90
       92
        
       

     

       91
       93
        
       module Encoding = Encoding

     

       92
       94
        
       

     

       93
       93
       -
       

     

       94
       95
        
       (** {2 Parsing} *)

     

       95
       96
        
       

     

       96
       97
        
       type version = [ `V1_1 | `V1_2 ]

     
···

       103
       104
        
       (** Default maximum alias nesting depth (100). *)

     

       104
       105
        
       

     

       105
       106
        
       val of_string :

     

       106
       106
       -
         ?resolve_aliases:bool ->

     

       107
       107
       -
         ?max_nodes:int ->

     

       108
       108
       -
         ?max_depth:int ->

     

       109
       109
       -
         string -> value

     

       107
       107
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> string -> value

     

       110
       108
        
       (** Parse a YAML string into a JSON-compatible value.

     

       111
       109
        
       

     

       112
       110
        
           @param resolve_aliases Whether to expand aliases (default: true)

     
···

       115
       113
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       116
       114
        
       

     

       117
       115
        
       val yaml_of_string :

     

       118
       118
       -
         ?resolve_aliases:bool ->

     

       119
       119
       -
         ?max_nodes:int ->

     

       120
       120
       -
         ?max_depth:int ->

     

       121
       121
       -
         string -> yaml

     

       116
       116
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> string -> yaml

     

       122
       117
        
       (** Parse a YAML string preserving full YAML metadata (anchors, tags, etc).

     

       123
       118
        
       

     

       124
       119
        
           By default, aliases are NOT resolved, preserving the document structure.

     
···

       131
       126
        
       val documents_of_string : string -> document list

     

       132
       127
        
       (** Parse a multi-document YAML stream.

     

       133
       128
        
       

     

       134
       134
       -
           Use this when your YAML input contains multiple documents separated

     

       135
       135
       -
           by document markers (---).

     

       129
       129
       +
           Use this when your YAML input contains multiple documents separated by

     

       130
       130
       +
           document markers (---).

     

       136
       131
        
       

     

       137
       132
        
           @raise Yamlrw_error on parse error *)

     

       138
       133
        
       

     

       139
       139
       -
       

     

       140
       134
        
       (** {2 Formatting Styles} *)

     

       141
       135
        
       

     

       142
       136
        
       module Scalar_style = Scalar_style

     

       143
       143
       -
       

     

       144
       137
        
       module Layout_style = Layout_style

     

       145
       145
       -
       

     

       146
       138
        
       

     

       147
       139
        
       (** {2 Serialization} *)

     

       148
       140
        
       

     
···

       151
       143
        
         ?scalar_style:Scalar_style.t ->

     

       152
       144
        
         ?layout_style:Layout_style.t ->

     

       153
       145
        
         ?buffer:Buffer.t ->

     

       154
       154
       -
         value -> Buffer.t

     

       146
       146
       +
         value ->

     

       147
       147
       +
         Buffer.t

     

       155
       148
        
       (** Serialize a value to a buffer.

     

       156
       149
        
       

     

       157
       150
        
           @param encoding Output encoding (default: UTF-8)

     

       158
       151
        
           @param scalar_style Preferred scalar style (default: Any)

     

       159
       152
        
           @param layout_style Preferred layout style (default: Any)

     

       160
       160
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       153
       153
       +
           @param buffer

     

       154
       154
       +
             Optional buffer to append to (allocates new one if not provided)

     

       161
       155
        
           @return The buffer containing the serialized YAML *)

     

       162
       156
        
       

     

       163
       157
        
       val to_string :

     

       164
       158
        
         ?encoding:Encoding.t ->

     

       165
       159
        
         ?scalar_style:Scalar_style.t ->

     

       166
       160
        
         ?layout_style:Layout_style.t ->

     

       167
       167
       -
         value -> string

     

       161
       161
       +
         value ->

     

       162
       162
       +
         string

     

       168
       163
        
       (** Serialize a value to a YAML string.

     

       169
       164
        
       

     

       170
       165
        
           @param encoding Output encoding (default: UTF-8)

     
···

       176
       171
        
         ?scalar_style:Scalar_style.t ->

     

       177
       172
        
         ?layout_style:Layout_style.t ->

     

       178
       173
        
         ?buffer:Buffer.t ->

     

       179
       179
       -
         yaml -> Buffer.t

     

       174
       174
       +
         yaml ->

     

       175
       175
       +
         Buffer.t

     

       180
       176
        
       (** Serialize a full YAML value to a buffer.

     

       181
       177
        
       

     

       182
       178
        
           @param encoding Output encoding (default: UTF-8)

     

       183
       179
        
           @param scalar_style Preferred scalar style (default: Any)

     

       184
       180
        
           @param layout_style Preferred layout style (default: Any)

     

       185
       185
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       181
       181
       +
           @param buffer

     

       182
       182
       +
             Optional buffer to append to (allocates new one if not provided)

     

       186
       183
        
           @return The buffer containing the serialized YAML *)

     

       187
       184
        
       

     

       188
       185
        
       val yaml_to_string :

     

       189
       186
        
         ?encoding:Encoding.t ->

     

       190
       187
        
         ?scalar_style:Scalar_style.t ->

     

       191
       188
        
         ?layout_style:Layout_style.t ->

     

       192
       192
       -
         yaml -> string

     

       189
       189
       +
         yaml ->

     

       190
       190
       +
         string

     

       193
       191
        
       (** Serialize a full YAML value to a string.

     

       194
       192
        
       

     

       195
       193
        
           @param encoding Output encoding (default: UTF-8)

     
···

       202
       200
        
         ?layout_style:Layout_style.t ->

     

       203
       201
        
         ?resolve_aliases:bool ->

     

       204
       202
        
         ?buffer:Buffer.t ->

     

       205
       205
       -
         document list -> Buffer.t

     

       203
       203
       +
         document list ->

     

       204
       204
       +
         Buffer.t

     

       206
       205
        
       (** Serialize multiple documents to a buffer.

     

       207
       206
        
       

     

       208
       207
        
           @param encoding Output encoding (default: UTF-8)

     

       209
       208
        
           @param scalar_style Preferred scalar style (default: Any)

     

       210
       209
        
           @param layout_style Preferred layout style (default: Any)

     

       211
       210
        
           @param resolve_aliases Whether to expand aliases (default: true)

     

       212
       212
       -
           @param buffer Optional buffer to append to (allocates new one if not provided)

     

       211
       211
       +
           @param buffer

     

       212
       212
       +
             Optional buffer to append to (allocates new one if not provided)

     

       213
       213
        
           @return The buffer containing the serialized YAML *)

     

       214
       214
        
       

     

       215
       215
        
       val documents_to_string :

     
···

       217
       217
        
         ?scalar_style:Scalar_style.t ->

     

       218
       218
        
         ?layout_style:Layout_style.t ->

     

       219
       219
        
         ?resolve_aliases:bool ->

     

       220
       220
       -
         document list -> string

     

       220
       220
       +
         document list ->

     

       221
       221
       +
         string

     

       221
       222
        
       (** Serialize multiple documents to a YAML stream.

     

       222
       223
        
       

     

       223
       224
        
           @param encoding Output encoding (default: UTF-8)

     
···

       228
       229
        
       (** {2 Buffer Parsing} *)

     

       229
       230
        
       

     

       230
       231
        
       val of_buffer :

     

       231
       231
       -
         ?resolve_aliases:bool ->

     

       232
       232
       -
         ?max_nodes:int ->

     

       233
       233
       -
         ?max_depth:int ->

     

       234
       234
       -
         Buffer.t -> value

     

       232
       232
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> Buffer.t -> value

     

       235
       233
        
       (** Parse YAML from a buffer into a JSON-compatible value.

     

       236
       234
        
       

     

       237
       235
        
           @param resolve_aliases Whether to expand aliases (default: true)

     
···

       240
       238
        
           @raise Yamlrw_error on parse error or if multiple documents found *)

     

       241
       239
        
       

     

       242
       240
        
       val yaml_of_buffer :

     

       243
       243
       -
         ?resolve_aliases:bool ->

     

       244
       244
       -
         ?max_nodes:int ->

     

       245
       245
       -
         ?max_depth:int ->

     

       246
       246
       -
         Buffer.t -> yaml

     

       241
       241
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> Buffer.t -> yaml

     

       247
       242
        
       (** Parse YAML from a buffer preserving full YAML metadata.

     

       248
       243
        
       

     

       249
       244
        
           @param resolve_aliases Whether to expand aliases (default: false)

     
···

       256
       251
        
       

     

       257
       252
        
           @raise Yamlrw_error on parse error *)

     

       258
       253
        
       

     

       259
       259
       -
       

     

       260
       254
        
       (** {2 Conversion} *)

     

       261
       255
        
       

     

       262
       256
        
       val to_json :

     

       263
       263
       -
         ?resolve_aliases:bool ->

     

       264
       264
       -
         ?max_nodes:int ->

     

       265
       265
       -
         ?max_depth:int ->

     

       266
       266
       -
         yaml -> value

     

       257
       257
       +
         ?resolve_aliases:bool -> ?max_nodes:int -> ?max_depth:int -> yaml -> value

     

       267
       258
        
       (** Convert full YAML to JSON-compatible value.

     

       268
       259
        
       

     

       269
       260
        
           @param resolve_aliases Whether to expand aliases (default: true)

     
···

       274
       265
        
       val of_json : value -> yaml

     

       275
       266
        
       (** Convert JSON-compatible value to full YAML representation. *)

     

       276
       267
        
       

     

       277
       277
       -
       

     

       278
       268
        
       (** {2 Pretty Printing & Equality} *)

     

       279
       269
        
       

     

       280
       270
        
       val pp : Format.formatter -> value -> unit

     
···

       283
       273
        
       val equal : value -> value -> bool

     

       284
       274
        
       (** Test equality of two values. *)

     

       285
       275
        
       

     

       286
       286
       -
       

     

       287
       276
        
       (** {2 Util - Value Combinators}

     

       288
       277
        
       

     

       289
       278
        
           Combinators for working with {!type:value} values.

     

       290
       279
        
       

     

       291
       291
       -
           This module provides constructors, accessors, and transformations

     

       292
       292
       -
           for JSON-compatible YAML values. *)

     

       280
       280
       +
           This module provides constructors, accessors, and transformations for

     

       281
       281
       +
           JSON-compatible YAML values. *)

     

       293
       282
        
       

     

       294
       283
        
       module Util : sig

     

       295
       284
        
         type t = Value.t

     
···

       400
       389
        
         (** {3 Object Operations} *)

     

       401
       390
        
       

     

       402
       391
        
         val mem : string -> t -> bool

     

       403
       403
       -
         (** [mem key obj] checks if [key] exists in object [obj].

     

       404
       404
       -
             Returns [false] if [obj] is not an object. *)

     

       392
       392
       +
         (** [mem key obj] checks if [key] exists in object [obj]. Returns [false] if

     

       393
       393
       +
             [obj] is not an object. *)

     

       405
       394
        
       

     

       406
       395
        
         val find : string -> t -> t option

     

       407
       407
       -
         (** [find key obj] looks up [key] in object [obj].

     

       408
       408
       -
             Returns [None] if key not found or if [obj] is not an object. *)

     

       396
       396
       +
         (** [find key obj] looks up [key] in object [obj]. Returns [None] if key not

     

       397
       397
       +
             found or if [obj] is not an object. *)

     

       409
       398
        
       

     

       410
       399
        
         val get : string -> t -> t

     

       411
       411
       -
         (** [get key obj] looks up [key] in object [obj].

     

       412
       412
       -
             Raises [Not_found] if key not found. *)

     

       400
       400
       +
         (** [get key obj] looks up [key] in object [obj]. Raises [Not_found] if key

     

       401
       401
       +
             not found. *)

     

       413
       402
        
       

     

       414
       403
        
         val keys : t -> string list

     

       415
       404
        
         (** Get all keys from an object.

     
···

       420
       409
        
             @raise Type_error if not an object *)

     

       421
       410
        
       

     

       422
       411
        
         val update : string -> t -> t -> t

     

       423
       423
       -
         (** [update key value obj] sets [key] to [value] in [obj].

     

       424
       424
       -
             Adds the key if it doesn't exist.

     

       412
       412
       +
         (** [update key value obj] sets [key] to [value] in [obj]. Adds the key if it

     

       413
       413
       +
             doesn't exist.

     

       425
       414
        
             @raise Type_error if [obj] is not an object *)

     

       426
       415
        
       

     

       427
       416
        
         val remove : string -> t -> t

     
···

       429
       418
        
             @raise Type_error if [obj] is not an object *)

     

       430
       419
        
       

     

       431
       420
        
         val combine : t -> t -> t

     

       432
       432
       -
         (** [combine obj1 obj2] merges two objects, with [obj2] values taking precedence.

     

       421
       421
       +
         (** [combine obj1 obj2] merges two objects, with [obj2] values taking

     

       422
       422
       +
             precedence.

     

       433
       423
        
             @raise Type_error if either argument is not an object *)

     

       434
       424
        
       

     

       435
       425
        
         (** {3 List Operations} *)

     
···

       451
       441
        
             @raise Type_error if [lst] is not a list *)

     

       452
       442
        
       

     

       453
       443
        
         val nth : int -> t -> t option

     

       454
       454
       -
         (** [nth n lst] gets element at index [n].

     

       455
       455
       -
             Returns [None] if [lst] is not a list or index out of bounds. *)

     

       444
       444
       +
         (** [nth n lst] gets element at index [n]. Returns [None] if [lst] is not a

     

       445
       445
       +
             list or index out of bounds. *)

     

       456
       446
        
       

     

       457
       447
        
         val length : t -> int

     

       458
       448
        
         (** Get the length of a list or object. Returns 0 for other types. *)

     

       459
       449
        
       

     

       460
       450
        
         val flatten : t -> t

     

       461
       461
       -
         (** Flatten a list of lists into a single list.

     

       462
       462
       -
             Non-list elements are kept as-is.

     

       451
       451
       +
         (** Flatten a list of lists into a single list. Non-list elements are kept

     

       452
       452
       +
             as-is.

     

       463
       453
        
             @raise Type_error if not a list *)

     

       464
       454
        
       

     

       465
       455
        
         (** {3 Path Operations} *)

     

       466
       456
        
       

     

       467
       457
        
         val get_path : string list -> t -> t option

     

       468
       468
       -
         (** [get_path ["a"; "b"; "c"] obj] looks up nested path [obj.a.b.c].

     

       469
       469
       -
             Returns [None] if any key is not found. *)

     

       458
       458
       +
         (** [get_path ["a"; "b"; "c"] obj] looks up nested path [obj.a.b.c]. Returns

     

       459
       459
       +
             [None] if any key is not found. *)

     

       470
       460
        
       

     

       471
       461
        
         val get_path_exn : string list -> t -> t

     

       472
       462
        
         (** Like {!get_path} but raises [Not_found] if path not found. *)

     
···

       521
       511
        
             @raise Type_error if type doesn't match and no default provided *)

     

       522
       512
        
       end

     

       523
       513
        
       

     

       524
       524
       -
       

     

       525
       514
        
       (** {2 Stream - Low-Level Event API}

     

       526
       515
        
       

     

       527
       516
        
           Low-level streaming API for event-based YAML processing.

     
···

       532
       521
        
           - Fine-grained control over YAML emission *)

     

       533
       522
        
       

     

       534
       523
        
       module Stream : sig

     

       535
       535
       -
       

     

       536
       524
        
         (** {3 Event Types} *)

     

       537
       525
        
       

     

       538
       526
        
         type event = Event.t

     
···

       557
       545
        
         (** Create a parser from a string. *)

     

       558
       546
        
       

     

       559
       547
        
         val next : parser -> event_result option

     

       560
       560
       -
         (** Get the next event from the parser.

     

       561
       561
       -
             Returns [None] when parsing is complete. *)

     

       548
       548
       +
         (** Get the next event from the parser. Returns [None] when parsing is

     

       549
       549
       +
             complete. *)

     

       562
       550
        
       

     

       563
       551
        
         val iter : (event -> position -> position -> unit) -> parser -> unit

     

       564
       552
        
         (** [iter f parser] calls [f event start_pos end_pos] for each event. *)

     
···

       589
       577
        
         val stream_end : emitter -> unit

     

       590
       578
        
         (** Emit a stream end event. *)

     

       591
       579
        
       

     

       592
       592
       -
         val document_start : emitter -> ?version:version -> ?implicit:bool -> unit -> unit

     

       580
       580
       +
         val document_start :

     

       581
       581
       +
           emitter -> ?version:version -> ?implicit:bool -> unit -> unit

     

       593
       582
        
         (** Emit a document start event.

     

       594
       583
        
             @param version YAML version directive

     

       595
       584
        
             @param implicit Whether start marker is implicit (default: true) *)

     
···

       598
       587
        
         (** Emit a document end event.

     

       599
       588
        
             @param implicit Whether end marker is implicit (default: true) *)

     

       600
       589
        
       

     

       601
       601
       -
         val scalar : emitter -> ?anchor:string -> ?tag:string -> ?style:Scalar_style.t -> string -> unit

     

       590
       590
       +
         val scalar :

     

       591
       591
       +
           emitter ->

     

       592
       592
       +
           ?anchor:string ->

     

       593
       593
       +
           ?tag:string ->

     

       594
       594
       +
           ?style:Scalar_style.t ->

     

       595
       595
       +
           string ->

     

       596
       596
       +
           unit

     

       602
       597
        
         (** Emit a scalar value.

     

       603
       598
        
             @param anchor Optional anchor name

     

       604
       599
        
             @param tag Optional type tag

     
···

       607
       602
        
         val alias : emitter -> string -> unit

     

       608
       603
        
         (** Emit an alias reference. *)

     

       609
       604
        
       

     

       610
       610
       -
         val sequence_start : emitter -> ?anchor:string -> ?tag:string -> ?style:Layout_style.t -> unit -> unit

     

       605
       605
       +
         val sequence_start :

     

       606
       606
       +
           emitter ->

     

       607
       607
       +
           ?anchor:string ->

     

       608
       608
       +
           ?tag:string ->

     

       609
       609
       +
           ?style:Layout_style.t ->

     

       610
       610
       +
           unit ->

     

       611
       611
       +
           unit

     

       611
       612
        
         (** Emit a sequence start event.

     

       612
       613
        
             @param anchor Optional anchor name

     

       613
       614
        
             @param tag Optional type tag

     
···

       616
       617
        
         val sequence_end : emitter -> unit

     

       617
       618
        
         (** Emit a sequence end event. *)

     

       618
       619
        
       

     

       619
       619
       -
         val mapping_start : emitter -> ?anchor:string -> ?tag:string -> ?style:Layout_style.t -> unit -> unit

     

       620
       620
       +
         val mapping_start :

     

       621
       621
       +
           emitter ->

     

       622
       622
       +
           ?anchor:string ->

     

       623
       623
       +
           ?tag:string ->

     

       624
       624
       +
           ?style:Layout_style.t ->

     

       625
       625
       +
           unit ->

     

       626
       626
       +
           unit

     

       620
       627
        
         (** Emit a mapping start event.

     

       621
       628
        
             @param anchor Optional anchor name

     

       622
       629
        
             @param tag Optional type tag

     
···

       626
       633
        
         (** Emit a mapping end event. *)

     

       627
       634
        
       end

     

       628
       635
        
       

     

       629
       629
       -
       

     

       630
       636
        
       (** {2 Internal Modules}

     

       631
       637
        
       

     

       632
       632
       -
           These modules are exposed for advanced use cases requiring

     

       633
       633
       -
           fine-grained control over parsing, emission, or data structures.

     

       638
       638
       +
           These modules are exposed for advanced use cases requiring fine-grained

     

       639
       639
       +
           control over parsing, emission, or data structures.

     

       634
       640
        
       

     

       635
       641
        
           For typical usage, prefer the top-level functions and {!Util}. *)

     

       636
       642

tests/cram/anchor_flow_map.yml

···

       1
       1
       +
       {original: &cfg {a: 1}, copy: *cfg}

tests/cram/anchor_flow_seq.yml

···

       1
       1
       +
       [&item apple, *item]

tests/cram/anchor_list.yml

···

       1
       1
       +
       list: &items

     

       2
       2
       +
         - one

     

       3
       3
       +
         - two

     

       4
       4
       +
       copy: *items

tests/cram/anchor_mapping.yml

···

       1
       1
       +
       person: &p

     

       2
       2
       +
         name: Alice

     

       3
       3
       +
         age: 30

     

       4
       4
       +
       copy: *p

tests/cram/anchor_multiple_refs.yml

···

       1
       1
       +
       value: &v 100

     

       2
       2
       +
       first: *v

     

       3
       3
       +
       second: *v

     

       4
       4
       +
       third: *v

tests/cram/anchor_number.yml

···

       1
       1
       +
       original: &num 42

     

       2
       2
       +
       copy: *num

tests/cram/anchor_simple.yml

···

       1
       1
       +
       anchor: &anc value

     

       2
       2
       +
       alias: *anc

+9 -21

tests/cram/anchors.t

···

       1
       1
       -
       Anchor and Alias Support (currently not supported)

     

       1
       1
       +
       Anchor and Alias Support

     

       2
       2
        
       

     

       3
       3
       -
       These tests document anchor (&) and alias (*) support that is not yet

     

       4
       4
       -
       implemented. Currently, aliases fail with "unresolved alias" error.

     

       3
       3
       +
       These tests verify that anchor (&) and alias (*) support is working correctly.

     

       5
       4
        
       

     

       6
       5
        
       Test: Simple scalar anchor and alias

     

       7
       6
        
       

     

       8
       8
       -
         $ echo 'anchor: &anc value

     

       9
       9
       -
         > alias: *anc' | yamlcat 2>&1

     

       7
       7
       +
         $ yamlcat anchor_simple.yml 2>&1

     

       10
       8
        
         anchor: value

     

       11
       9
        
         alias: value

     

       12
       10
        
       

     

       13
       11
        
       Test: Numeric anchor and alias

     

       14
       12
        
       

     

       15
       15
       -
         $ echo 'original: &num 42

     

       16
       16
       -
         > copy: *num' | yamlcat 2>&1

     

       13
       13
       +
         $ yamlcat anchor_number.yml 2>&1

     

       17
       14
        
         original: 42

     

       18
       15
        
         copy: 42

     

       19
       16
        
       

     

       20
       17
        
       Test: Sequence anchor and alias

     

       21
       18
        
       

     

       22
       22
       -
         $ echo 'list: &items

     

       23
       23
       -
         >   - one

     

       24
       24
       -
         >   - two

     

       25
       25
       -
         > copy: *items' | yamlcat 2>&1

     

       19
       19
       +
         $ yamlcat anchor_list.yml 2>&1

     

       26
       20
        
         list:

     

       27
       21
        
           - one

     

       28
       22
        
           - two

     
···

       32
       26
        
       

     

       33
       27
        
       Test: Mapping anchor and alias

     

       34
       28
        
       

     

       35
       35
       -
         $ echo 'person: &p

     

       36
       36
       -
         >   name: Alice

     

       37
       37
       -
         >   age: 30

     

       38
       38
       -
         > copy: *p' | yamlcat 2>&1

     

       29
       29
       +
         $ yamlcat anchor_mapping.yml 2>&1

     

       39
       30
        
         person:

     

       40
       31
        
           name: Alice

     

       41
       32
        
           age: 30

     
···

       45
       36
        
       

     

       46
       37
        
       Test: Multiple aliases to same anchor

     

       47
       38
        
       

     

       48
       48
       -
         $ echo 'value: &v 100

     

       49
       49
       -
         > first: *v

     

       50
       50
       -
         > second: *v

     

       51
       51
       -
         > third: *v' | yamlcat 2>&1

     

       39
       39
       +
         $ yamlcat anchor_multiple_refs.yml 2>&1

     

       52
       40
        
         value: 100

     

       53
       41
        
         first: 100

     

       54
       42
        
         second: 100

     
···

       56
       44
        
       

     

       57
       45
        
       Test: Anchor in flow context

     

       58
       46
        
       

     

       59
       59
       -
         $ echo '[&item apple, *item]' | yamlcat 2>&1

     

       47
       47
       +
         $ yamlcat anchor_flow_seq.yml 2>&1

     

       60
       48
        
         - apple

     

       61
       49
        
         - apple

     

       62
       50
        
       

     

       63
       51
        
       Test: Anchor with mapping in flow

     

       64
       52
        
       

     

       65
       65
       -
         $ echo '{original: &cfg {a: 1}, copy: *cfg}' | yamlcat 2>&1

     

       53
       53
       +
         $ yamlcat anchor_flow_map.yml 2>&1

     

       66
       54
        
         original:

     

       67
       55
        
           a: 1

     

       68
       56
        
         copy:

tests/cram/bell_character.yml

···

       1
       1
       +
       text: "test\a"

+8 -8

tests/cram/collections.t

···

       119
       119
        
       Test collections_block.yml with flow output

     

       120
       120
        
       

     

       121
       121
        
         $ yamlcat --flow collections_block.yml

     

       122
       122
       -
         {simple_sequence: [apple, banana, cherry, date]simple_mapping, {name: John Doe, age: 30, city: New York, country: USA}, nested_sequences: [[alpha, beta, gamma], [one, two, three], [red, green, blue]]nested_mappings, {person: {name: Alice, contact: {email: alice@example.com, phone: 555-1234}address, {street: 123 Main St, city: Boston}}}, mapping_with_sequences: {colors: [red, green, blue]sizes, [small, medium, large], numbers: [1, 2, 3]}sequence_with_mappings, [{name: Alice, age: 25, role: developer}, {name: Bob, age: 30, role: designer}, {name: Charlie, age: 35, role: manager}], deep_nesting: {level1: {level2: {level3: {level4: [deeply, nested, values]another_key, value: }items, [item1, item2]}metadata, {created: 2024-01-01, modified: 2024-12-04}}}complex_structure, {database: {connections: [{host: db1.example.com, port: 5432, credentials: {username: admin, password: secret}}, {host: db2.example.com, port: 5432, credentials: {username: readonly, password: public}}]}services, [{name: api, endpoints: [/users, /posts, /comments]config, {timeout: 30, retries: 3}}, {name: worker, tasks: [email, reports]config, {concurrency: 10}}]}, empty_collections: {empty_sequence: []empty_mapping, {}, sequence_with_empty: [value1, [], value2]mapping_with_empty, {key1: value1, key2: {}key3, value3: }}}

     

       122
       122
       +
         {simple_sequence: [apple, banana, cherry, date], simple_mapping: {name: John Doe, age: 30, city: New York, country: USA}, nested_sequences: [[alpha, beta, gamma], [one, two, three], [red, green, blue]], nested_mappings: {person: {name: Alice, contact: {email: alice@example.com, phone: 555-1234}, address: {street: 123 Main St, city: Boston}}}, mapping_with_sequences: {colors: [red, green, blue], sizes: [small, medium, large], numbers: [1, 2, 3]}, sequence_with_mappings: [{name: Alice, age: 25, role: developer}, {name: Bob, age: 30, role: designer}, {name: Charlie, age: 35, role: manager}], deep_nesting: {level1: {level2: {level3: {level4: [deeply, nested, values], another_key: value}, items: [item1, item2]}, metadata: {created: 2024-01-01, modified: 2024-12-04}}}, complex_structure: {database: {connections: [{host: db1.example.com, port: 5432, credentials: {username: admin, password: secret}}, {host: db2.example.com, port: 5432, credentials: {username: readonly, password: public}}]}, services: [{name: api, endpoints: [/users, /posts, /comments], config: {timeout: 30, retries: 3}}, {name: worker, tasks: [email, reports], config: {concurrency: 10}}]}, empty_collections: {empty_sequence: [], empty_mapping: {}, sequence_with_empty: [value1, [], value2], mapping_with_empty: {key1: value1, key2: {}, key3: value3}}}

     

       123
       123
        
       

     

       124
       124
        
       Test collections_compact.yml - Compact notation

     

       125
       125
        
       

     
···

       314
       314
        
       Test collections_compact.yml with flow output

     

       315
       315
        
       

     

       316
       316
        
         $ yamlcat --flow collections_compact.yml

     

       317
       317
       -
         {compact_sequence: [{name: Alice, age: 25, city: Boston}, {name: Bob, age: 30, city: Seattle}, {name: Charlie, age: 35, city: Portland}]compact_nested, [{id: 1, details: {type: admin, permissions: [read, write, delete]}}, {id: 2, details: {type: user, permissions: [read]}}], compact_complex: [{key1: value1, key2: value2, nested: {sub1: val1, sub2: val2}}, {key1: value3, key2: value4, nested: {sub1: val3, sub2: val4}}]users, [{username: alice, email: alice@example.com, active: true}, {username: bob, email: bob@example.com, active: false}], compact_with_flow: [{name: service1, ports: [8080, 8443]env, {DEBUG: true, MODE: production}}, {name: service2, ports: [3000]env, {DEBUG: false, MODE: development}}]deep_compact, [{category: electronics, items: [{name: laptop, specs: {cpu: Intel i7, ram: 16GB, storage: 512GB SSD}}, {name: phone, specs: {os: Android, ram: 8GB, storage: 256GB}}]}, {category: furniture, items: [{name: desk, dimensions: {width: 150cm, depth: 75cm, height: 75cm}}, {name: chair, dimensions: {width: 60cm, depth: 60cm, height: 120cm}}]}], mixed_compact: {databases: [{type: postgresql, connection: {host: localhost, port: 5432}credentials, {user: admin, password: secret}}, {type: mongodb, connection: {host: localhost, port: 27017}credentials, {user: root, password: root}}]}single_line_compact, [{name: Alice, age: 25, role: developer}, {name: Bob, age: 30, role: designer}, {name: Charlie, age: 35, role: manager}], sequences_in_compact: [{title: Project A, members: [Alice, Bob, Charlie]tags, [urgent, backend]}, {title: Project B, members: [David, Eve]tags, [frontend, design]}]compact_with_empty, [{id: 1, data: []meta, {}}, {id: 2, data: [item1]meta, {key: value}}], compact_complex_nesting: [{level: 1, children: [{level: 2a, children: [{level: 3a, value: leaf1}, {level: 3b, value: leaf2}]}, {level: 2b, children: [{level: 3c, value: leaf3}]}]}]api_endpoints, [{path: /users, method: GET, auth: required, params: [{name: page, type: integer, default: 1}, {name: limit, type: integer, default: 10}]}, {path: '/users/:id', method: GET, auth: required, params: []}, {path: /users, method: POST, auth: required, body: {username: string, email: string, password: string}}], compact_types: [{string_val: hello, number_val: 42, float_val: 3.14, bool_val: true, null_val: null}, {string_val: world, number_val: 100, float_val: 2.71, bool_val: false, null_val: null}]minimal, [{a: 1}, {b: 2}, {c: 3}]}

     

       317
       317
       +
         {compact_sequence: [{name: Alice, age: 25, city: Boston}, {name: Bob, age: 30, city: Seattle}, {name: Charlie, age: 35, city: Portland}], compact_nested: [{id: 1, details: {type: admin, permissions: [read, write, delete]}}, {id: 2, details: {type: user, permissions: [read]}}], compact_complex: [{key1: value1, key2: value2, nested: {sub1: val1, sub2: val2}}, {key1: value3, key2: value4, nested: {sub1: val3, sub2: val4}}], users: [{username: alice, email: alice@example.com, active: true}, {username: bob, email: bob@example.com, active: false}], compact_with_flow: [{name: service1, ports: [8080, 8443], env: {DEBUG: true, MODE: production}}, {name: service2, ports: [3000], env: {DEBUG: false, MODE: development}}], deep_compact: [{category: electronics, items: [{name: laptop, specs: {cpu: Intel i7, ram: 16GB, storage: 512GB SSD}}, {name: phone, specs: {os: Android, ram: 8GB, storage: 256GB}}]}, {category: furniture, items: [{name: desk, dimensions: {width: 150cm, depth: 75cm, height: 75cm}}, {name: chair, dimensions: {width: 60cm, depth: 60cm, height: 120cm}}]}], mixed_compact: {databases: [{type: postgresql, connection: {host: localhost, port: 5432}, credentials: {user: admin, password: secret}}, {type: mongodb, connection: {host: localhost, port: 27017}, credentials: {user: root, password: root}}]}, single_line_compact: [{name: Alice, age: 25, role: developer}, {name: Bob, age: 30, role: designer}, {name: Charlie, age: 35, role: manager}], sequences_in_compact: [{title: Project A, members: [Alice, Bob, Charlie], tags: [urgent, backend]}, {title: Project B, members: [David, Eve], tags: [frontend, design]}], compact_with_empty: [{id: 1, data: [], meta: {}}, {id: 2, data: [item1], meta: {key: value}}], compact_complex_nesting: [{level: 1, children: [{level: 2a, children: [{level: 3a, value: leaf1}, {level: 3b, value: leaf2}]}, {level: 2b, children: [{level: 3c, value: leaf3}]}]}], api_endpoints: [{path: /users, method: GET, auth: required, params: [{name: page, type: integer, default: 1}, {name: limit, type: integer, default: 10}]}, {path: '/users/:id', method: GET, auth: required, params: []}, {path: /users, method: POST, auth: required, body: {username: string, email: string, password: string}}], compact_types: [{string_val: hello, number_val: 42, float_val: 3.14, bool_val: true, null_val: null}, {string_val: world, number_val: 100, float_val: 2.71, bool_val: false, null_val: null}], minimal: [{a: 1}, {b: 2}, {c: 3}]}

     

       318
       318
        
       

     

       319
       319
        
       Test collections_flow.yml - Flow style collections

     

       320
       320
        
       

     
···

       515
       515
        
       Test collections_flow.yml with flow output

     

       516
       516
        
       

     

       517
       517
        
         $ yamlcat --flow collections_flow.yml

     

       518
       518
       -
         {simple_flow_sequence: [apple, banana, cherry, date]simple_flow_mapping, {name: John, age: 30, city: New York}, nested_flow_sequences: [[a, b, c], [1, 2, 3], [red, green, blue]]nested_flow_mappings, {person: {name: Alice, age: 25}contact, {email: alice@example.com, phone: 555-1234}}, flow_seq_with_maps: [{name: Alice, role: dev}, {name: Bob, role: ops}, {name: Charlie, role: qa}]flow_map_with_seqs, {colors: [red, green, blue]sizes, [S, M, L], numbers: [1, 2, 3]}, deep_flow_nesting: {level1: {level2: {level3: {level4: [a, b, c]}}}}empty_flow, {empty_seq: []empty_map, {}, both: [[], {}]}, flow_in_block: {sequence: [1, 2, 3, 4, 5]mapping, {a: 1, b: 2, c: 3}, nested: {items: [x, y, z]config, {timeout: 30, retries: 3}}}block_in_flow, {users: [{name: Alice, tags: [dev, senior]}, {name: Bob, tags: [ops, junior]}]}, mixed_structure: {services: [{name: api, ports: [8080, 8443]env, {DEBUG: true, LOG_LEVEL: info}}, {name: db, ports: [5432]env, {POSTGRES_DB: mydb, POSTGRES_USER: admin}}]config, {version: 1, enabled: true}}flow_types, {strings: [hello, world, foo, bar]numbers, [1, 2, 3, 42, 100], mixed: [string, 123, true, false, null]quoted, [with spaces, 'special:chars', commas, here]}, flow_map_types: {string: value, number: 42, boolean: true, null_value: null, float: 3.14}nested_mixed, [{id: 1, data: [a, b, c]meta, {type: first}}, {id: 2, data: [d, e, f]meta, {type: second}}, {id: 3, data: [g, h, i]meta, {type: third}}], multiline_flow: {long_sequence: [item1, item2, item3, item4]long_mapping, {key1: value1, key2: value2, key3: value3}}edge_cases, {single_item_seq: [alone]single_item_map, {only: one}, nested_empty: [[], [{}], [{}, []]]all_empty, [{}, [], {a: []}, {b: {}}]}}

     

       518
       518
       +
         {simple_flow_sequence: [apple, banana, cherry, date], simple_flow_mapping: {name: John, age: 30, city: New York}, nested_flow_sequences: [[a, b, c], [1, 2, 3], [red, green, blue]], nested_flow_mappings: {person: {name: Alice, age: 25}, contact: {email: alice@example.com, phone: 555-1234}}, flow_seq_with_maps: [{name: Alice, role: dev}, {name: Bob, role: ops}, {name: Charlie, role: qa}], flow_map_with_seqs: {colors: [red, green, blue], sizes: [S, M, L], numbers: [1, 2, 3]}, deep_flow_nesting: {level1: {level2: {level3: {level4: [a, b, c]}}}}, empty_flow: {empty_seq: [], empty_map: {}, both: [[], {}]}, flow_in_block: {sequence: [1, 2, 3, 4, 5], mapping: {a: 1, b: 2, c: 3}, nested: {items: [x, y, z], config: {timeout: 30, retries: 3}}}, block_in_flow: {users: [{name: Alice, tags: [dev, senior]}, {name: Bob, tags: [ops, junior]}]}, mixed_structure: {services: [{name: api, ports: [8080, 8443], env: {DEBUG: true, LOG_LEVEL: info}}, {name: db, ports: [5432], env: {POSTGRES_DB: mydb, POSTGRES_USER: admin}}], config: {version: 1, enabled: true}}, flow_types: {strings: [hello, world, foo, bar], numbers: [1, 2, 3, 42, 100], mixed: [string, 123, true, false, null], quoted: [with spaces, 'special:chars', commas, here]}, flow_map_types: {string: value, number: 42, boolean: true, null_value: null, float: 3.14}, nested_mixed: [{id: 1, data: [a, b, c], meta: {type: first}}, {id: 2, data: [d, e, f], meta: {type: second}}, {id: 3, data: [g, h, i], meta: {type: third}}], multiline_flow: {long_sequence: [item1, item2, item3, item4], long_mapping: {key1: value1, key2: value2, key3: value3}}, edge_cases: {single_item_seq: [alone], single_item_map: {only: one}, nested_empty: [[], [{}], [{}, []]], all_empty: [{}, [], {a: []}, {b: {}}]}}

     

       519
       519
        
       

     

       520
       520
        
       Inline test: Simple sequence

     

       521
       521
        
       

     
···

       686
       686
        
         $ echo 'block_key:

     

       687
       687
        
         >   flow_seq: [1, 2, 3]

     

       688
       688
        
         >   flow_map: {a: 1, b: 2}' | yamlcat --flow

     

       689
       689
       -
         {block_key: {flow_seq: [1, 2, 3]flow_map, {a: 1, b: 2}}}

     

       689
       689
       +
         {block_key: {flow_seq: [1, 2, 3], flow_map: {a: 1, b: 2}}}

     

       690
       690
        
       

     

       691
       691
        
       Inline test: Mixed block and flow (block in flow)

     

       692
       692
        
       

     
···

       769
       769
        
         >   tags: [x, y, z]

     

       770
       770
        
         >   config:

     

       771
       771
        
         >     enabled: false' | yamlcat --flow

     

       772
       772
       -
         [{id: 1, tags: [a, b, c]config, {enabled: true}}, {id: 2, tags: [x, y, z]config, {enabled: false}}]

     

       772
       772
       +
         [{id: 1, tags: [a, b, c], config: {enabled: true}}, {id: 2, tags: [x, y, z], config: {enabled: false}}]

     

       773
       773
        
       

     

       774
       774
        
       Inline test: Empty collections

     

       775
       775
        
       

     
···

       784
       784
        
       

     

       785
       785
        
         $ echo 'empty_seq: []

     

       786
       786
        
         > empty_map: {}' | yamlcat --flow

     

       787
       787
       -
         {empty_seq: []empty_map, {}}

     

       787
       787
       +
         {empty_seq: [], empty_map: {}}

     

       788
       788
        
       

     

       789
       789
        
       Inline test: Sequence with mapping values

     

       790
       790
        
       

     
···

       811
       811
        
         >   - banana

     

       812
       812
        
         > config:

     

       813
       813
        
         >   mode: fast' | yamlcat --flow

     

       814
       814
       -
         {items: [apple, banana]config, {mode: fast}}

     

       814
       814
       +
         {items: [apple, banana], config: {mode: fast}}

     

       815
       815
        
       

     

       816
       816
        
       Inline test: Complex nested structure

     

       817
       817
        
       

     
···

       850
       850
        
         >     env:

     

       851
       851
        
         >       DEBUG: false

     

       852
       852
        
         >       MODE: prod' | yamlcat --flow

     

       853
       853
       -
         {services: [{name: web, ports: [80, 443]env, {DEBUG: false, MODE: prod}}]}

     

       853
       853
       +
         {services: [{name: web, ports: [80, 443], env: {DEBUG: false, MODE: prod}}]}

     

       854
       854
        
       

     

       855
       855
        
       Inline test: Flow sequence with various types

     

       856
       856

tests/cram/directive_with_comment.yml

···

       1
       1
       +
       %YAML 1.2

     

       2
       2
       +
       # Comment after directive

     

       3
       3
       +
       ---

     

       4
       4
       +
       key: value

tests/cram/directive_without_start.yml

···

       1
       1
       +
       %YAML 1.2

     

       2
       2
       +
       simple: document

tests/cram/doc_with_comments.yml

···

       1
       1
       +
       # This is a comment

     

       2
       2
       +
       name: Alice

     

       3
       3
       +
       # Another comment

     

       4
       4
       +
       value: 42

tests/cram/doc_with_end.yml

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Example

     

       3
       3
       +
       content: data

     

       4
       4
       +
       ...

+11 -35

tests/cram/documents.t

···

       1
       1
        
       Test YAML directives and single document parsing

     

       2
       2
        
       

     

       3
       3
        
       This test suite covers YAML directives (%YAML, %TAG) and various single document formats.

     

       4
       4
       -
       Multi-document streams are not yet supported and are not tested here.

     

       4
       4
       +
       For multi-document stream tests, see multidoc.t.

     

       5
       5
        
       

     

       6
       6
        
       Test 1: Basic YAML 1.2 directive

     

       7
       7
        
       ====================================

     
···

       102
       102
        
       Test 9: Inline - implicit document (no markers)

     

       103
       103
        
       ====================================

     

       104
       104
        
       

     

       105
       105
       -
         $ echo 'name: John

     

       106
       106
       -
         > age: 30

     

       107
       107
       -
         > city: New York' | yamlcat

     

       105
       105
       +
         $ yamlcat person_john.yml

     

       108
       106
        
         name: John

     

       109
       107
        
         age: 30

     

       110
       108
        
         city: New York

     
···

       112
       110
        
       Test 10: Inline - explicit start marker

     

       113
       111
        
       ====================================

     

       114
       112
        
       

     

       115
       115
       -
         $ echo '---

     

       116
       116
       -
         > name: Jane

     

       117
       117
       -
         > age: 25' | yamlcat

     

       113
       113
       +
         $ yamlcat person_jane.yml

     

       118
       114
        
         name: Jane

     

       119
       115
        
         age: 25

     

       120
       116
        
       

     

       121
       117
        
       Test 11: Inline - explicit start and end markers

     

       122
       118
        
       ====================================

     

       123
       119
        
       

     

       124
       124
       -
         $ echo '---

     

       125
       125
       -
         > title: Example

     

       126
       126
       -
         > content: data

     

       127
       127
       -
         > ...' | yamlcat

     

       120
       120
       +
         $ yamlcat doc_with_end.yml

     

       128
       121
        
         title: Example

     

       129
       122
        
         content: data

     

       130
       123
        
       

     

       131
       124
        
       Test 12: Inline - document with %YAML 1.2 directive

     

       132
       125
        
       ====================================

     

       133
       126
        
       

     

       134
       134
       -
         $ echo '%YAML 1.2

     

       135
       135
       -
         > ---

     

       136
       136
       -
         > version: 1.2

     

       137
       137
       -
         > enabled: true' | yamlcat

     

       127
       127
       +
         $ yamlcat yaml12_version.yml

     

       138
       128
        
         version: 1.2

     

       139
       129
        
         enabled: true

     

       140
       130
        
       

     

       141
       131
        
       Test 13: Inline - document with comment before content

     

       142
       132
        
       ====================================

     

       143
       133
        
       

     

       144
       144
       -
         $ echo '# This is a comment

     

       145
       145
       -
         > name: Alice

     

       146
       146
       -
         > # Another comment

     

       147
       147
       -
         > value: 42' | yamlcat

     

       134
       134
       +
         $ yamlcat doc_with_comments.yml

     

       148
       135
        
         name: Alice

     

       149
       136
        
         value: 42

     

       150
       137
        
       

     

       151
       138
        
       Test 14: Inline - document with comment after directive

     

       152
       139
        
       ====================================

     

       153
       140
        
       

     

       154
       154
       -
         $ echo '%YAML 1.2

     

       155
       155
       -
         > # Comment after directive

     

       156
       156
       -
         > ---

     

       157
       157
       -
         > key: value' | yamlcat

     

       141
       141
       +
         $ yamlcat directive_with_comment.yml

     

       158
       142
        
         key: value

     

       159
       143
        
       

     

       160
       144
        
       Test 15: Inline - explicit markers with comments

     

       161
       145
        
       ====================================

     

       162
       146
        
       

     

       163
       163
       -
         $ echo '---  # Document start

     

       164
       164
       -
         > data: content

     

       165
       165
       -
         > # Mid-document comment

     

       166
       166
       -
         > more: values

     

       167
       167
       -
         > ...  # Document end' | yamlcat

     

       147
       147
       +
         $ yamlcat start_with_comment.yml

     

       168
       148
        
         data: content

     

       169
       149
        
         more: values

     

       170
       150
        
       

     
···

       183
       163
        
       Test 18: Empty document with explicit markers

     

       184
       164
        
       ====================================

     

       185
       165
        
       

     

       186
       186
       -
         $ echo '---

     

       187
       187
       -
         > ...' | yamlcat

     

       166
       166
       +
         $ yamlcat empty_doc_markers.yml

     

       188
       167
        
         null

     

       189
       168
        
       

     

       190
       169
        
       Test 19: Document with only whitespace and markers

     

       191
       170
        
       ====================================

     

       192
       171
        
       

     

       193
       193
       -
         $ echo '---

     

       194
       194
       -
         > 

     

       195
       195
       -
         > ...' | yamlcat

     

       172
       172
       +
         $ yamlcat empty_doc_with_blank.yml

     

       196
       173
        
         null

     

       197
       174
        
       

     

       198
       175
        
       Test 20: Directive followed by content without explicit start

     

       199
       176
        
       ====================================

     

       200
       177
        
       

     

       201
       201
       -
         $ echo '%YAML 1.2

     

       202
       202
       -
         > simple: document' | yamlcat

     

       178
       178
       +
         $ yamlcat directive_without_start.yml

     

       203
       179
        
         Error: expected document start '---' at line 2, columns 1-1

     

       204
       180
        
         [1]

tests/cram/empty_both.yml

···

       1
       1
       +
       empty_seq: []

     

       2
       2
       +
       empty_map: {}

+6 -14

tests/cram/empty_collections.t

···

       5
       5
        
       

     

       6
       6
        
       Test: Empty sequence

     

       7
       7
        
       

     

       8
       8
       -
         $ echo 'empty_seq: []' | yamlcat

     

       8
       8
       +
         $ yamlcat empty_seq.yml

     

       9
       9
        
         empty_seq: []

     

       10
       10
        
       

     

       11
       11
        
       Test: Empty mapping

     

       12
       12
        
       

     

       13
       13
       -
         $ echo 'empty_map: {}' | yamlcat

     

       13
       13
       +
         $ yamlcat empty_map.yml

     

       14
       14
        
         empty_map: {}

     

       15
       15
        
       

     

       16
       16
        
       Test: Multiple empty collections

     

       17
       17
        
       

     

       18
       18
       -
         $ echo 'seq: []

     

       19
       19
       -
         > map: {}

     

       20
       20
       -
         > data: value' | yamlcat

     

       18
       18
       +
         $ yamlcat multiple_empty.yml

     

       21
       19
        
         seq: []

     

       22
       20
        
         map: {}

     

       23
       21
        
         data: value

     

       24
       22
        
       

     

       25
       23
        
       Test: Nested empty collections

     

       26
       24
        
       

     

       27
       27
       -
         $ echo 'outer:

     

       28
       28
       -
         >   inner_seq: []

     

       29
       29
       -
         >   inner_map: {}' | yamlcat

     

       25
       25
       +
         $ yamlcat nested_empty.yml

     

       30
       26
        
         outer:

     

       31
       27
        
           inner_seq: []

     

       32
       28
        
           inner_map: {}

     

       33
       29
        
       

     

       34
       30
        
       Test: Empty collection in sequence

     

       35
       31
        
       

     

       36
       36
       -
         $ echo 'items:

     

       37
       37
       -
         >   - first

     

       38
       38
       -
         >   - []

     

       39
       39
       -
         >   - third' | yamlcat

     

       32
       32
       +
         $ yamlcat empty_in_seq.yml

     

       40
       33
        
         items:

     

       41
       34
        
           - first

     

       42
       35
        
           - []

     
···

       44
       37
        
       

     

       45
       38
        
       Test: Verify JSON output is correct (for comparison)

     

       46
       39
        
       

     

       47
       47
       -
         $ echo 'empty_seq: []

     

       48
       48
       -
         > empty_map: {}' | yamlcat --json

     

       40
       40
       +
         $ yamlcat --json empty_both.yml

     

       49
       41
        
         {"empty_seq": [], "empty_map": {}}

tests/cram/empty_doc_markers.yml

tests/cram/empty_doc_with_blank.yml

tests/cram/empty_in_seq.yml

tests/cram/empty_map.yml

···

       1
       1
       +
       empty_map: {}

tests/cram/empty_seq.yml

···

       1
       1
       +
       empty_seq: []

tests/cram/escaped_backslashes.yml

···

       1
       1
       +
       escaped: "one\\two\\three"

+7 -8

tests/cram/failing_escapes.t

···

       9
       9
        
       

     

       10
       10
        
       Test: Capital U interpreted as unicode escape

     

       11
       11
        
       

     

       12
       12
       -
         $ echo 'path: "C:\\Users\\Name"' | yamlcat --json 2>&1

     

       12
       12
       +
         $ yamlcat --json failing_escapes.yml 2>&1

     

       13
       13
        
         Error: invalid hex escape:  at line 1, columns 12-12

     

       14
       14
        
         [1]

     

       15
       15
        
       

     

       16
       16
        
       This fails because:

     

       17
       17
       -
       - Shell: echo 'C:\\Users\\Name' produces C:\Users\Name

     

       18
       18
       -
       - YAML sees: "C:\Users\Name"

     

       17
       17
       +
       - YAML input: "C:\Users\Name"

     

       19
       18
        
       - \U is a 32-bit unicode escape (expects \UHHHHHHHH)

     

       20
       19
        
       - "sers" are not 8 hex digits, so it fails

     

       21
       20
        
       

     

       22
       21
        
       Test: Lowercase u unicode escape works

     

       23
       22
        
       

     

       24
       24
       -
         $ echo 'unicode: "\\u0041"' | yamlcat --json

     

       23
       23
       +
         $ yamlcat --json lowercase_u_unicode.yml

     

       25
       24
        
         {"unicode": "A"}

     

       26
       25
        
       

     

       27
       26
        
       Test: Uppercase U requires 8 hex digits

     

       28
       27
        
       

     

       29
       29
       -
         $ echo 'unicode: "\\U00000041"' | yamlcat --json

     

       28
       28
       +
         $ yamlcat --json uppercase_U_unicode.yml

     

       30
       29
        
         {"unicode": "A"}

     

       31
       30
        
       

     

       32
       31
        
       Test: Backslash escaping works for non-unicode

     

       33
       32
        
       

     

       34
       34
       -
         $ echo 'escaped: "one\\\\two\\\\three"' | yamlcat --json

     

       33
       33
       +
         $ yamlcat --json escaped_backslashes.yml

     

       35
       34
        
         {"escaped": "one\\two\\three"}

     

       36
       35
        
       

     

       37
       36
        
       Test: Mixed valid escapes

     

       38
       37
        
       

     

       39
       39
       -
         $ echo 'text: "Tab:\\t Newline:\\n Quote:\\\\"' | yamlcat --json

     

       38
       38
       +
         $ yamlcat --json mixed_escapes.yml

     

       40
       39
        
         {"text": "Tab:\t Newline:\n Quote:\\"}

     

       41
       40
        
       

     

       42
       41
        
       Test: Backslash a is bell character

     

       43
       42
        
       

     

       44
       44
       -
         $ echo 'text: "test\\a"' | yamlcat --json

     

       43
       43
       +
         $ yamlcat --json bell_character.yml

     

       45
       44
        
         {"text": "test\007"}

tests/cram/failing_escapes.yml

···

       1
       1
       +
       path: "C:\Users\Name"

tests/cram/folded_block.yml

tests/cram/fruits_list.yml

tests/cram/fruits_mapping.yml

tests/cram/hobbies.yml

···

       1
       1
       +
       name: Alice

     

       2
       2
       +
       hobbies:

     

       3
       3
       +
         - reading

     

       4
       4
       +
         - coding

tests/cram/literal_block.yml

tests/cram/lowercase_u_unicode.yml

···

       1
       1
       +
       unicode: "\u0041"

tests/cram/mixed_escapes.yml

···

       1
       1
       +
       text: "Tab:\t Newline:\n Quote:\\"

+2 -3

tests/cram/multidoc.t

···

       1
       1
       -
       Multi-document stream support (currently not supported)

     

       1
       1
       +
       Multi-document stream support

     

       2
       2
        
       

     

       3
       3
       -
       These tests document expected behavior for multi-document YAML streams.

     

       4
       4
       -
       They currently fail with "multiple documents found when single expected".

     

       3
       3
       +
       These tests verify that multi-document YAML streams are working correctly.

     

       5
       4
        
       

     

       6
       5
        
       Test: Two documents separated by ---

     

       7
       6

tests/cram/multiple_empty.yml

···

       1
       1
       +
       seq: []

     

       2
       2
       +
       map: {}

     

       3
       3
       +
       data: value

tests/cram/multiple_escapes.yml

···

       1
       1
       +
       text: "Tab:\t Newline:\n Quote:\" Backslash:\\\\"

tests/cram/nested_empty.yml

···

       1
       1
       +
       outer:

     

       2
       2
       +
         inner_seq: []

     

       3
       3
       +
         inner_map: {}

tests/cram/nested_mappings.yml

···

       1
       1
       +
       server:

     

       2
       2
       +
         host: localhost

     

       3
       3
       +
         port: 8080

     

       4
       4
       +
       database:

     

       5
       5
       +
         name: mydb

tests/cram/person.yml

···

       1
       1
       +
       name: Alice

     

       2
       2
       +
       age: 30

tests/cram/person_jane.yml

tests/cram/person_john.yml

···

       1
       1
       +
       name: John

     

       2
       2
       +
       age: 30

     

       3
       3
       +
       city: New York

tests/cram/quoted_strings.yml

···

       1
       1
       +
       single: 'hello world'

     

       2
       2
       +
       double: "hello world"

tests/cram/scalar_bool_vs_string.yml

···

       1
       1
       +
       unquoted_true: true

     

       2
       2
       +
       quoted_true: "true"

tests/cram/scalar_clip_folded.yml

···

       1
       1
       +
       text: >

     

       2
       2
       +
         Folded with one

     

       3
       3
       +
         trailing newline

     

       4
       4
       +

tests/cram/scalar_clip_literal.yml

···

       1
       1
       +
       text: |

     

       2
       2
       +
         One trailing newline

     

       3
       3
       +

tests/cram/scalar_code_sample.yml

···

       1
       1
       +
       code: |

     

       2
       2
       +
         def hello():

     

       3
       3
       +
             print("Hello")

     

       4
       4
       +
             if True:

     

       5
       5
       +
                 return 42

tests/cram/scalar_double_empty.yml

···

       1
       1
       +
       empty: ""

tests/cram/scalar_double_quote.yml

···

       1
       1
       +
       text: "She said \"hello\""

tests/cram/scalar_double_simple.yml

···

       1
       1
       +
       double: "hello world"

tests/cram/scalar_empty_folded.yml

···

       1
       1
       +
       empty_folded: >

tests/cram/scalar_empty_literal.yml

···

       1
       1
       +
       empty_literal: |

tests/cram/scalar_folded_basic.yml

···

       1
       1
       +
       text: >

     

       2
       2
       +
         This is a long paragraph

     

       3
       3
       +
         that will be folded into

     

       4
       4
       +
         a single line.

tests/cram/scalar_folded_comment.yml

···

       1
       1
       +
       text: >

     

       2
       2
       +
         Normal paragraph

     

       3
       3
       +
         that continues.

     

       4
       4
       +
         # This is part of the content

tests/cram/scalar_folded_indent_preserve.yml

···

       1
       1
       +
       text: >

     

       2
       2
       +
         Normal paragraph

     

       3
       3
       +
         continues here.

     

       4
       4
       +
       

     

       5
       5
       +
           Indented block

     

       6
       6
       +
           preserved.

     

       7
       7
       +
       

     

       8
       8
       +
         Back to normal.

tests/cram/scalar_folded_para.yml

···

       1
       1
       +
       text: >

     

       2
       2
       +
         First paragraph

     

       3
       3
       +
         flows together.

     

       4
       4
       +
       

     

       5
       5
       +
         Second paragraph

     

       6
       6
       +
         also flows.

tests/cram/scalar_folded_strip.yml

···

       1
       1
       +
       text: >-

     

       2
       2
       +
         Folded text

     

       3
       3
       +
         with stripped

     

       4
       4
       +
         trailing newlines

     

       5
       5
       +

tests/cram/scalar_indent2_folded.yml

···

       1
       1
       +
       text: >2

     

       2
       2
       +
           Text with two space

     

       3
       3
       +
           base indentation that

     

       4
       4
       +
           will be folded.

tests/cram/scalar_indent2_keep.yml

···

       1
       1
       +
       text: |2+

     

       2
       2
       +
           Indented by 2

     

       3
       3
       +
           Keeps trailing newlines

     

       4
       4
       +
       

     

       5
       5
       +
       

     

       6
       6
       +

tests/cram/scalar_indent2_literal.yml

···

       1
       1
       +
       text: |2

     

       2
       2
       +
           Two space base

     

       3
       3
       +
           Second line

     

       4
       4
       +
             Extra indent

tests/cram/scalar_indent2_strip.yml

···

       1
       1
       +
       text: |2-

     

       2
       2
       +
           Indented by 2

     

       3
       3
       +
           No trailing newlines

     

       4
       4
       +

tests/cram/scalar_keep_folded.yml

···

       1
       1
       +
       text: >+

     

       2
       2
       +
         Folded text

     

       3
       3
       +
         keeps trailing

     

       4
       4
       +
       

     

       5
       5
       +
       

     

       6
       6
       +

tests/cram/scalar_keep_literal.yml

···

       1
       1
       +
       text: |+

     

       2
       2
       +
         Keeps trailing newlines

     

       3
       3
       +
       

     

       4
       4
       +
       

     

       5
       5
       +

tests/cram/scalar_literal_basic.yml

tests/cram/scalar_literal_blank.yml

···

       1
       1
       +
       text: |

     

       2
       2
       +
         First paragraph

     

       3
       3
       +
       

     

       4
       4
       +
         Second paragraph

tests/cram/scalar_literal_indent.yml

···

       1
       1
       +
       text: |

     

       2
       2
       +
         First line

     

       3
       3
       +
           Indented line

     

       4
       4
       +
         Back to first

tests/cram/scalar_nested_blocks.yml

···

       1
       1
       +
       outer:

     

       2
       2
       +
         inner:

     

       3
       3
       +
           description: >

     

       4
       4
       +
             This is a folded

     

       5
       5
       +
             description.

     

       6
       6
       +
           code: |

     

       7
       7
       +
             def test():

     

       8
       8
       +
                 return True

tests/cram/scalar_null_vs_string.yml

···

       1
       1
       +
       unquoted_null: null

     

       2
       2
       +
       quoted_null: "null"

tests/cram/scalar_plain_multi.yml

···

       1
       1
       +
       name: Alice

     

       2
       2
       +
       age: 30

     

       3
       3
       +
       active: true

tests/cram/scalar_plain_simple.yml

···

       1
       1
       +
       key: value

tests/cram/scalar_plain_types.yml

···

       1
       1
       +
       null_val: null

     

       2
       2
       +
       bool_true: true

     

       3
       3
       +
       bool_false: false

     

       4
       4
       +
       number: 42

     

       5
       5
       +
       float: 3.14

tests/cram/scalar_seq_blocks.yml

···

       1
       1
       +
       items:

     

       2
       2
       +
         - |

     

       3
       3
       +
           First item

     

       4
       4
       +
           multiline

     

       5
       5
       +
         - >

     

       6
       6
       +
           Second item

     

       7
       7
       +
           folded

tests/cram/scalar_single_dquote.yml

···

       1
       1
       +
       quote: 'He said "hello"'

tests/cram/scalar_single_empty.yml

···

       1
       1
       +
       empty: ''

tests/cram/scalar_single_escaped.yml

···

       1
       1
       +
       escaped: 'It''s a test'

tests/cram/scalar_single_multiline.yml

···

       1
       1
       +
       text: 'This is a

     

       2
       2
       +
         multi-line

     

       3
       3
       +
         string'

tests/cram/scalar_single_simple.yml

···

       1
       1
       +
       single: 'hello world'

tests/cram/scalar_special_chars.yml

···

       1
       1
       +
       code: |

     

       2
       2
       +
         Special: @#$%^&*()

     

       3
       3
       +
         Symbols: <>?/\|

     

       4
       4
       +
         Brackets: []{}

tests/cram/scalar_strip_blank.yml

tests/cram/scalar_strip_simple.yml

···

       1
       1
       +
       text: |-

     

       2
       2
       +
         No trailing newline

tests/cram/scalar_whitespace.yml

···

       1
       1
       +
       leading: "  spaces"

     

       2
       2
       +
       trailing: "spaces  "

     

       3
       3
       +
       both: "  both  "

+49 -142

tests/cram/scalars.t

···

       8
       8
        
       

     

       9
       9
        
       Simple plain scalars

     

       10
       10
        
       

     

       11
       11
       -
         $ echo 'key: value' | yamlcat

     

       11
       11
       +
         $ yamlcat scalar_plain_simple.yml

     

       12
       12
        
         key: value

     

       13
       13
        
       

     

       14
       14
       -
         $ echo 'name: Alice

     

       15
       15
       -
         > age: 30

     

       16
       16
       -
         > active: true' | yamlcat

     

       14
       14
       +
         $ yamlcat scalar_plain_multi.yml

     

       17
       15
        
         name: Alice

     

       18
       16
        
         age: 30

     

       19
       17
        
         active: true

     

       20
       18
        
       

     

       21
       19
        
       Plain scalars with special values

     

       22
       20
        
       

     

       23
       23
       -
         $ echo 'null_val: null

     

       24
       24
       -
         > bool_true: true

     

       25
       25
       -
         > bool_false: false

     

       26
       26
       -
         > number: 42

     

       27
       27
       -
         > float: 3.14' | yamlcat --json

     

       21
       21
       +
         $ yamlcat --json scalar_plain_types.yml

     

       28
       22
        
         {"null_val": null, "bool_true": true, "bool_false": false, "number": 42, "float": 3.14}

     

       29
       23
        
       

     

       30
       24
        
       ================================================================================

     
···

       33
       27
        
       

     

       34
       28
        
       Single-quoted strings preserve literal text

     

       35
       29
        
       

     

       36
       36
       -
         $ echo "single: 'hello world'" | yamlcat

     

       30
       30
       +
         $ yamlcat scalar_single_simple.yml

     

       37
       31
        
         single: hello world

     

       38
       32
        
       

     

       39
       33
        
       Single-quoted strings with embedded double quotes

     

       40
       34
        
       

     

       41
       41
       -
         $ echo "quote: 'He said \"hello\"'" | yamlcat

     

       35
       35
       +
         $ yamlcat scalar_single_dquote.yml

     

       42
       36
        
         quote: "He said \"hello\""

     

       43
       37
        
       

     

       44
       38
        
       Single-quoted strings with escaped single quotes (doubled)

     

       45
       39
        
       

     

       46
       46
       -
         $ echo "escaped: 'It''s a test'" | yamlcat

     

       40
       40
       +
         $ yamlcat scalar_single_escaped.yml

     

       47
       41
        
         escaped: It's a test

     

       48
       42
        
       

     

       49
       43
        
       Single-quoted multiline (newlines become spaces)

     

       50
       44
        
       

     

       51
       51
       -
         $ echo "text: 'This is a

     

       52
       52
       -
         >   multi-line

     

       53
       53
       -
         >   string'" | yamlcat --json

     

       45
       45
       +
         $ yamlcat --json scalar_single_multiline.yml

     

       54
       46
        
         {"text": "This is a multi-line string"}

     

       55
       47
        
       

     

       56
       48
        
       Empty single-quoted string

     

       57
       49
        
       

     

       58
       58
       -
         $ echo "empty: ''" | yamlcat

     

       50
       50
       +
         $ yamlcat scalar_single_empty.yml

     

       59
       51
        
         empty: ''

     

       60
       52
        
       

     

       61
       53
        
       ================================================================================

     
···

       64
       56
        
       

     

       65
       57
        
       Simple double-quoted strings

     

       66
       58
        
       

     

       67
       67
       -
         $ echo 'double: "hello world"' | yamlcat

     

       59
       59
       +
         $ yamlcat scalar_double_simple.yml

     

       68
       60
        
         double: hello world

     

       69
       61
        
       

     

       70
       62
        
       Double-quoted with escaped newline

     
···

       74
       66
        
       

     

       75
       67
        
       Double-quoted with escaped tab

     

       76
       68
        
       

     

       77
       77
       -
         $ echo 'text: "Col1\tCol2\tCol3"' | yamlcat --json

     

       69
       69
       +
         $ yamlcat --json tab_columns.yml

     

       78
       70
        
         {"text": "Col1\tCol2\tCol3"}

     

       79
       71
        
       

     

       80
       80
       -
       Double-quoted with backslash escape

     

       72
       72
       +
       Double-quoted with backslash escape (Windows path)

     

       73
       73
       +
       Note: Using YAML file instead of echo to avoid shell interpretation

     

       74
       74
       +
       The echo command would interpret \\ as \ before yamlcat sees it

     

       81
       75
        
       

     

       82
       82
       -
         $ echo 'path: "C:\\Users\\Name"' | yamlcat --json

     

       83
       83
       -
         Error: invalid hex escape:  at line 1, columns 12-12

     

       84
       84
       -
         [1]

     

       76
       76
       +
         $ yamlcat --json windows_path.yml

     

       77
       77
       +
         {"path": "C:\\Users\\Name"}

     

       85
       78
        
       

     

       86
       79
        
       Double-quoted with escaped quote

     

       87
       80
        
       

     

       88
       88
       -
         $ echo 'text: "She said \"hello\""' | yamlcat --json

     

       81
       81
       +
         $ yamlcat --json scalar_double_quote.yml

     

       89
       82
        
         {"text": "She said \"hello\""}

     

       90
       83
        
       

     

       91
       84
        
       Double-quoted with multiple escape sequences

     

       85
       85
       +
       Note: Using YAML file instead of echo to avoid shell interpretation

     

       86
       86
       +
       The echo command interprets \t and \n before yamlcat sees them

     

       92
       87
        
       

     

       93
       93
       -
         $ echo 'text: "Tab:\t Newline:\n Quote:\" Backslash:\\\\"' | yamlcat --json

     

       94
       94
       -
         {"text": "Tab:\t Newline: Quote:\" Backslash:\\"}

     

       88
       88
       +
         $ yamlcat --json multiple_escapes.yml

     

       89
       89
       +
         {"text": "Tab:\t Newline:\n Quote:\" Backslash:\\\\"}

     

       95
       90
        
       

     

       96
       91
        
       Empty double-quoted string

     

       97
       92
        
       

     

       98
       98
       -
         $ echo 'empty: ""' | yamlcat

     

       93
       93
       +
         $ yamlcat scalar_double_empty.yml

     

       99
       94
        
         empty: ''

     

       100
       95
        
       

     

       101
       96
        
       ================================================================================

     
···

       104
       99
        
       

     

       105
       100
        
       Basic literal block scalar (preserves newlines)

     

       106
       101
        
       

     

       107
       107
       -
         $ echo 'text: |

     

       108
       108
       -
         >   line one

     

       109
       109
       -
         >   line two

     

       110
       110
       -
         >   line three' | yamlcat --json

     

       102
       102
       +
         $ yamlcat --json scalar_literal_basic.yml

     

       111
       103
        
         {"text": "line one\nline two\nline three\n"}

     

       112
       104
        
       

     

       113
       105
        
       Literal with indentation

     

       114
       106
        
       

     

       115
       115
       -
         $ echo 'text: |

     

       116
       116
       -
         >   First line

     

       117
       117
       -
         >     Indented line

     

       118
       118
       -
         >   Back to first' | yamlcat --json

     

       107
       107
       +
         $ yamlcat --json scalar_literal_indent.yml

     

       119
       108
        
         {"text": "First line\n  Indented line\nBack to first\n"}

     

       120
       109
        
       

     

       121
       110
        
       Literal with blank lines

     

       122
       111
        
       

     

       123
       123
       -
         $ echo 'text: |

     

       124
       124
       -
         >   First paragraph

     

       125
       125
       -
         > 

     

       126
       126
       -
         >   Second paragraph' | yamlcat --json

     

       112
       112
       +
         $ yamlcat --json scalar_literal_blank.yml

     

       127
       113
        
         {"text": "First paragraph\n\nSecond paragraph\n"}

     

       128
       114
        
       

     

       129
       115
        
       ================================================================================

     
···

       132
       118
        
       

     

       133
       119
        
       Basic folded block scalar (newlines become spaces)

     

       134
       120
        
       

     

       135
       135
       -
         $ echo 'text: >

     

       136
       136
       -
         >   This is a long paragraph

     

       137
       137
       -
         >   that will be folded into

     

       138
       138
       -
         >   a single line.' | yamlcat --json

     

       121
       121
       +
         $ yamlcat --json scalar_folded_basic.yml

     

       139
       122
        
         {"text": "This is a long paragraph that will be folded into a single line.\n"}

     

       140
       123
        
       

     

       141
       124
        
       Folded with paragraph separation (blank line preserved)

     

       142
       125
        
       

     

       143
       143
       -
         $ echo 'text: >

     

       144
       144
       -
         >   First paragraph

     

       145
       145
       -
         >   flows together.

     

       146
       146
       -
         > 

     

       147
       147
       -
         >   Second paragraph

     

       148
       148
       -
         >   also flows.' | yamlcat --json

     

       126
       126
       +
         $ yamlcat --json scalar_folded_para.yml

     

       149
       127
        
         {"text": "First paragraph flows together.\nSecond paragraph also flows.\n"}

     

       150
       128
        
       

     

       151
       129
        
       ================================================================================

     
···

       154
       132
        
       

     

       155
       133
        
       Strip chomping (-) removes trailing newlines

     

       156
       134
        
       

     

       157
       157
       -
         $ echo 'text: |-

     

       158
       158
       -
         >   No trailing newline' | yamlcat --json

     

       135
       135
       +
         $ yamlcat --json scalar_strip_simple.yml

     

       159
       136
        
         {"text": "No trailing newline"}

     

       160
       137
        
       

     

       161
       161
       -
         $ echo 'text: |-

     

       162
       162
       -
         >   Text here

     

       163
       163
       -
         > 

     

       164
       164
       -
         > ' | yamlcat --json

     

       138
       138
       +
         $ yamlcat --json scalar_strip_blank.yml

     

       165
       139
        
         {"text": "Text here"}

     

       166
       140
        
       

     

       167
       141
        
       Folded with strip

     

       168
       142
        
       

     

       169
       169
       -
         $ echo 'text: >-

     

       170
       170
       -
         >   Folded text

     

       171
       171
       -
         >   with stripped

     

       172
       172
       -
         >   trailing newlines

     

       173
       173
       -
         > 

     

       174
       174
       -
         > ' | yamlcat --json

     

       143
       143
       +
         $ yamlcat --json scalar_folded_strip.yml

     

       175
       144
        
         {"text": "Folded text with stripped trailing newlines"}

     

       176
       145
        
       

     

       177
       146
        
       Clip chomping (default) keeps single trailing newline

     

       178
       147
        
       

     

       179
       179
       -
         $ echo 'text: |

     

       180
       180
       -
         >   One trailing newline

     

       181
       181
       -
         > 

     

       182
       182
       -
         > ' | yamlcat --json

     

       148
       148
       +
         $ yamlcat --json scalar_clip_literal.yml

     

       183
       149
        
         {"text": "One trailing newline\n"}

     

       184
       150
        
       

     

       185
       185
       -
         $ echo 'text: >

     

       186
       186
       -
         >   Folded with one

     

       187
       187
       -
         >   trailing newline

     

       188
       188
       -
         > 

     

       189
       189
       -
         > ' | yamlcat --json

     

       151
       151
       +
         $ yamlcat --json scalar_clip_folded.yml

     

       190
       152
        
         {"text": "Folded with one trailing newline\n"}

     

       191
       153
        
       

     

       192
       154
        
       Keep chomping (+) preserves all trailing newlines

     

       193
       155
        
       

     

       194
       194
       -
         $ echo 'text: |+

     

       195
       195
       -
         >   Keeps trailing newlines

     

       196
       196
       -
         > 

     

       197
       197
       -
         > 

     

       198
       198
       -
         > ' | yamlcat --json

     

       156
       156
       +
         $ yamlcat --json scalar_keep_literal.yml

     

       199
       157
        
         {"text": "Keeps trailing newlines\n\n\n\n"}

     

       200
       158
        
       

     

       201
       201
       -
         $ echo 'text: >+

     

       202
       202
       -
         >   Folded text

     

       203
       203
       -
         >   keeps trailing

     

       204
       204
       -
         > 

     

       205
       205
       -
         > 

     

       206
       206
       -
         > ' | yamlcat --json

     

       159
       159
       +
         $ yamlcat --json scalar_keep_folded.yml

     

       207
       160
        
         {"text": "Folded text keeps trailing\n\n\n\n"}

     

       208
       161
        
       

     

       209
       162
        
       ================================================================================

     
···

       212
       165
        
       

     

       213
       166
        
       Literal with explicit 2-space indentation

     

       214
       167
        
       

     

       215
       215
       -
         $ echo 'text: |2

     

       216
       216
       -
         >     Two space base

     

       217
       217
       -
         >     Second line

     

       218
       218
       -
         >       Extra indent' | yamlcat --json

     

       168
       168
       +
         $ yamlcat --json scalar_indent2_literal.yml

     

       219
       169
        
         {"text": "  Two space base\n  Second line\n    Extra indent\n"}

     

       220
       170
        
       

     

       221
       171
        
       Folded with explicit indentation

     

       222
       172
        
       

     

       223
       223
       -
         $ echo 'text: >2

     

       224
       224
       -
         >     Text with two space

     

       225
       225
       -
         >     base indentation that

     

       226
       226
       -
         >     will be folded.' | yamlcat --json

     

       173
       173
       +
         $ yamlcat --json scalar_indent2_folded.yml

     

       227
       174
        
         {"text": "  Text with two space\n  base indentation that\n  will be folded.\n"}

     

       228
       175
        
       

     

       229
       176
        
       Combined indentation and chomping indicators

     

       230
       177
        
       

     

       231
       231
       -
         $ echo 'text: |2-

     

       232
       232
       -
         >     Indented by 2

     

       233
       233
       -
         >     No trailing newlines

     

       234
       234
       -
         > 

     

       235
       235
       -
         > ' | yamlcat --json

     

       178
       178
       +
         $ yamlcat --json scalar_indent2_strip.yml

     

       236
       179
        
         {"text": "  Indented by 2\n  No trailing newlines"}

     

       237
       180
        
       

     

       238
       238
       -
         $ echo 'text: |2+

     

       239
       239
       -
         >     Indented by 2

     

       240
       240
       -
         >     Keeps trailing newlines

     

       241
       241
       -
         > 

     

       242
       242
       -
         > 

     

       243
       243
       -
         > ' | yamlcat --json

     

       181
       181
       +
         $ yamlcat --json scalar_indent2_keep.yml

     

       244
       182
        
         {"text": "  Indented by 2\n  Keeps trailing newlines\n\n\n\n"}

     

       245
       183
        
       

     

       246
       184
        
       ================================================================================

     
···

       395
       333
        
       

     

       396
       334
        
       Empty block scalars

     

       397
       335
        
       

     

       398
       398
       -
         $ echo 'empty_literal: |' | yamlcat --json

     

       336
       336
       +
         $ yamlcat --json scalar_empty_literal.yml

     

       399
       337
        
         {"empty_literal": ""}

     

       400
       338
        
       

     

       401
       401
       -
         $ echo 'empty_folded: >' | yamlcat --json

     

       339
       339
       +
         $ yamlcat --json scalar_empty_folded.yml

     

       402
       340
        
         {"empty_folded": ""}

     

       403
       341
        
       

     

       404
       342
        
       Block scalars with special characters (no escaping needed)

     

       405
       343
        
       

     

       406
       406
       -
         $ echo 'code: |

     

       407
       407
       -
         >   Special: @#$%^&*()

     

       408
       408
       -
         >   Quotes: "double" '"'"'single'"'"'

     

       409
       409
       -
         >   Brackets: [array] {object}' | yamlcat --json

     

       410
       410
       -
         {"code": "Special: @#$%^&*()\nQuotes: \"double\" 'single'\nBrackets: [array] {object}\n"}

     

       344
       344
       +
         $ yamlcat --json scalar_special_chars.yml

     

       345
       345
       +
         {"code": "Special: @#$%^&*()\nSymbols: <>?/\\|\nBrackets: []{}\n"}

     

       411
       346
        
       

     

       412
       347
        
       Plain scalar vs quoted string for special values

     

       413
       348
        
       

     

       414
       414
       -
         $ echo 'unquoted_true: true

     

       415
       415
       -
         > quoted_true: "true"' | yamlcat --json

     

       349
       349
       +
         $ yamlcat --json scalar_bool_vs_string.yml

     

       416
       350
        
         {"unquoted_true": true, "quoted_true": "true"}

     

       417
       351
        
       

     

       418
       418
       -
         $ echo 'unquoted_null: null

     

       419
       419
       -
         > quoted_null: "null"' | yamlcat --json

     

       352
       352
       +
         $ yamlcat --json scalar_null_vs_string.yml

     

       420
       353
        
         {"unquoted_null": null, "quoted_null": "null"}

     

       421
       354
        
       

     

       422
       355
        
       Strings that need quoting to preserve leading/trailing spaces

     

       423
       356
        
       

     

       424
       424
       -
         $ echo 'leading: "  spaces"

     

       425
       425
       -
         > trailing: "spaces  "

     

       426
       426
       -
         > both: "  spaces  "' | yamlcat --json

     

       427
       427
       -
         {"leading": "  spaces", "trailing": "spaces  ", "both": "  spaces  "}

     

       357
       357
       +
         $ yamlcat --json scalar_whitespace.yml

     

       358
       358
       +
         {"leading": "  spaces", "trailing": "spaces  ", "both": "  both  "}

     

       428
       359
        
       

     

       429
       360
        
       Block scalars in sequences

     

       430
       361
        
       

     

       431
       431
       -
         $ echo 'items:

     

       432
       432
       -
         >   - |

     

       433
       433
       -
         >     First item

     

       434
       434
       -
         >     multiline

     

       435
       435
       -
         >   - >

     

       436
       436
       -
         >     Second item

     

       437
       437
       -
         >     folded' | yamlcat --json

     

       362
       362
       +
         $ yamlcat --json scalar_seq_blocks.yml

     

       438
       363
        
         {"items": ["First item\nmultiline\n", "Second item folded\n"]}

     

       439
       364
        
       

     

       440
       365
        
       Block scalars in nested mappings

     

       441
       366
        
       

     

       442
       442
       -
         $ echo 'outer:

     

       443
       443
       -
         >   inner:

     

       444
       444
       -
         >     description: >

     

       445
       445
       -
         >       This is a folded

     

       446
       446
       -
         >       description.

     

       447
       447
       -
         >     code: |

     

       448
       448
       -
         >       def test():

     

       449
       449
       -
         >           return True' | yamlcat --json

     

       367
       367
       +
         $ yamlcat --json scalar_nested_blocks.yml

     

       450
       368
        
         {"outer": {"inner": {"description": "This is a folded description.\n", "code": "def test():\n    return True\n"}}}

     

       451
       369
        
       

     

       452
       370
        
       Preserving indentation in literal blocks

     

       453
       371
        
       

     

       454
       454
       -
         $ echo 'code: |

     

       455
       455
       -
         >   def hello():

     

       456
       456
       -
         >       print("Hello")

     

       457
       457
       -
         >       if True:

     

       458
       458
       -
         >           return 42' | yamlcat --json

     

       372
       372
       +
         $ yamlcat --json scalar_code_sample.yml

     

       459
       373
        
         {"code": "def hello():\n    print(\"Hello\")\n    if True:\n        return 42\n"}

     

       460
       374
        
       

     

       461
       375
        
       Folded scalars preserve more-indented lines

     

       462
       376
        
       

     

       463
       463
       -
         $ echo 'text: >

     

       464
       464
       -
         >   Normal paragraph

     

       465
       465
       -
         >   continues here.

     

       466
       466
       -
         > 

     

       467
       467
       -
         >     Indented block

     

       468
       468
       -
         >     preserved.

     

       469
       469
       -
         > 

     

       470
       470
       -
         >   Back to normal.' | yamlcat --json

     

       377
       377
       +
         $ yamlcat --json scalar_folded_indent_preserve.yml

     

       471
       378
        
         {"text": "Normal paragraph continues here.\n\n  Indented block\n  preserved.\n\nBack to normal.\n"}

tests/cram/simple_hello.yml

···

       1
       1
       +
       hello: world

tests/cram/special_values.yml

···

       1
       1
       +
       null_val: null

     

       2
       2
       +
       bool_true: true

     

       3
       3
       +
       bool_false: false

     

       4
       4
       +
       number: 42

     

       5
       5
       +
       float: 3.14

tests/cram/start_with_comment.yml

···

       1
       1
       +
       ---  # Document start

     

       2
       2
       +
       data: content

     

       3
       3
       +
       # Mid-document comment

     

       4
       4
       +
       more: values

tests/cram/tab_columns.yml

···

       1
       1
       +
       text: "Col1\tCol2\tCol3"

tests/cram/uppercase_U_unicode.yml

···

       1
       1
       +
       unicode: "\U00000041"

tests/cram/windows_path.yml

···

       1
       1
       +
       path: "C:\\Users\\Name"

tests/cram/yaml12_version.yml

···

       1
       1
       +
       %YAML 1.2

     

       2
       2
       +
       ---

     

       3
       3
       +
       version: 1.2

     

       4
       4
       +
       enabled: true

+11 -33

tests/cram/yamlcat.t

···

       1
       1
        
       Test yamlcat with simple YAML

     

       2
       2
        
       

     

       3
       3
       -
         $ echo 'hello: world' | yamlcat

     

       3
       3
       +
         $ yamlcat simple_hello.yml

     

       4
       4
        
         hello: world

     

       5
       5
        
       

     

       6
       6
       -
         $ echo 'name: Alice

     

       7
       7
       -
         > age: 30' | yamlcat

     

       6
       6
       +
         $ yamlcat person.yml

     

       8
       7
        
         name: Alice

     

       9
       8
        
         age: 30

     

       10
       9
        
       

     

       11
       10
        
       Test nested mappings

     

       12
       11
        
       

     

       13
       13
       -
         $ echo 'server:

     

       14
       14
       -
         >   host: localhost

     

       15
       15
       -
         >   port: 8080

     

       16
       16
       -
         > database:

     

       17
       17
       -
         >   name: mydb' | yamlcat

     

       12
       12
       +
         $ yamlcat nested_mappings.yml

     

       18
       13
        
         server:

     

       19
       14
        
           host: localhost

     

       20
       15
        
           port: 8080

     
···

       23
       18
        
       

     

       24
       19
        
       Test sequences

     

       25
       20
        
       

     

       26
       26
       -
         $ echo '- apple

     

       27
       27
       -
         > - banana

     

       28
       28
       -
         > - cherry' | yamlcat

     

       21
       21
       +
         $ yamlcat fruits_list.yml

     

       29
       22
        
         - apple

     

       30
       23
        
         - banana

     

       31
       24
        
         - cherry

     

       32
       25
        
       

     

       33
       26
        
       Test mapping with sequence value

     

       34
       27
        
       

     

       35
       35
       -
         $ echo 'fruits:

     

       36
       36
       -
         >   - apple

     

       37
       37
       -
         >   - banana' | yamlcat

     

       28
       28
       +
         $ yamlcat fruits_mapping.yml

     

       38
       29
        
         fruits:

     

       39
       30
        
           - apple

     

       40
       31
        
           - banana

     

       41
       32
        
       

     

       42
       33
        
       Test flow style output

     

       43
       34
        
       

     

       44
       44
       -
         $ echo 'name: Alice

     

       45
       45
       -
         > hobbies:

     

       46
       46
       -
         >   - reading

     

       47
       47
       -
         >   - coding' | yamlcat --flow

     

       35
       35
       +
         $ yamlcat --flow hobbies.yml

     

       48
       36
        
         {name: Alice, hobbies: [reading, coding]}

     

       49
       37
        
       

     

       50
       38
        
       Test JSON output

     

       51
       39
        
       

     

       52
       52
       -
         $ echo 'name: Alice

     

       53
       53
       -
         > age: 30' | yamlcat --json

     

       40
       40
       +
         $ yamlcat --json person.yml

     

       54
       41
        
         {"name": "Alice", "age": 30}

     

       55
       42
        
       

     

       56
       43
        
       Test seq.yml file (multiline plain scalar)

     
···

       98
       85
        
       

     

       99
       86
        
       Test special values

     

       100
       87
        
       

     

       101
       101
       -
         $ echo 'null_val: null

     

       102
       102
       -
         > bool_true: true

     

       103
       103
       -
         > bool_false: false

     

       104
       104
       -
         > number: 42

     

       105
       105
       -
         > float: 3.14' | yamlcat --json

     

       88
       88
       +
         $ yamlcat --json special_values.yml

     

       106
       89
        
         {"null_val": null, "bool_true": true, "bool_false": false, "number": 42, "float": 3.14}

     

       107
       90
        
       

     

       108
       91
        
       Test quoted strings

     

       109
       92
        
       

     

       110
       110
       -
         $ echo 'single: '"'"'hello world'"'"'

     

       111
       111
       -
         > double: "hello world"' | yamlcat

     

       93
       93
       +
         $ yamlcat quoted_strings.yml

     

       112
       94
        
         single: hello world

     

       113
       95
        
         double: hello world

     

       114
       96
        
       

     

       115
       97
        
       Test literal block scalar

     

       116
       98
        
       

     

       117
       117
       -
         $ echo 'text: |

     

       118
       118
       -
         >   line one

     

       119
       119
       -
         >   line two' | yamlcat --json

     

       99
       99
       +
         $ yamlcat --json literal_block.yml

     

       120
       100
        
         {"text": "line one\nline two\n"}

     

       121
       101
        
       

     

       122
       102
        
       Test folded block scalar

     

       123
       103
        
       

     

       124
       124
       -
         $ echo 'text: >

     

       125
       125
       -
         >   line one

     

       126
       126
       -
         >   line two' | yamlcat --json

     

       104
       104
       +
         $ yamlcat --json folded_block.yml

     

       127
       105
        
         {"text": "line one line two\n"}

     

       128
       106
        
       

     

       129
       107
        
       Test linuxkit.yml (sequences of mappings)

+40

tests/dune

···

       1
       1
       +
       ; Test executables for the full YAML test suite

     

       2
       2
       +
       

     

       3
       3
       +
       (executable

     

       4
       4
       +
        (name run_all_tests)

     

       5
       5
       +
        (modules run_all_tests test_yamlrw)

     

       6
       6
       +
        (libraries yamlrw test_suite_lib alcotest))

     

       7
       7
       +
       

     

       8
       8
       +
       (executable

     

       9
       9
       +
        (name run_all_tests_eio)

     

       10
       10
       +
        (modules run_all_tests_eio)

     

       11
       11
       +
        (libraries yamlrw test_suite_lib_eio eio_main))

     

       12
       12
       +
       

     

       13
       13
       +
       ; Alias to run the full YAML test suite and generate HTML report

     

       14
       14
       +
       ; Requires yaml-test-suite to be cloned to tests/yaml-test-suite

     

       15
       15
       +
       

     

       16
       16
       +
       (rule

     

       17
       17
       +
        (alias yaml-test-suite)

     

       18
       18
       +
        (deps

     

       19
       19
       +
         (source_tree yaml-test-suite))

     

       20
       20
       +
        (targets yaml-test-results.html)

     

       21
       21
       +
        (action

     

       22
       22
       +
         (run

     

       23
       23
       +
          %{exe:run_all_tests.exe}

     

       24
       24
       +
          --test-suite-path

     

       25
       25
       +
          %{workspace_root}/tests/yaml-test-suite

     

       26
       26
       +
          --html

     

       27
       27
       +
          yaml-test-results.html)))

     

       28
       28
       +
       

     

       29
       29
       +
       (rule

     

       30
       30
       +
        (alias yaml-test-suite-eio)

     

       31
       31
       +
        (deps

     

       32
       32
       +
         (source_tree yaml-test-suite))

     

       33
       33
       +
        (targets yaml-test-results-eio.html)

     

       34
       34
       +
        (action

     

       35
       35
       +
         (run

     

       36
       36
       +
          %{exe:run_all_tests_eio.exe}

     

       37
       37
       +
          --test-suite-path

     

       38
       38
       +
          %{workspace_root}/tests/yaml-test-suite

     

       39
       39
       +
          --html

     

       40
       40
       +
          yaml-test-results-eio.html)))

+216 -144

tests/run_all_tests.ml

···

       9
       9
        
       module JF = Test_suite_lib.Json_format

     

       10
       10
        
       module JC = Test_suite_lib.Json_compare

     

       11
       11
        
       

     

       12
       12
       -
       let test_suite_path = "../yaml-test-suite"

     

       12
       12
       +
       let test_suite_path = "yaml-test-suite"

     

       13
       13
        
       

     

       14
       14
        
       (* HTML escape function *)

     

       15
       15
        
       let html_escape s =

     

       16
       16
        
         let buf = Buffer.create (String.length s) in

     

       17
       17
       -
         String.iter (function

     

       18
       18
       -
           | '<' -> Buffer.add_string buf "&lt;"

     

       19
       19
       -
           | '>' -> Buffer.add_string buf "&gt;"

     

       20
       20
       -
           | '&' -> Buffer.add_string buf "&amp;"

     

       21
       21
       -
           | '"' -> Buffer.add_string buf "&quot;"

     

       22
       22
       -
           | c -> Buffer.add_char buf c

     

       23
       23
       -
         ) s;

     

       17
       17
       +
         String.iter

     

       18
       18
       +
           (function

     

       19
       19
       +
             | '<' -> Buffer.add_string buf "&lt;"

     

       20
       20
       +
             | '>' -> Buffer.add_string buf "&gt;"

     

       21
       21
       +
             | '&' -> Buffer.add_string buf "&amp;"

     

       22
       22
       +
             | '"' -> Buffer.add_string buf "&quot;"

     

       23
       23
       +
             | c -> Buffer.add_char buf c)

     

       24
       24
       +
           s;

     

       24
       25
        
         Buffer.contents buf

     

       25
       26
        
       

     

       26
       27
        
       let normalize_tree s =

     
···

       33
       34
        
         name : string;

     

       34
       35
        
         yaml : string;

     

       35
       36
        
         is_error_test : bool;

     

       36
       36
       -
         status : [`Pass | `Fail of string | `Skip];

     

       37
       37
       +
         status : [ `Pass | `Fail of string | `Skip ];

     

       37
       38
        
         output : string;

     

       38
       38
       -
         json_status : [`Pass | `Fail of string | `Skip];

     

       39
       39
       +
         json_status : [ `Pass | `Fail of string | `Skip ];

     

       39
       40
        
         json_expected : string;

     

       40
       41
        
         json_actual : string;

     

       41
       42
        
       }

     
···

       45
       46
        
            This handles formatting differences and object key ordering. *)

     

       46
       47
        
         JC.compare_json_strings expected actual

     

       47
       48
        
       

     

       48
       48
       -
       let run_json_test (test : TL.test_case) : [`Pass | `Fail of string | `Skip] * string =

     

       49
       49
       +
       let run_json_test (test : TL.test_case) :

     

       50
       50
       +
           [ `Pass | `Fail of string | `Skip ] * string =

     

       49
       51
        
         match test.json with

     

       50
       52
        
         | None -> (`Skip, "")

     

       51
       51
       -
         | Some expected_json ->

     

       53
       53
       +
         | Some expected_json -> (

     

       52
       54
        
             if test.fail then

     

       53
       55
        
               (* Error tests shouldn't have JSON comparison *)

     

       54
       56
        
               (`Skip, "")

     
···

       56
       58
        
               try

     

       57
       59
        
                 (* Handle multi-document YAML by using documents_of_string *)

     

       58
       60
        
                 let docs = Loader.documents_of_string test.yaml in

     

       59
       59
       -
                 let values = List.filter_map (fun doc ->

     

       60
       60
       -
                   match Document.root doc with

     

       61
       61
       -
                   | None -> None

     

       62
       62
       -
                   | Some yaml -> Some (Yaml.to_value ~resolve_aliases_first:true yaml)

     

       63
       63
       -
                 ) docs in

     

       64
       64
       -
                 let actual_json = match values with

     

       65
       65
       -
                   | [] -> ""  (* Empty document produces empty JSON *)

     

       66
       66
       -
                   | [v] -> JF.to_json v

     

       61
       61
       +
                 let values =

     

       62
       62
       +
                   List.filter_map

     

       63
       63
       +
                     (fun doc ->

     

       64
       64
       +
                       match Document.root doc with

     

       65
       65
       +
                       | None -> None

     

       66
       66
       +
                       | Some yaml ->

     

       67
       67
       +
                           Some (Yaml.to_value ~resolve_aliases_first:true yaml))

     

       68
       68
       +
                     docs

     

       69
       69
       +
                 in

     

       70
       70
       +
                 let actual_json =

     

       71
       71
       +
                   match values with

     

       72
       72
       +
                   | [] -> "" (* Empty document produces empty JSON *)

     

       73
       73
       +
                   | [ v ] -> JF.to_json v

     

       67
       74
        
                   | vs -> JF.documents_to_json vs

     

       68
       75
        
                 in

     

       69
       69
       -
                 if compare_json expected_json actual_json then

     

       70
       70
       -
                   (`Pass, actual_json)

     

       71
       71
       -
                 else

     

       72
       72
       -
                   (`Fail "JSON mismatch", actual_json)

     

       76
       76
       +
                 if compare_json expected_json actual_json then (`Pass, actual_json)

     

       77
       77
       +
                 else (`Fail "JSON mismatch", actual_json)

     

       73
       78
        
               with

     

       74
       79
        
               | Yamlrw_error e ->

     

       75
       80
        
                   (`Fail (Format.asprintf "Parse error: %a" Error.pp e), "")

     

       76
       81
        
               | exn ->

     

       77
       82
        
                   (`Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn)), "")

     

       83
       83
       +
             )

     

       78
       84
        
       

     

       79
       85
        
       let run_test (test : TL.test_case) : test_result =

     

       80
       86
        
         let json_status, json_actual = run_json_test test in

     

       81
       81
       -
         let base = {

     

       82
       82
       -
           id = test.id;

     

       83
       83
       -
           name = test.name;

     

       84
       84
       -
           yaml = test.yaml;

     

       85
       85
       -
           is_error_test = test.fail;

     

       86
       86
       -
           status = `Skip;

     

       87
       87
       -
           output = "";

     

       88
       88
       -
           json_status;

     

       89
       89
       -
           json_expected = Option.value ~default:"" test.json;

     

       90
       90
       -
           json_actual;

     

       91
       91
       -
         } in

     

       87
       87
       +
         let base =

     

       88
       88
       +
           {

     

       89
       89
       +
             id = test.id;

     

       90
       90
       +
             name = test.name;

     

       91
       91
       +
             yaml = test.yaml;

     

       92
       92
       +
             is_error_test = test.fail;

     

       93
       93
       +
             status = `Skip;

     

       94
       94
       +
             output = "";

     

       95
       95
       +
             json_status;

     

       96
       96
       +
             json_expected = Option.value ~default:"" test.json;

     

       97
       97
       +
             json_actual;

     

       98
       98
       +
           }

     

       99
       99
       +
         in

     

       92
       100
        
         if test.fail then begin

     

       93
       101
        
           try

     

       94
       102
        
             let parser = Parser.of_string test.yaml in

     

       95
       103
        
             let events = Parser.to_list parser in

     

       96
       104
        
             let tree = TF.of_spanned_events events in

     

       97
       97
       -
             { base with

     

       98
       98
       -
               status = `Fail "Expected parsing to fail";

     

       99
       99
       -
               output = tree;

     

       100
       100
       -
             }

     

       105
       105
       +
             { base with status = `Fail "Expected parsing to fail"; output = tree }

     

       101
       106
        
           with

     

       102
       107
        
           | Yamlrw_error e ->

     

       103
       103
       -
               { base with

     

       104
       104
       -
                 status = `Pass;

     

       105
       105
       -
                 output = Format.asprintf "%a" Error.pp e;

     

       106
       106
       -
               }

     

       107
       107
       -
           | exn ->

     

       108
       108
       -
               { base with

     

       109
       109
       -
                 status = `Pass;

     

       110
       110
       -
                 output = Printexc.to_string exn;

     

       111
       111
       -
               }

     

       108
       108
       +
               { base with status = `Pass; output = Format.asprintf "%a" Error.pp e }

     

       109
       109
       +
           | exn -> { base with status = `Pass; output = Printexc.to_string exn }

     

       112
       110
        
         end

     

       113
       111
        
         else begin

     

       114
       112
        
           match test.tree with

     

       115
       115
       -
           | None ->

     

       113
       113
       +
           | None -> (

     

       116
       114
        
               (* No expected tree - check if json indicates expected success *)

     

       117
       117
       -
               (match test.json with

     

       118
       118
       -
                | Some _ ->

     

       119
       119
       -
                    (* Has json output, so should parse successfully *)

     

       120
       120
       -
                    (try

     

       121
       121
       -
                      let parser = Parser.of_string test.yaml in

     

       122
       122
       -
                      let events = Parser.to_list parser in

     

       123
       123
       -
                      let tree = TF.of_spanned_events events in

     

       124
       124
       -
                      { base with status = `Pass; output = tree }

     

       125
       125
       -
                    with exn ->

     

       126
       126
       -
                      { base with

     

       127
       127
       -
                        status = `Fail (Printf.sprintf "Should parse but got: %s" (Printexc.to_string exn));

     

       128
       128
       -
                        output = Printexc.to_string exn;

     

       129
       129
       -
                      })

     

       130
       130
       -
                | None ->

     

       131
       131
       -
                    (* No tree, no json, no fail - ambiguous edge case, skip *)

     

       132
       132
       -
                    { base with status = `Skip; output = "(no expected tree or json)" })

     

       133
       133
       -
           | Some expected ->

     

       115
       115
       +
               match test.json with

     

       116
       116
       +
               | Some _ -> (

     

       117
       117
       +
                   (* Has json output, so should parse successfully *)

     

       118
       118
       +
                   try

     

       119
       119
       +
                     let parser = Parser.of_string test.yaml in

     

       120
       120
       +
                     let events = Parser.to_list parser in

     

       121
       121
       +
                     let tree = TF.of_spanned_events events in

     

       122
       122
       +
                     { base with status = `Pass; output = tree }

     

       123
       123
       +
                   with exn ->

     

       124
       124
       +
                     {

     

       125
       125
       +
                       base with

     

       126
       126
       +
                       status =

     

       127
       127
       +
                         `Fail

     

       128
       128
       +
                           (Printf.sprintf "Should parse but got: %s"

     

       129
       129
       +
                              (Printexc.to_string exn));

     

       130
       130
       +
                       output = Printexc.to_string exn;

     

       131
       131
       +
                     })

     

       132
       132
       +
               | None ->

     

       133
       133
       +
                   (* No tree, no json, no fail - ambiguous edge case, skip *)

     

       134
       134
       +
                   { base with status = `Skip; output = "(no expected tree or json)" })

     

       135
       135
       +
           | Some expected -> (

     

       134
       136
        
               try

     

       135
       137
        
                 let parser = Parser.of_string test.yaml in

     

       136
       138
        
                 let events = Parser.to_list parser in

     
···

       140
       142
        
                 if expected_norm = actual_norm then

     

       141
       143
        
                   { base with status = `Pass; output = actual }

     

       142
       144
        
                 else

     

       143
       143
       -
                   { base with

     

       145
       145
       +
                   {

     

       146
       146
       +
                     base with

     

       144
       147
        
                     status = `Fail (Printf.sprintf "Tree mismatch");

     

       145
       145
       -
                     output = Printf.sprintf "Expected:\n%s\n\nActual:\n%s" expected_norm actual_norm;

     

       148
       148
       +
                     output =

     

       149
       149
       +
                       Printf.sprintf "Expected:\n%s\n\nActual:\n%s" expected_norm

     

       150
       150
       +
                         actual_norm;

     

       146
       151
        
                   }

     

       147
       152
        
               with exn ->

     

       148
       148
       -
                 { base with

     

       149
       149
       -
                   status = `Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn));

     

       153
       153
       +
                 {

     

       154
       154
       +
                   base with

     

       155
       155
       +
                   status =

     

       156
       156
       +
                     `Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn));

     

       150
       157
        
                   output = Printexc.to_string exn;

     

       151
       151
       -
                 }

     

       158
       158
       +
                 })

     

       152
       159
        
         end

     

       153
       160
        
       

     

       154
       161
        
       let status_class = function

     
···

       163
       170
        
       

     

       164
       171
        
       let generate_html results output_file =

     

       165
       172
        
         let oc = open_out output_file in

     

       166
       166
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       167
       167
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

       168
       168
       -
         let skip_count = List.length (List.filter (fun r -> r.status = `Skip) results) in

     

       173
       173
       +
         let pass_count =

     

       174
       174
       +
           List.length (List.filter (fun r -> r.status = `Pass) results)

     

       175
       175
       +
         in

     

       176
       176
       +
         let fail_count =

     

       177
       177
       +
           List.length

     

       178
       178
       +
             (List.filter

     

       179
       179
       +
                (fun r -> match r.status with `Fail _ -> true | _ -> false)

     

       180
       180
       +
                results)

     

       181
       181
       +
         in

     

       182
       182
       +
         let skip_count =

     

       183
       183
       +
           List.length (List.filter (fun r -> r.status = `Skip) results)

     

       184
       184
       +
         in

     

       169
       185
        
         let total = List.length results in

     

       170
       170
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       171
       171
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

       172
       172
       -
         let json_skip_count = List.length (List.filter (fun r -> r.json_status = `Skip) results) in

     

       186
       186
       +
         let json_pass_count =

     

       187
       187
       +
           List.length (List.filter (fun r -> r.json_status = `Pass) results)

     

       188
       188
       +
         in

     

       189
       189
       +
         let json_fail_count =

     

       190
       190
       +
           List.length

     

       191
       191
       +
             (List.filter

     

       192
       192
       +
                (fun r -> match r.json_status with `Fail _ -> true | _ -> false)

     

       193
       193
       +
                results)

     

       194
       194
       +
         in

     

       195
       195
       +
         let json_skip_count =

     

       196
       196
       +
           List.length (List.filter (fun r -> r.json_status = `Skip) results)

     

       197
       197
       +
         in

     

       173
       198
        
       

     

       174
       174
       -
         Printf.fprintf oc {|<!DOCTYPE html>

     

       199
       199
       +
         Printf.fprintf oc

     

       200
       200
       +
           {|<!DOCTYPE html>

     

       175
       201
        
       <html lang="en">

     

       176
       202
        
       <head>

     

       177
       203
        
         <meta charset="UTF-8">

     
···

       335
       361
        
             <input type="text" class="search" placeholder="Search by ID or name...">

     

       336
       362
        
           </div>

     

       337
       363
        
           <div class="tests">

     

       338
       338
       -
       |} pass_count fail_count skip_count total json_pass_count json_fail_count json_skip_count;

     

       364
       364
       +
       |}

     

       365
       365
       +
           pass_count fail_count skip_count total json_pass_count json_fail_count

     

       366
       366
       +
           json_skip_count;

     

       339
       367
        
       

     

       340
       340
       -
         List.iter (fun result ->

     

       341
       341
       -
           let error_badge = if result.is_error_test then

     

       342
       342
       -
             {|<span class="badge error-test">Error Test</span>|}

     

       343
       343
       -
           else "" in

     

       344
       344
       -
           let json_badge = Printf.sprintf {|<span class="badge %s" style="margin-left: 4px;">JSON: %s</span>|}

     

       345
       345
       -
             (status_class result.json_status) (status_text result.json_status) in

     

       346
       346
       -
           let json_section = if result.json_expected <> "" || result.json_actual <> "" then

     

       347
       347
       -
             Printf.sprintf {|

     

       368
       368
       +
         List.iter

     

       369
       369
       +
           (fun result ->

     

       370
       370
       +
             let error_badge =

     

       371
       371
       +
               if result.is_error_test then

     

       372
       372
       +
                 {|<span class="badge error-test">Error Test</span>|}

     

       373
       373
       +
               else ""

     

       374
       374
       +
             in

     

       375
       375
       +
             let json_badge =

     

       376
       376
       +
               Printf.sprintf

     

       377
       377
       +
                 {|<span class="badge %s" style="margin-left: 4px;">JSON: %s</span>|}

     

       378
       378
       +
                 (status_class result.json_status)

     

       379
       379
       +
                 (status_text result.json_status)

     

       380
       380
       +
             in

     

       381
       381
       +
             let json_section =

     

       382
       382
       +
               if result.json_expected <> "" || result.json_actual <> "" then

     

       383
       383
       +
                 Printf.sprintf

     

       384
       384
       +
                   {|

     

       348
       385
        
                 <div class="section">

     

       349
       386
        
                   <div class="section-title">Expected JSON</div>

     

       350
       387
        
                   <pre>%s</pre>

     
···

       353
       390
        
                   <div class="section-title">Actual JSON</div>

     

       354
       391
        
                   <pre>%s</pre>

     

       355
       392
        
                 </div>|}

     

       356
       356
       -
               (html_escape result.json_expected)

     

       357
       357
       -
               (html_escape result.json_actual)

     

       358
       358
       -
           else "" in

     

       359
       359
       -
           Printf.fprintf oc {|      <div class="test" data-status="%s" data-json-status="%s" data-id="%s" data-name="%s">

     

       393
       393
       +
                   (html_escape result.json_expected)

     

       394
       394
       +
                   (html_escape result.json_actual)

     

       395
       395
       +
               else ""

     

       396
       396
       +
             in

     

       397
       397
       +
             Printf.fprintf oc

     

       398
       398
       +
               {|      <div class="test" data-status="%s" data-json-status="%s" data-id="%s" data-name="%s">

     

       360
       399
        
               <div class="test-header" onclick="this.parentElement.classList.toggle('expanded')">

     

       361
       400
        
                 <span class="expand-icon">▶</span>

     

       362
       401
        
                 <span class="badge %s">%s</span>

     
···

       377
       416
        
               </div>

     

       378
       417
        
             </div>

     

       379
       418
        
       |}

     

       380
       380
       -
             (status_class result.status)

     

       381
       381
       -
             (status_class result.json_status)

     

       382
       382
       -
             (html_escape result.id)

     

       383
       383
       -
             (html_escape (String.lowercase_ascii result.name))

     

       384
       384
       -
             (status_class result.status)

     

       385
       385
       -
             (status_text result.status)

     

       386
       386
       -
             json_badge

     

       387
       387
       -
             (html_escape result.id)

     

       388
       388
       -
             (html_escape result.name)

     

       389
       389
       -
             error_badge

     

       390
       390
       -
             (html_escape result.yaml)

     

       391
       391
       -
             (html_escape result.output)

     

       392
       392
       -
             json_section

     

       393
       393
       -
         ) results;

     

       419
       419
       +
               (status_class result.status)

     

       420
       420
       +
               (status_class result.json_status)

     

       421
       421
       +
               (html_escape result.id)

     

       422
       422
       +
               (html_escape (String.lowercase_ascii result.name))

     

       423
       423
       +
               (status_class result.status)

     

       424
       424
       +
               (status_text result.status)

     

       425
       425
       +
               json_badge (html_escape result.id) (html_escape result.name) error_badge

     

       426
       426
       +
               (html_escape result.yaml)

     

       427
       427
       +
               (html_escape result.output)

     

       428
       428
       +
               json_section)

     

       429
       429
       +
           results;

     

       394
       430
        
       

     

       395
       395
       -
         Printf.fprintf oc {|    </div>

     

       431
       431
       +
         Printf.fprintf oc

     

       432
       432
       +
           {|    </div>

     

       396
       433
        
         </div>

     

       397
       434
        
         <script>

     

       398
       435
        
           document.querySelectorAll('.filter-btn').forEach(btn => {

     
···

       424
       461
        
       let () =

     

       425
       462
        
         let html_output = ref None in

     

       426
       463
        
         let show_skipped = ref false in

     

       427
       427
       -
         let args = [

     

       428
       428
       -
           "--html", Arg.String (fun s -> html_output := Some s),

     

       429
       429
       -
           "<file> Generate HTML report to file";

     

       430
       430
       -
           "--show-skipped", Arg.Set show_skipped,

     

       431
       431
       -
           " Show details of skipped tests";

     

       432
       432
       -
         ] in

     

       433
       433
       -
         Arg.parse args (fun _ -> ()) "Usage: run_all_tests [--html <file>] [--show-skipped]";

     

       464
       464
       +
         let test_suite_path_ref = ref test_suite_path in

     

       465
       465
       +
         let args =

     

       466
       466
       +
           [

     

       467
       467
       +
             ( "--html",

     

       468
       468
       +
               Arg.String (fun s -> html_output := Some s),

     

       469
       469
       +
               "<file> Generate HTML report to file" );

     

       470
       470
       +
             ("--show-skipped", Arg.Set show_skipped, " Show details of skipped tests");

     

       471
       471
       +
             ( "--test-suite-path",

     

       472
       472
       +
               Arg.Set_string test_suite_path_ref,

     

       473
       473
       +
               "<path> Path to yaml-test-suite directory" );

     

       474
       474
       +
           ]

     

       475
       475
       +
         in

     

       476
       476
       +
         Arg.parse args

     

       477
       477
       +
           (fun _ -> ())

     

       478
       478
       +
           "Usage: run_all_tests [--html <file>] [--show-skipped] [--test-suite-path \

     

       479
       479
       +
            <path>]";

     

       434
       480
        
       

     

       435
       435
       -
         let all_tests = TL.load_directory test_suite_path in

     

       481
       481
       +
         let all_tests = TL.load_directory !test_suite_path_ref in

     

       436
       482
        
         Printf.printf "Total tests loaded: %d\n%!" (List.length all_tests);

     

       437
       483
        
       

     

       438
       484
        
         let results = List.map run_test all_tests in

     

       439
       485
        
       

     

       440
       440
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       441
       441
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

       442
       442
       -
         let skip_count = List.length (List.filter (fun r -> r.status = `Skip) results) in

     

       486
       486
       +
         let pass_count =

     

       487
       487
       +
           List.length (List.filter (fun r -> r.status = `Pass) results)

     

       488
       488
       +
         in

     

       489
       489
       +
         let fail_count =

     

       490
       490
       +
           List.length

     

       491
       491
       +
             (List.filter

     

       492
       492
       +
                (fun r -> match r.status with `Fail _ -> true | _ -> false)

     

       493
       493
       +
                results)

     

       494
       494
       +
         in

     

       495
       495
       +
         let skip_count =

     

       496
       496
       +
           List.length (List.filter (fun r -> r.status = `Skip) results)

     

       497
       497
       +
         in

     

       443
       498
        
       

     

       444
       444
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       445
       445
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

       446
       446
       -
         let json_skip_count = List.length (List.filter (fun r -> r.json_status = `Skip) results) in

     

       499
       499
       +
         let json_pass_count =

     

       500
       500
       +
           List.length (List.filter (fun r -> r.json_status = `Pass) results)

     

       501
       501
       +
         in

     

       502
       502
       +
         let json_fail_count =

     

       503
       503
       +
           List.length

     

       504
       504
       +
             (List.filter

     

       505
       505
       +
                (fun r -> match r.json_status with `Fail _ -> true | _ -> false)

     

       506
       506
       +
                results)

     

       507
       507
       +
         in

     

       508
       508
       +
         let json_skip_count =

     

       509
       509
       +
           List.length (List.filter (fun r -> r.json_status = `Skip) results)

     

       510
       510
       +
         in

     

       447
       511
        
       

     

       448
       448
       -
         Printf.printf "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!"

     

       449
       449
       -
           pass_count fail_count skip_count (pass_count + fail_count + skip_count);

     

       512
       512
       +
         Printf.printf

     

       513
       513
       +
           "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!" pass_count

     

       514
       514
       +
           fail_count skip_count

     

       515
       515
       +
           (pass_count + fail_count + skip_count);

     

       450
       516
        
       

     

       451
       451
       -
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!"

     

       452
       452
       -
           json_pass_count json_fail_count json_skip_count;

     

       517
       517
       +
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!" json_pass_count

     

       518
       518
       +
           json_fail_count json_skip_count;

     

       453
       519
        
       

     

       454
       520
        
         if fail_count > 0 then begin

     

       455
       521
        
           Printf.printf "\nFailing event tree tests:\n";

     

       456
       456
       -
           List.iter (fun r ->

     

       457
       457
       -
             match r.status with

     

       458
       458
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       459
       459
       -
             | _ -> ()

     

       460
       460
       -
           ) results

     

       522
       522
       +
           List.iter

     

       523
       523
       +
             (fun r ->

     

       524
       524
       +
               match r.status with

     

       525
       525
       +
               | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       526
       526
       +
               | _ -> ())

     

       527
       527
       +
             results

     

       461
       528
        
         end;

     

       462
       529
        
       

     

       463
       530
        
         if json_fail_count > 0 then begin

     

       464
       531
        
           Printf.printf "\nFailing JSON tests:\n";

     

       465
       465
       -
           List.iter (fun r ->

     

       466
       466
       -
             match r.json_status with

     

       467
       467
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       468
       468
       -
             | _ -> ()

     

       469
       469
       -
           ) results

     

       532
       532
       +
           List.iter

     

       533
       533
       +
             (fun r ->

     

       534
       534
       +
               match r.json_status with

     

       535
       535
       +
               | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       536
       536
       +
               | _ -> ())

     

       537
       537
       +
             results

     

       470
       538
        
         end;

     

       471
       539
        
       

     

       472
       540
        
         if !show_skipped && skip_count > 0 then begin

     

       473
       541
        
           Printf.printf "\nSkipped tests (no expected tree):\n";

     

       474
       474
       -
           List.iter (fun r ->

     

       475
       475
       -
             if r.status = `Skip then begin

     

       476
       476
       -
               Printf.printf "  %s: %s\n" r.id r.name;

     

       477
       477
       -
               Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       478
       478
       -
                 (if String.length r.yaml <= 60 then r.yaml

     

       479
       479
       -
                  else String.sub r.yaml 0 60 ^ "...")

     

       480
       480
       -
             end

     

       481
       481
       -
           ) results

     

       542
       542
       +
           List.iter

     

       543
       543
       +
             (fun r ->

     

       544
       544
       +
               if r.status = `Skip then begin

     

       545
       545
       +
                 Printf.printf "  %s: %s\n" r.id r.name;

     

       546
       546
       +
                 Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       547
       547
       +
                   (if String.length r.yaml <= 60 then r.yaml

     

       548
       548
       +
                    else String.sub r.yaml 0 60 ^ "...")

     

       549
       549
       +
               end)

     

       550
       550
       +
             results

     

       482
       551
        
         end;

     

       483
       552
        
       

     

       484
       484
       -
         match !html_output with

     

       553
       553
       +
         (match !html_output with

     

       485
       554
        
         | Some file ->

     

       486
       555
        
             generate_html results file;

     

       487
       556
        
             Printf.printf "\nHTML report generated: %s\n" file

     

       488
       488
       -
         | None -> ()

     

       557
       557
       +
         | None -> ());

     

       558
       558
       +
       

     

       559
       559
       +
         (* Exit with non-zero code if any tests failed *)

     

       560
       560
       +
         if fail_count > 0 || json_fail_count > 0 then exit 1

+230 -162

tests/run_all_tests_eio.ml

···

       11
       11
        
       module JF = Test_suite_lib.Json_format

     

       12
       12
        
       module JC = Test_suite_lib.Json_compare

     

       13
       13
        
       

     

       14
       14
       -
       let test_suite_path = "../yaml-test-suite"

     

       14
       14
       +
       let test_suite_path = "yaml-test-suite"

     

       15
       15
        
       

     

       16
       16
        
       (* HTML escape function *)

     

       17
       17
        
       let html_escape s =

     

       18
       18
        
         let buf = Buffer.create (String.length s) in

     

       19
       19
       -
         String.iter (function

     

       20
       20
       -
           | '<' -> Buffer.add_string buf "&lt;"

     

       21
       21
       -
           | '>' -> Buffer.add_string buf "&gt;"

     

       22
       22
       -
           | '&' -> Buffer.add_string buf "&amp;"

     

       23
       23
       -
           | '"' -> Buffer.add_string buf "&quot;"

     

       24
       24
       -
           | c -> Buffer.add_char buf c

     

       25
       25
       -
         ) s;

     

       19
       19
       +
         String.iter

     

       20
       20
       +
           (function

     

       21
       21
       +
             | '<' -> Buffer.add_string buf "&lt;"

     

       22
       22
       +
             | '>' -> Buffer.add_string buf "&gt;"

     

       23
       23
       +
             | '&' -> Buffer.add_string buf "&amp;"

     

       24
       24
       +
             | '"' -> Buffer.add_string buf "&quot;"

     

       25
       25
       +
             | c -> Buffer.add_char buf c)

     

       26
       26
       +
           s;

     

       26
       27
        
         Buffer.contents buf

     

       27
       28
        
       

     

       28
       29
        
       let normalize_tree s =

     
···

       35
       36
        
         name : string;

     

       36
       37
        
         yaml : string;

     

       37
       38
        
         is_error_test : bool;

     

       38
       38
       -
         status : [`Pass | `Fail of string | `Skip];

     

       39
       39
       +
         status : [ `Pass | `Fail of string | `Skip ];

     

       39
       40
        
         output : string;

     

       40
       40
       -
         json_status : [`Pass | `Fail of string | `Skip];

     

       41
       41
       +
         json_status : [ `Pass | `Fail of string | `Skip ];

     

       41
       42
        
         json_expected : string;

     

       42
       43
        
         json_actual : string;

     

       43
       44
        
       }

     

       44
       45
        
       

     

       45
       45
       -
       let compare_json expected actual =

     

       46
       46
       -
         JC.compare_json_strings expected actual

     

       46
       46
       +
       let compare_json expected actual = JC.compare_json_strings expected actual

     

       47
       47
        
       

     

       48
       48
       -
       let run_json_test (test : TL.test_case) : [`Pass | `Fail of string | `Skip] * string =

     

       48
       48
       +
       let run_json_test (test : TL.test_case) :

     

       49
       49
       +
           [ `Pass | `Fail of string | `Skip ] * string =

     

       49
       50
        
         match test.json with

     

       50
       51
        
         | None -> (`Skip, "")

     

       51
       51
       -
         | Some expected_json ->

     

       52
       52
       -
             if test.fail then

     

       53
       53
       -
               (`Skip, "")

     

       52
       52
       +
         | Some expected_json -> (

     

       53
       53
       +
             if test.fail then (`Skip, "")

     

       54
       54
        
             else

     

       55
       55
        
               try

     

       56
       56
        
                 let docs = Loader.documents_of_string test.yaml in

     

       57
       57
       -
                 let values = List.filter_map (fun doc ->

     

       58
       58
       -
                   match Document.root doc with

     

       59
       59
       -
                   | None -> None

     

       60
       60
       -
                   | Some yaml -> Some (Yaml.to_value ~resolve_aliases_first:true yaml)

     

       61
       61
       -
                 ) docs in

     

       62
       62
       -
                 let actual_json = match values with

     

       57
       57
       +
                 let values =

     

       58
       58
       +
                   List.filter_map

     

       59
       59
       +
                     (fun doc ->

     

       60
       60
       +
                       match Document.root doc with

     

       61
       61
       +
                       | None -> None

     

       62
       62
       +
                       | Some yaml ->

     

       63
       63
       +
                           Some (Yaml.to_value ~resolve_aliases_first:true yaml))

     

       64
       64
       +
                     docs

     

       65
       65
       +
                 in

     

       66
       66
       +
                 let actual_json =

     

       67
       67
       +
                   match values with

     

       63
       68
        
                   | [] -> ""

     

       64
       64
       -
                   | [v] -> JF.to_json v

     

       69
       69
       +
                   | [ v ] -> JF.to_json v

     

       65
       70
        
                   | vs -> JF.documents_to_json vs

     

       66
       71
        
                 in

     

       67
       67
       -
                 if compare_json expected_json actual_json then

     

       68
       68
       -
                   (`Pass, actual_json)

     

       69
       69
       -
                 else

     

       70
       70
       -
                   (`Fail "JSON mismatch", actual_json)

     

       72
       72
       +
                 if compare_json expected_json actual_json then (`Pass, actual_json)

     

       73
       73
       +
                 else (`Fail "JSON mismatch", actual_json)

     

       71
       74
        
               with

     

       72
       75
        
               | Yamlrw_error e ->

     

       73
       76
        
                   (`Fail (Format.asprintf "Parse error: %a" Error.pp e), "")

     

       74
       77
        
               | exn ->

     

       75
       78
        
                   (`Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn)), "")

     

       79
       79
       +
             )

     

       76
       80
        
       

     

       77
       81
        
       let run_test (test : TL.test_case) : test_result =

     

       78
       82
        
         let json_status, json_actual = run_json_test test in

     

       79
       79
       -
         let base = {

     

       80
       80
       -
           id = test.id;

     

       81
       81
       -
           name = test.name;

     

       82
       82
       -
           yaml = test.yaml;

     

       83
       83
       -
           is_error_test = test.fail;

     

       84
       84
       -
           status = `Skip;

     

       85
       85
       -
           output = "";

     

       86
       86
       -
           json_status;

     

       87
       87
       -
           json_expected = Option.value ~default:"" test.json;

     

       88
       88
       -
           json_actual;

     

       89
       89
       -
         } in

     

       83
       83
       +
         let base =

     

       84
       84
       +
           {

     

       85
       85
       +
             id = test.id;

     

       86
       86
       +
             name = test.name;

     

       87
       87
       +
             yaml = test.yaml;

     

       88
       88
       +
             is_error_test = test.fail;

     

       89
       89
       +
             status = `Skip;

     

       90
       90
       +
             output = "";

     

       91
       91
       +
             json_status;

     

       92
       92
       +
             json_expected = Option.value ~default:"" test.json;

     

       93
       93
       +
             json_actual;

     

       94
       94
       +
           }

     

       95
       95
       +
         in

     

       90
       96
        
         if test.fail then begin

     

       91
       97
        
           try

     

       92
       98
        
             let parser = Parser.of_string test.yaml in

     

       93
       99
        
             let events = Parser.to_list parser in

     

       94
       100
        
             let tree = TF.of_spanned_events events in

     

       95
       95
       -
             { base with

     

       96
       96
       -
               status = `Fail "Expected parsing to fail";

     

       97
       97
       -
               output = tree;

     

       98
       98
       -
             }

     

       101
       101
       +
             { base with status = `Fail "Expected parsing to fail"; output = tree }

     

       99
       102
        
           with

     

       100
       103
        
           | Yamlrw_error e ->

     

       101
       101
       -
               { base with

     

       102
       102
       -
                 status = `Pass;

     

       103
       103
       -
                 output = Format.asprintf "%a" Error.pp e;

     

       104
       104
       -
               }

     

       105
       105
       -
           | exn ->

     

       106
       106
       -
               { base with

     

       107
       107
       -
                 status = `Pass;

     

       108
       108
       -
                 output = Printexc.to_string exn;

     

       109
       109
       -
               }

     

       104
       104
       +
               { base with status = `Pass; output = Format.asprintf "%a" Error.pp e }

     

       105
       105
       +
           | exn -> { base with status = `Pass; output = Printexc.to_string exn }

     

       110
       106
        
         end

     

       111
       107
        
         else begin

     

       112
       108
        
           match test.tree with

     

       113
       113
       -
           | None ->

     

       114
       114
       -
               (match test.json with

     

       115
       115
       -
                | Some _ ->

     

       116
       116
       -
                    (try

     

       117
       117
       -
                      let parser = Parser.of_string test.yaml in

     

       118
       118
       -
                      let events = Parser.to_list parser in

     

       119
       119
       -
                      let tree = TF.of_spanned_events events in

     

       120
       120
       -
                      { base with status = `Pass; output = tree }

     

       121
       121
       -
                    with exn ->

     

       122
       122
       -
                      { base with

     

       123
       123
       -
                        status = `Fail (Printf.sprintf "Should parse but got: %s" (Printexc.to_string exn));

     

       124
       124
       -
                        output = Printexc.to_string exn;

     

       125
       125
       -
                      })

     

       126
       126
       -
                | None ->

     

       127
       127
       -
                    { base with status = `Skip; output = "(no expected tree or json)" })

     

       128
       128
       -
           | Some expected ->

     

       109
       109
       +
           | None -> (

     

       110
       110
       +
               match test.json with

     

       111
       111
       +
               | Some _ -> (

     

       112
       112
       +
                   try

     

       113
       113
       +
                     let parser = Parser.of_string test.yaml in

     

       114
       114
       +
                     let events = Parser.to_list parser in

     

       115
       115
       +
                     let tree = TF.of_spanned_events events in

     

       116
       116
       +
                     { base with status = `Pass; output = tree }

     

       117
       117
       +
                   with exn ->

     

       118
       118
       +
                     {

     

       119
       119
       +
                       base with

     

       120
       120
       +
                       status =

     

       121
       121
       +
                         `Fail

     

       122
       122
       +
                           (Printf.sprintf "Should parse but got: %s"

     

       123
       123
       +
                              (Printexc.to_string exn));

     

       124
       124
       +
                       output = Printexc.to_string exn;

     

       125
       125
       +
                     })

     

       126
       126
       +
               | None ->

     

       127
       127
       +
                   { base with status = `Skip; output = "(no expected tree or json)" })

     

       128
       128
       +
           | Some expected -> (

     

       129
       129
        
               try

     

       130
       130
        
                 let parser = Parser.of_string test.yaml in

     

       131
       131
        
                 let events = Parser.to_list parser in

     
···

       135
       135
        
                 if expected_norm = actual_norm then

     

       136
       136
        
                   { base with status = `Pass; output = actual }

     

       137
       137
        
                 else

     

       138
       138
       -
                   { base with

     

       138
       138
       +
                   {

     

       139
       139
       +
                     base with

     

       139
       140
        
                     status = `Fail (Printf.sprintf "Tree mismatch");

     

       140
       140
       -
                     output = Printf.sprintf "Expected:\n%s\n\nActual:\n%s" expected_norm actual_norm;

     

       141
       141
       +
                     output =

     

       142
       142
       +
                       Printf.sprintf "Expected:\n%s\n\nActual:\n%s" expected_norm

     

       143
       143
       +
                         actual_norm;

     

       141
       144
        
                   }

     

       142
       145
        
               with exn ->

     

       143
       143
       -
                 { base with

     

       144
       144
       -
                   status = `Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn));

     

       146
       146
       +
                 {

     

       147
       147
       +
                   base with

     

       148
       148
       +
                   status =

     

       149
       149
       +
                     `Fail (Printf.sprintf "Exception: %s" (Printexc.to_string exn));

     

       145
       150
        
                   output = Printexc.to_string exn;

     

       146
       146
       -
                 }

     

       151
       151
       +
                 })

     

       147
       152
        
         end

     

       148
       153
        
       

     

       149
       154
        
       (* Run tests in parallel using Eio fibers *)

     

       150
       150
       -
       let run_tests_parallel tests =

     

       151
       151
       -
         Eio.Fiber.List.map run_test tests

     

       155
       155
       +
       let run_tests_parallel tests = Eio.Fiber.List.map run_test tests

     

       152
       156
        
       

     

       153
       157
        
       let status_class = function

     

       154
       158
        
         | `Pass -> "pass"

     
···

       161
       165
        
         | `Skip -> "SKIP"

     

       162
       166
        
       

     

       163
       167
        
       let generate_html ~fs results output_file =

     

       164
       164
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       165
       165
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

       166
       166
       -
         let skip_count = List.length (List.filter (fun r -> r.status = `Skip) results) in

     

       168
       168
       +
         let pass_count =

     

       169
       169
       +
           List.length (List.filter (fun r -> r.status = `Pass) results)

     

       170
       170
       +
         in

     

       171
       171
       +
         let fail_count =

     

       172
       172
       +
           List.length

     

       173
       173
       +
             (List.filter

     

       174
       174
       +
                (fun r -> match r.status with `Fail _ -> true | _ -> false)

     

       175
       175
       +
                results)

     

       176
       176
       +
         in

     

       177
       177
       +
         let skip_count =

     

       178
       178
       +
           List.length (List.filter (fun r -> r.status = `Skip) results)

     

       179
       179
       +
         in

     

       167
       180
        
         let total = List.length results in

     

       168
       168
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       169
       169
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

       170
       170
       -
         let json_skip_count = List.length (List.filter (fun r -> r.json_status = `Skip) results) in

     

       181
       181
       +
         let json_pass_count =

     

       182
       182
       +
           List.length (List.filter (fun r -> r.json_status = `Pass) results)

     

       183
       183
       +
         in

     

       184
       184
       +
         let json_fail_count =

     

       185
       185
       +
           List.length

     

       186
       186
       +
             (List.filter

     

       187
       187
       +
                (fun r -> match r.json_status with `Fail _ -> true | _ -> false)

     

       188
       188
       +
                results)

     

       189
       189
       +
         in

     

       190
       190
       +
         let json_skip_count =

     

       191
       191
       +
           List.length (List.filter (fun r -> r.json_status = `Skip) results)

     

       192
       192
       +
         in

     

       171
       193
        
       

     

       172
       194
        
         let buf = Buffer.create 65536 in

     

       173
       173
       -
         Printf.bprintf buf {|<!DOCTYPE html>

     

       195
       195
       +
         Printf.bprintf buf

     

       196
       196
       +
           {|<!DOCTYPE html>

     

       174
       197
        
       <html lang="en">

     

       175
       198
        
       <head>

     

       176
       199
        
         <meta charset="UTF-8">

     
···

       344
       367
        
             <input type="text" class="search" placeholder="Search by ID or name...">

     

       345
       368
        
           </div>

     

       346
       369
        
           <div class="tests">

     

       347
       347
       -
       |} pass_count fail_count skip_count total json_pass_count json_fail_count json_skip_count;

     

       370
       370
       +
       |}

     

       371
       371
       +
           pass_count fail_count skip_count total json_pass_count json_fail_count

     

       372
       372
       +
           json_skip_count;

     

       348
       373
        
       

     

       349
       349
       -
         List.iter (fun result ->

     

       350
       350
       -
           let error_badge = if result.is_error_test then

     

       351
       351
       -
             {|<span class="badge error-test">Error Test</span>|}

     

       352
       352
       -
           else "" in

     

       353
       353
       -
           let json_badge = Printf.sprintf {|<span class="badge %s" style="margin-left: 4px;">JSON: %s</span>|}

     

       354
       354
       -
             (status_class result.json_status) (status_text result.json_status) in

     

       355
       355
       -
           let json_section = if result.json_expected <> "" || result.json_actual <> "" then

     

       356
       356
       -
             Printf.sprintf {|

     

       374
       374
       +
         List.iter

     

       375
       375
       +
           (fun result ->

     

       376
       376
       +
             let error_badge =

     

       377
       377
       +
               if result.is_error_test then

     

       378
       378
       +
                 {|<span class="badge error-test">Error Test</span>|}

     

       379
       379
       +
               else ""

     

       380
       380
       +
             in

     

       381
       381
       +
             let json_badge =

     

       382
       382
       +
               Printf.sprintf

     

       383
       383
       +
                 {|<span class="badge %s" style="margin-left: 4px;">JSON: %s</span>|}

     

       384
       384
       +
                 (status_class result.json_status)

     

       385
       385
       +
                 (status_text result.json_status)

     

       386
       386
       +
             in

     

       387
       387
       +
             let json_section =

     

       388
       388
       +
               if result.json_expected <> "" || result.json_actual <> "" then

     

       389
       389
       +
                 Printf.sprintf

     

       390
       390
       +
                   {|

     

       357
       391
        
                 <div class="section">

     

       358
       392
        
                   <div class="section-title">Expected JSON</div>

     

       359
       393
        
                   <pre>%s</pre>

     
···

       362
       396
        
                   <div class="section-title">Actual JSON</div>

     

       363
       397
        
                   <pre>%s</pre>

     

       364
       398
        
                 </div>|}

     

       365
       365
       -
               (html_escape result.json_expected)

     

       366
       366
       -
               (html_escape result.json_actual)

     

       367
       367
       -
           else "" in

     

       368
       368
       -
           Printf.bprintf buf {|      <div class="test" data-status="%s" data-json-status="%s" data-id="%s" data-name="%s">

     

       399
       399
       +
                   (html_escape result.json_expected)

     

       400
       400
       +
                   (html_escape result.json_actual)

     

       401
       401
       +
               else ""

     

       402
       402
       +
             in

     

       403
       403
       +
             Printf.bprintf buf

     

       404
       404
       +
               {|      <div class="test" data-status="%s" data-json-status="%s" data-id="%s" data-name="%s">

     

       369
       405
        
               <div class="test-header" onclick="this.parentElement.classList.toggle('expanded')">

     

       370
       406
        
                 <span class="expand-icon">▶</span>

     

       371
       407
        
                 <span class="badge %s">%s</span>

     
···

       386
       422
        
               </div>

     

       387
       423
        
             </div>

     

       388
       424
        
       |}

     

       389
       389
       -
             (status_class result.status)

     

       390
       390
       -
             (status_class result.json_status)

     

       391
       391
       -
             (html_escape result.id)

     

       392
       392
       -
             (html_escape (String.lowercase_ascii result.name))

     

       393
       393
       -
             (status_class result.status)

     

       394
       394
       -
             (status_text result.status)

     

       395
       395
       -
             json_badge

     

       396
       396
       -
             (html_escape result.id)

     

       397
       397
       -
             (html_escape result.name)

     

       398
       398
       -
             error_badge

     

       399
       399
       -
             (html_escape result.yaml)

     

       400
       400
       -
             (html_escape result.output)

     

       401
       401
       -
             json_section

     

       402
       402
       -
         ) results;

     

       425
       425
       +
               (status_class result.status)

     

       426
       426
       +
               (status_class result.json_status)

     

       427
       427
       +
               (html_escape result.id)

     

       428
       428
       +
               (html_escape (String.lowercase_ascii result.name))

     

       429
       429
       +
               (status_class result.status)

     

       430
       430
       +
               (status_text result.status)

     

       431
       431
       +
               json_badge (html_escape result.id) (html_escape result.name) error_badge

     

       432
       432
       +
               (html_escape result.yaml)

     

       433
       433
       +
               (html_escape result.output)

     

       434
       434
       +
               json_section)

     

       435
       435
       +
           results;

     

       403
       436
        
       

     

       404
       404
       -
         Printf.bprintf buf {|    </div>

     

       437
       437
       +
         Printf.bprintf buf

     

       438
       438
       +
           {|    </div>

     

       405
       439
        
         </div>

     

       406
       440
        
         <script>

     

       407
       441
        
           document.querySelectorAll('.filter-btn').forEach(btn => {

     
···

       437
       471
        
         let html_output = ref None in

     

       438
       472
        
         let show_skipped = ref false in

     

       439
       473
        
         let sequential = ref false in

     

       440
       440
       -
         let args = [

     

       441
       441
       -
           "--html", Arg.String (fun s -> html_output := Some s),

     

       442
       442
       -
           "<file> Generate HTML report to file";

     

       443
       443
       -
           "--show-skipped", Arg.Set show_skipped,

     

       444
       444
       -
           " Show details of skipped tests";

     

       445
       445
       -
           "--sequential", Arg.Set sequential,

     

       446
       446
       -
           " Run tests sequentially instead of in parallel";

     

       447
       447
       -
         ] in

     

       448
       448
       -
         Arg.parse args (fun _ -> ()) "Usage: run_all_tests_eio [--html <file>] [--show-skipped] [--sequential]";

     

       474
       474
       +
         let test_suite_path_ref = ref test_suite_path in

     

       475
       475
       +
         let args =

     

       476
       476
       +
           [

     

       477
       477
       +
             ( "--html",

     

       478
       478
       +
               Arg.String (fun s -> html_output := Some s),

     

       479
       479
       +
               "<file> Generate HTML report to file" );

     

       480
       480
       +
             ("--show-skipped", Arg.Set show_skipped, " Show details of skipped tests");

     

       481
       481
       +
             ( "--sequential",

     

       482
       482
       +
               Arg.Set sequential,

     

       483
       483
       +
               " Run tests sequentially instead of in parallel" );

     

       484
       484
       +
             ( "--test-suite-path",

     

       485
       485
       +
               Arg.Set_string test_suite_path_ref,

     

       486
       486
       +
               "<path> Path to yaml-test-suite directory" );

     

       487
       487
       +
           ]

     

       488
       488
       +
         in

     

       489
       489
       +
         Arg.parse args

     

       490
       490
       +
           (fun _ -> ())

     

       491
       491
       +
           "Usage: run_all_tests_eio [--html <file>] [--show-skipped] [--sequential] \

     

       492
       492
       +
            [--test-suite-path <path>]";

     

       449
       493
        
       

     

       450
       494
        
         Eio_main.run @@ fun env ->

     

       451
       495
        
         (* Use fs (full filesystem) rather than cwd (sandboxed) to allow ".." navigation *)

     

       452
       496
        
         let fs = Eio.Stdenv.fs env in

     

       453
       497
        
         (* Get the absolute path to the test suite *)

     

       454
       454
       -
         let cwd = Sys.getcwd () in

     

       455
       455
       -
         let test_suite_abs = if Filename.is_relative test_suite_path then

     

       456
       456
       -
           Filename.concat cwd test_suite_path

     

       457
       457
       -
         else

     

       458
       458
       -
           test_suite_path

     

       498
       498
       +
         let test_suite_abs =

     

       499
       499
       +
           if Filename.is_relative !test_suite_path_ref then

     

       500
       500
       +
             Filename.concat (Sys.getcwd ()) !test_suite_path_ref

     

       501
       501
       +
           else !test_suite_path_ref

     

       459
       502
        
         in

     

       460
       503
        
       

     

       461
       504
        
         let start_time = Unix.gettimeofday () in

     

       462
       505
        
       

     

       463
       506
        
         (* Load tests using Eio (parallel by default) *)

     

       464
       464
       -
         let all_tests = if !sequential then

     

       465
       465
       -
           TL.load_directory ~fs test_suite_abs

     

       466
       466
       -
         else

     

       467
       467
       -
           TL.load_directory_parallel ~fs test_suite_abs

     

       507
       507
       +
         let all_tests =

     

       508
       508
       +
           if !sequential then TL.load_directory ~fs test_suite_abs

     

       509
       509
       +
           else TL.load_directory_parallel ~fs test_suite_abs

     

       468
       510
        
         in

     

       469
       511
        
         let load_time = Unix.gettimeofday () in

     

       470
       470
       -
         Printf.printf "Loaded %d tests in %.3fs\n%!" (List.length all_tests) (load_time -. start_time);

     

       512
       512
       +
         Printf.printf "Loaded %d tests in %.3fs\n%!" (List.length all_tests)

     

       513
       513
       +
           (load_time -. start_time);

     

       471
       514
        
       

     

       472
       515
        
         (* Run tests (parallel or sequential based on flag) *)

     

       473
       473
       -
         let results = if !sequential then

     

       474
       474
       -
           List.map run_test all_tests

     

       475
       475
       -
         else

     

       476
       476
       -
           run_tests_parallel all_tests

     

       516
       516
       +
         let results =

     

       517
       517
       +
           if !sequential then List.map run_test all_tests

     

       518
       518
       +
           else run_tests_parallel all_tests

     

       477
       519
        
         in

     

       478
       520
        
         let run_time = Unix.gettimeofday () in

     

       479
       521
        
         Printf.printf "Ran tests in %.3fs\n%!" (run_time -. load_time);

     

       480
       522
        
       

     

       481
       481
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       482
       482
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

       483
       483
       -
         let skip_count = List.length (List.filter (fun r -> r.status = `Skip) results) in

     

       523
       523
       +
         let pass_count =

     

       524
       524
       +
           List.length (List.filter (fun r -> r.status = `Pass) results)

     

       525
       525
       +
         in

     

       526
       526
       +
         let fail_count =

     

       527
       527
       +
           List.length

     

       528
       528
       +
             (List.filter

     

       529
       529
       +
                (fun r -> match r.status with `Fail _ -> true | _ -> false)

     

       530
       530
       +
                results)

     

       531
       531
       +
         in

     

       532
       532
       +
         let skip_count =

     

       533
       533
       +
           List.length (List.filter (fun r -> r.status = `Skip) results)

     

       534
       534
       +
         in

     

       484
       535
        
       

     

       485
       485
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       486
       486
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

       487
       487
       -
         let json_skip_count = List.length (List.filter (fun r -> r.json_status = `Skip) results) in

     

       536
       536
       +
         let json_pass_count =

     

       537
       537
       +
           List.length (List.filter (fun r -> r.json_status = `Pass) results)

     

       538
       538
       +
         in

     

       539
       539
       +
         let json_fail_count =

     

       540
       540
       +
           List.length

     

       541
       541
       +
             (List.filter

     

       542
       542
       +
                (fun r -> match r.json_status with `Fail _ -> true | _ -> false)

     

       543
       543
       +
                results)

     

       544
       544
       +
         in

     

       545
       545
       +
         let json_skip_count =

     

       546
       546
       +
           List.length (List.filter (fun r -> r.json_status = `Skip) results)

     

       547
       547
       +
         in

     

       488
       548
        
       

     

       489
       489
       -
         Printf.printf "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!"

     

       490
       490
       -
           pass_count fail_count skip_count (pass_count + fail_count + skip_count);

     

       549
       549
       +
         Printf.printf

     

       550
       550
       +
           "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!" pass_count

     

       551
       551
       +
           fail_count skip_count

     

       552
       552
       +
           (pass_count + fail_count + skip_count);

     

       491
       553
        
       

     

       492
       492
       -
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!"

     

       493
       493
       -
           json_pass_count json_fail_count json_skip_count;

     

       554
       554
       +
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!" json_pass_count

     

       555
       555
       +
           json_fail_count json_skip_count;

     

       494
       556
        
       

     

       495
       557
        
         if fail_count > 0 then begin

     

       496
       558
        
           Printf.printf "\nFailing event tree tests:\n";

     

       497
       497
       -
           List.iter (fun r ->

     

       498
       498
       -
             match r.status with

     

       499
       499
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       500
       500
       -
             | _ -> ()

     

       501
       501
       -
           ) results

     

       559
       559
       +
           List.iter

     

       560
       560
       +
             (fun r ->

     

       561
       561
       +
               match r.status with

     

       562
       562
       +
               | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       563
       563
       +
               | _ -> ())

     

       564
       564
       +
             results

     

       502
       565
        
         end;

     

       503
       566
        
       

     

       504
       567
        
         if json_fail_count > 0 then begin

     

       505
       568
        
           Printf.printf "\nFailing JSON tests:\n";

     

       506
       506
       -
           List.iter (fun r ->

     

       507
       507
       -
             match r.json_status with

     

       508
       508
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       509
       509
       -
             | _ -> ()

     

       510
       510
       -
           ) results

     

       569
       569
       +
           List.iter

     

       570
       570
       +
             (fun r ->

     

       571
       571
       +
               match r.json_status with

     

       572
       572
       +
               | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       573
       573
       +
               | _ -> ())

     

       574
       574
       +
             results

     

       511
       575
        
         end;

     

       512
       576
        
       

     

       513
       577
        
         if !show_skipped && skip_count > 0 then begin

     

       514
       578
        
           Printf.printf "\nSkipped tests (no expected tree):\n";

     

       515
       515
       -
           List.iter (fun r ->

     

       516
       516
       -
             if r.status = `Skip then begin

     

       517
       517
       -
               Printf.printf "  %s: %s\n" r.id r.name;

     

       518
       518
       -
               Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       519
       519
       -
                 (if String.length r.yaml <= 60 then r.yaml

     

       520
       520
       -
                  else String.sub r.yaml 0 60 ^ "...")

     

       521
       521
       -
             end

     

       522
       522
       -
           ) results

     

       579
       579
       +
           List.iter

     

       580
       580
       +
             (fun r ->

     

       581
       581
       +
               if r.status = `Skip then begin

     

       582
       582
       +
                 Printf.printf "  %s: %s\n" r.id r.name;

     

       583
       583
       +
                 Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       584
       584
       +
                   (if String.length r.yaml <= 60 then r.yaml

     

       585
       585
       +
                    else String.sub r.yaml 0 60 ^ "...")

     

       586
       586
       +
               end)

     

       587
       587
       +
             results

     

       523
       588
        
         end;

     

       524
       589
        
       

     

       525
       590
        
         let total_time = Unix.gettimeofday () in

     

       526
       591
        
         Printf.printf "\nTotal time: %.3fs\n%!" (total_time -. start_time);

     

       527
       592
        
       

     

       528
       528
       -
         match !html_output with

     

       593
       593
       +
         (match !html_output with

     

       529
       594
        
         | Some file ->

     

       530
       595
        
             generate_html ~fs results file;

     

       531
       596
        
             Printf.printf "HTML report generated: %s\n" file

     

       532
       532
       -
         | None -> ()

     

       597
       597
       +
         | None -> ());

     

       598
       598
       +
       

     

       599
       599
       +
         (* Exit with non-zero code if any tests failed *)

     

       600
       600
       +
         if fail_count > 0 || json_fail_count > 0 then exit 1

+6 -1

tests/test_suite_lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name test_suite_lib)

     

       3
       3
       -
        (modules test_suite_loader_generic test_suite_loader tree_format json_format json_compare)

     

       3
       3
       +
        (modules

     

       4
       4
       +
         test_suite_loader_generic

     

       5
       5
       +
         test_suite_loader

     

       6
       6
       +
         tree_format

     

       7
       7
       +
         json_format

     

       8
       8
       +
         json_compare)

     

       4
       9
        
        (libraries yamlrw jsonm))

     

       5
       10
        
       

     

       6
       11
        
       (library

+29 -27

tests/test_suite_lib/json_compare.ml

···

       14
       14
        
         | Object of (string * json) list

     

       15
       15
        
       

     

       16
       16
        
       let rec equal a b =

     

       17
       17
       -
         match a, b with

     

       17
       17
       +
         match (a, b) with

     

       18
       18
        
         | Null, Null -> true

     

       19
       19
        
         | Bool a, Bool b -> a = b

     

       20
       20
        
         | Float a, Float b -> Float.equal a b

     
···

       22
       22
        
         | Array a, Array b -> List.equal equal a b

     

       23
       23
        
         | Object a, Object b ->

     

       24
       24
        
             (* Compare objects as sets of key-value pairs (order independent) *)

     

       25
       25
       -
             let sorted_a = List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) a in

     

       26
       26
       -
             let sorted_b = List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) b in

     

       27
       27
       -
             List.length sorted_a = List.length sorted_b &&

     

       28
       28
       -
             List.for_all2 (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2) sorted_a sorted_b

     

       25
       25
       +
             let sorted_a =

     

       26
       26
       +
               List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) a

     

       27
       27
       +
             in

     

       28
       28
       +
             let sorted_b =

     

       29
       29
       +
               List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) b

     

       30
       30
       +
             in

     

       31
       31
       +
             List.length sorted_a = List.length sorted_b

     

       32
       32
       +
             && List.for_all2

     

       33
       33
       +
                  (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2)

     

       34
       34
       +
                  sorted_a sorted_b

     

       29
       35
        
         | _ -> false

     

       30
       36
        
       

     

       31
       37
        
       (* Parse JSON string using jsonm *)

     
···

       46
       52
        
         and parse_array acc =

     

       47
       53
        
           match Jsonm.decode decoder with

     

       48
       54
        
           | `Lexeme `Ae -> Ok (Array (List.rev acc))

     

       49
       49
       -
           | `Lexeme _ as lex ->

     

       55
       55
       +
           | `Lexeme _ as lex -> (

     

       50
       56
        
               (* Push back and parse value *)

     

       51
       57
        
               let result = parse_value_with_lex lex in

     

       52
       52
       -
               (match result with

     

       53
       53
       -
                | Ok v -> parse_array (v :: acc)

     

       54
       54
       -
                | Error _ as e -> e)

     

       58
       58
       +
               match result with Ok v -> parse_array (v :: acc) | Error _ as e -> e)

     

       55
       59
        
           | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)

     

       56
       60
        
           | `End -> Error "unexpected end in array"

     

       57
       61
        
           | `Await -> Error "unexpected await"

     

       58
       62
        
         and parse_object acc =

     

       59
       63
        
           match Jsonm.decode decoder with

     

       60
       64
        
           | `Lexeme `Oe -> Ok (Object (List.rev acc))

     

       61
       61
       -
           | `Lexeme (`Name key) ->

     

       62
       62
       -
               (match parse_value () with

     

       63
       63
       -
                | Ok v -> parse_object ((key, v) :: acc)

     

       64
       64
       -
                | Error _ as e -> e)

     

       65
       65
       +
           | `Lexeme (`Name key) -> (

     

       66
       66
       +
               match parse_value () with

     

       67
       67
       +
               | Ok v -> parse_object ((key, v) :: acc)

     

       68
       68
       +
               | Error _ as e -> e)

     

       65
       69
        
           | `Lexeme _ -> Error "expected object key"

     

       66
       70
        
           | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)

     

       67
       71
        
           | `End -> Error "unexpected end in object"

     
···

       99
       103
        
         and parse_array acc =

     

       100
       104
        
           match Jsonm.decode decoder with

     

       101
       105
        
           | `Lexeme `Ae -> Some (Array (List.rev acc))

     

       102
       102
       -
           | `Lexeme _ as lex ->

     

       103
       103
       -
               (match parse_value_with_lex lex with

     

       104
       104
       -
                | Some v -> parse_array (v :: acc)

     

       105
       105
       -
                | None -> None)

     

       106
       106
       +
           | `Lexeme _ as lex -> (

     

       107
       107
       +
               match parse_value_with_lex lex with

     

       108
       108
       +
               | Some v -> parse_array (v :: acc)

     

       109
       109
       +
               | None -> None)

     

       106
       110
        
           | _ -> None

     

       107
       111
        
         and parse_object acc =

     

       108
       112
        
           match Jsonm.decode decoder with

     

       109
       113
        
           | `Lexeme `Oe -> Some (Object (List.rev acc))

     

       110
       110
       -
           | `Lexeme (`Name key) ->

     

       111
       111
       -
               (match parse_value () with

     

       112
       112
       -
                | Some v -> parse_object ((key, v) :: acc)

     

       113
       113
       -
                | None -> None)

     

       114
       114
       +
           | `Lexeme (`Name key) -> (

     

       115
       115
       +
               match parse_value () with

     

       116
       116
       +
               | Some v -> parse_object ((key, v) :: acc)

     

       117
       117
       +
               | None -> None)

     

       114
       118
        
           | _ -> None

     

       115
       119
        
         and parse_value_with_lex lex =

     

       116
       120
        
           match lex with

     
···

       134
       138
        
         (* Handle empty strings *)

     

       135
       139
        
         let expected_trimmed = String.trim expected in

     

       136
       140
        
         let actual_trimmed = String.trim actual in

     

       137
       137
       -
         if expected_trimmed = "" && actual_trimmed = "" then

     

       138
       138
       -
           true

     

       139
       139
       -
         else if expected_trimmed = "" || actual_trimmed = "" then

     

       140
       140
       -
           false

     

       141
       141
       +
         if expected_trimmed = "" && actual_trimmed = "" then true

     

       142
       142
       +
         else if expected_trimmed = "" || actual_trimmed = "" then false

     

       141
       143
        
         else

     

       142
       144
        
           (* Parse as potentially multiple JSON values *)

     

       143
       145
        
           let expected_values = parse_json_multi expected in

     

       144
       146
        
           let actual_values = parse_json_multi actual in

     

       145
       145
       -
           List.length expected_values = List.length actual_values &&

     

       146
       146
       -
           List.for_all2 equal expected_values actual_values

     

       147
       147
       +
           List.length expected_values = List.length actual_values

     

       148
       148
       +
           && List.for_all2 equal expected_values actual_values

+37 -27

tests/test_suite_lib/json_format.ml

···

       10
       10
        
       let escape_string s =

     

       11
       11
        
         let buf = Buffer.create (String.length s * 2) in

     

       12
       12
        
         Buffer.add_char buf '"';

     

       13
       13
       -
         String.iter (fun c ->

     

       14
       14
       -
           match c with

     

       15
       15
       -
           | '"' -> Buffer.add_string buf "\\\""

     

       16
       16
       -
           | '\\' -> Buffer.add_string buf "\\\\"

     

       17
       17
       -
           | '\n' -> Buffer.add_string buf "\\n"

     

       18
       18
       -
           | '\r' -> Buffer.add_string buf "\\r"

     

       19
       19
       -
           | '\t' -> Buffer.add_string buf "\\t"

     

       20
       20
       -
           | '\x08' -> Buffer.add_string buf "\\b"

     

       21
       21
       -
           | '\x0c' -> Buffer.add_string buf "\\f"

     

       22
       22
       -
           | c when Char.code c < 32 ->

     

       23
       23
       -
               Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))

     

       24
       24
       -
           | c -> Buffer.add_char buf c

     

       25
       25
       -
         ) s;

     

       13
       13
       +
         String.iter

     

       14
       14
       +
           (fun c ->

     

       15
       15
       +
             match c with

     

       16
       16
       +
             | '"' -> Buffer.add_string buf "\\\""

     

       17
       17
       +
             | '\\' -> Buffer.add_string buf "\\\\"

     

       18
       18
       +
             | '\n' -> Buffer.add_string buf "\\n"

     

       19
       19
       +
             | '\r' -> Buffer.add_string buf "\\r"

     

       20
       20
       +
             | '\t' -> Buffer.add_string buf "\\t"

     

       21
       21
       +
             | '\x08' -> Buffer.add_string buf "\\b"

     

       22
       22
       +
             | '\x0c' -> Buffer.add_string buf "\\f"

     

       23
       23
       +
             | c when Char.code c < 32 ->

     

       24
       24
       +
                 Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))

     

       25
       25
       +
             | c -> Buffer.add_char buf c)

     

       26
       26
       +
           s;

     

       26
       27
        
         Buffer.add_char buf '"';

     

       27
       28
        
         Buffer.contents buf

     

       28
       29
        
       

     

       29
       29
       -
       let rec format_value ?(indent=0) (v : Value.t) =

     

       30
       30
       +
       let rec format_value ?(indent = 0) (v : Value.t) =

     

       30
       31
        
         let spaces n = String.make n ' ' in

     

       31
       32
        
         match v with

     

       32
       33
        
         | `Null -> "null"

     

       33
       34
        
         | `Bool true -> "true"

     

       34
       35
        
         | `Bool false -> "false"

     

       35
       36
        
         | `Float f ->

     

       36
       36
       -
             if Float.is_nan f then "null"  (* JSON doesn't support NaN *)

     

       37
       37
       -
             else if f = Float.infinity || f = Float.neg_infinity then "null"  (* JSON doesn't support Inf *)

     

       37
       37
       +
             if Float.is_nan f then "null" (* JSON doesn't support NaN *)

     

       38
       38
       +
             else if f = Float.infinity || f = Float.neg_infinity then "null"

     

       39
       39
       +
               (* JSON doesn't support Inf *)

     

       38
       40
        
             else if Float.is_integer f && Float.abs f < 1e15 then

     

       39
       41
        
               Printf.sprintf "%.0f" f

     

       40
       42
        
             else

     

       41
       43
        
               (* Try to match yaml-test-suite's number formatting *)

     

       42
       44
        
               let s = Printf.sprintf "%g" f in

     

       43
       45
        
               (* Ensure we have a decimal point for floats *)

     

       44
       44
       -
               if String.contains s '.' || String.contains s 'e' || String.contains s 'E' then s

     

       46
       46
       +
               if

     

       47
       47
       +
                 String.contains s '.' || String.contains s 'e'

     

       48
       48
       +
                 || String.contains s 'E'

     

       49
       49
       +
               then s

     

       45
       50
        
               else s ^ ".0"

     

       46
       51
        
         | `String s -> escape_string s

     

       47
       52
        
         | `A [] -> "[]"

     

       48
       53
        
         | `A items ->

     

       49
       54
        
             let inner_indent = indent + 2 in

     

       50
       50
       -
             let formatted_items = List.map (fun item ->

     

       51
       51
       -
               spaces inner_indent ^ format_value ~indent:inner_indent item

     

       52
       52
       -
             ) items in

     

       55
       55
       +
             let formatted_items =

     

       56
       56
       +
               List.map

     

       57
       57
       +
                 (fun item ->

     

       58
       58
       +
                   spaces inner_indent ^ format_value ~indent:inner_indent item)

     

       59
       59
       +
                 items

     

       60
       60
       +
             in

     

       53
       61
        
             "[\n" ^ String.concat ",\n" formatted_items ^ "\n" ^ spaces indent ^ "]"

     

       54
       62
        
         | `O [] -> "{}"

     

       55
       63
        
         | `O pairs ->

     

       56
       64
        
             let inner_indent = indent + 2 in

     

       57
       57
       -
             let formatted_pairs = List.map (fun (k, v) ->

     

       58
       58
       -
               let key = escape_string k in

     

       59
       59
       -
               let value = format_value ~indent:inner_indent v in

     

       60
       60
       -
               spaces inner_indent ^ key ^ ": " ^ value

     

       61
       61
       -
             ) pairs in

     

       65
       65
       +
             let formatted_pairs =

     

       66
       66
       +
               List.map

     

       67
       67
       +
                 (fun (k, v) ->

     

       68
       68
       +
                   let key = escape_string k in

     

       69
       69
       +
                   let value = format_value ~indent:inner_indent v in

     

       70
       70
       +
                   spaces inner_indent ^ key ^ ": " ^ value)

     

       71
       71
       +
                 pairs

     

       72
       72
       +
             in

     

       62
       73
        
             "{\n" ^ String.concat ",\n" formatted_pairs ^ "\n" ^ spaces indent ^ "}"

     

       63
       74
        
       

     

       64
       64
       -
       let to_json (v : Value.t) : string =

     

       65
       65
       -
         format_value v

     

       75
       75
       +
       let to_json (v : Value.t) : string = format_value v

     

       66
       76
        
       

     

       67
       77
        
       (* Format multiple documents (for multi-doc YAML) *)

     

       68
       78
        
       let documents_to_json (docs : Value.t list) : string =

+5 -10

tests/test_suite_lib/test_suite_loader.ml

···

       18
       18
        
             Some s

     

       19
       19
        
           with _ -> None

     

       20
       20
        
       

     

       21
       21
       -
         let file_exists () path =

     

       22
       22
       -
           Sys.file_exists path

     

       23
       23
       -
       

     

       24
       24
       -
         let is_directory () path =

     

       25
       25
       -
           Sys.file_exists path && Sys.is_directory path

     

       26
       26
       -
       

     

       27
       27
       -
         let read_dir () path =

     

       28
       28
       -
           Array.to_list (Sys.readdir path)

     

       21
       21
       +
         let file_exists () path = Sys.file_exists path

     

       22
       22
       +
         let is_directory () path = Sys.file_exists path && Sys.is_directory path

     

       23
       23
       +
         let read_dir () path = Array.to_list (Sys.readdir path)

     

       29
       24
        
       end

     

       30
       25
        
       

     

       26
       26
       +
       module Loader = Test_suite_loader_generic.Make (Sync_io)

     

       31
       27
        
       (** Internal loader module *)

     

       32
       32
       -
       module Loader = Test_suite_loader_generic.Make(Sync_io)

     

       33
       28
        
       

     

       34
       34
       -
       (** Re-export test_case type from loader *)

     

       35
       29
        
       type test_case = Loader.test_case = {

     

       36
       30
        
         id : string;

     

       37
       31
        
         name : string;

     
···

       40
       34
        
         json : string option;

     

       41
       35
        
         fail : bool;

     

       42
       36
        
       }

     

       37
       37
       +
       (** Re-export test_case type from loader *)

     

       43
       38
        
       

     

       44
       39
        
       (** Load tests without needing to pass a context *)

     

       45
       40
        
       let load_directory path : test_case list = Loader.load_directory () path

+16 -16

tests/test_suite_lib/test_suite_loader_eio.ml

···

       8
       8
        
       module Generic = Test_suite_lib.Test_suite_loader_generic

     

       9
       9
        
       

     

       10
       10
        
       (** Eio file I/O implementation *)

     

       11
       11
       -
       module Eio_io : Generic.FILE_IO with type ctx = Eio.Fs.dir_ty Eio.Path.t = struct

     

       11
       11
       +
       module Eio_io : Generic.FILE_IO with type ctx = Eio.Fs.dir_ty Eio.Path.t =

     

       12
       12
       +
       struct

     

       12
       13
        
         type ctx = Eio.Fs.dir_ty Eio.Path.t

     

       13
       14
        
       

     

       14
       15
        
         let read_file fs path =

     

       15
       15
       -
           try

     

       16
       16
       -
             Some (Eio.Path.load Eio.Path.(fs / path))

     

       17
       17
       -
           with _ -> None

     

       16
       16
       +
           try Some (Eio.Path.load Eio.Path.(fs / path)) with _ -> None

     

       18
       17
        
       

     

       19
       18
        
         let file_exists fs path =

     

       20
       19
        
           match Eio.Path.kind ~follow:true Eio.Path.(fs / path) with

     
···

       28
       27
        
           | _ -> false

     

       29
       28
        
           | exception _ -> false

     

       30
       29
        
       

     

       31
       31
       -
         let read_dir fs path =

     

       32
       32
       -
           Eio.Path.read_dir Eio.Path.(fs / path)

     

       30
       30
       +
         let read_dir fs path = Eio.Path.read_dir Eio.Path.(fs / path)

     

       33
       31
        
       end

     

       34
       32
        
       

     

       33
       33
       +
       module Loader = Generic.Make (Eio_io)

     

       35
       34
        
       (** Internal loader module *)

     

       36
       36
       -
       module Loader = Generic.Make(Eio_io)

     

       37
       35
        
       

     

       38
       38
       -
       (** Re-export test_case type from loader *)

     

       39
       36
        
       type test_case = Loader.test_case = {

     

       40
       37
        
         id : string;

     

       41
       38
        
         name : string;

     
···

       44
       41
        
         json : string option;

     

       45
       42
        
         fail : bool;

     

       46
       43
        
       }

     

       44
       44
       +
       (** Re-export test_case type from loader *)

     

       47
       45
        
       

     

       48
       46
        
       (** Load tests with Eio filesystem context *)

     

       49
       47
        
       let load_directory ~fs path : test_case list = Loader.load_directory fs path

     
···

       53
       51
        
         if not (Eio_io.is_directory fs test_suite_path) then []

     

       54
       52
        
         else

     

       55
       53
        
           let entries = Eio_io.read_dir fs test_suite_path in

     

       56
       56
       -
           let test_ids = entries

     

       54
       54
       +
           let test_ids =

     

       55
       55
       +
             entries

     

       57
       56
        
             |> List.filter (fun e ->

     

       58
       58
       -
                 Eio_io.is_directory fs (Filename.concat test_suite_path e) &&

     

       59
       59
       -
                 String.length e >= 4 &&

     

       60
       60
       -
                 e.[0] >= '0' && e.[0] <= 'Z')

     

       57
       57
       +
                 Eio_io.is_directory fs (Filename.concat test_suite_path e)

     

       58
       58
       +
                 && String.length e >= 4

     

       59
       59
       +
                 && e.[0] >= '0'

     

       60
       60
       +
                 && e.[0] <= 'Z')

     

       61
       61
        
             |> List.sort String.compare

     

       62
       62
        
           in

     

       63
       63
       -
           (* Load each test ID in parallel using fibers *)

     

       64
       64
       -
           Eio.Fiber.List.map (fun test_id ->

     

       65
       65
       -
             Loader.load_test_id fs test_suite_path test_id

     

       66
       66
       -
           ) test_ids

     

       63
       63
       +
           (* Load each test ID in parallel using fibers with bounded concurrency *)

     

       64
       64
       +
           Eio.Fiber.List.map ~max_fibers:50

     

       65
       65
       +
             (fun test_id -> Loader.load_test_id fs test_suite_path test_id)

     

       66
       66
       +
             test_ids

     

       67
       67
        
           |> List.concat

+40 -31

tests/test_suite_lib/test_suite_loader_generic.ml

···

       5
       5
        
       

     

       6
       6
        
       (** Generic test suite loader - parameterized by file I/O operations *)

     

       7
       7
        
       

     

       8
       8
       -
       (** Test case representation *)

     

       9
       8
        
       type test_case = {

     

       10
       9
        
         id : string;

     

       11
       10
        
         name : string;

     
···

       14
       13
        
         json : string option;

     

       15
       14
        
         fail : bool;

     

       16
       15
        
       }

     

       16
       16
       +
       (** Test case representation *)

     

       17
       17
        
       

     

       18
       18
        
       (** Module type for file I/O operations *)

     

       19
       19
        
       module type FILE_IO = sig

     

       20
       20
       -
         (** Context type for file operations (unit for sync, ~fs for Eio) *)

     

       21
       20
        
         type ctx

     

       21
       21
       +
         (** Context type for file operations (unit for sync, ~fs for Eio) *)

     

       22
       22
        
       

     

       23
       23
       +
         val read_file : ctx -> string -> string option

     

       23
       24
        
         (** Read a file, returning None if it doesn't exist or can't be read *)

     

       24
       24
       -
         val read_file : ctx -> string -> string option

     

       25
       25
        
       

     

       26
       26
       -
         (** Check if a path exists and is a regular file *)

     

       27
       26
        
         val file_exists : ctx -> string -> bool

     

       27
       27
       +
         (** Check if a path exists and is a regular file *)

     

       28
       28
        
       

     

       29
       29
       -
         (** Check if a path exists and is a directory *)

     

       30
       29
        
         val is_directory : ctx -> string -> bool

     

       30
       30
       +
         (** Check if a path exists and is a directory *)

     

       31
       31
        
       

     

       32
       32
       +
         val read_dir : ctx -> string -> string list

     

       32
       33
        
         (** List directory entries *)

     

       33
       33
       -
         val read_dir : ctx -> string -> string list

     

       34
       34
        
       end

     

       35
       35
        
       

     

       36
       36
        
       (** Create a test loader from file I/O operations *)

     
···

       45
       45
        
         }

     

       46
       46
        
       

     

       47
       47
        
         let read_file_required ctx path =

     

       48
       48
       -
           match IO.read_file ctx path with

     

       49
       49
       -
           | Some s -> s

     

       50
       50
       -
           | None -> ""

     

       48
       48
       +
           match IO.read_file ctx path with Some s -> s | None -> ""

     

       51
       49
        
       

     

       52
       50
        
         (** Load a single test from a directory *)

     

       53
       51
        
         let load_test_dir ctx base_id dir_path =

     
···

       60
       58
        
           (* Must have in.yaml to be a valid test *)

     

       61
       59
        
           if not (IO.file_exists ctx yaml_file) then None

     

       62
       60
        
           else

     

       63
       63
       -
             let name = match IO.read_file ctx name_file with

     

       61
       61
       +
             let name =

     

       62
       62
       +
               match IO.read_file ctx name_file with

     

       64
       63
        
               | Some s -> String.trim s

     

       65
       64
        
               | None -> base_id

     

       66
       65
        
             in

     
···

       70
       69
        
             let fail = IO.file_exists ctx error_file in

     

       71
       70
        
             Some { id = base_id; name; yaml; tree; json; fail }

     

       72
       71
        
       

     

       73
       73
       -
         (** Load tests from a test ID directory (may have subdirectories for variants) *)

     

       72
       72
       +
         (** Load tests from a test ID directory (may have subdirectories for variants)

     

       73
       73
       +
         *)

     

       74
       74
        
         let load_test_id ctx test_suite_path test_id =

     

       75
       75
        
           let dir_path = Filename.concat test_suite_path test_id in

     

       76
       76
        
           if not (IO.is_directory ctx dir_path) then []

     

       77
       77
        
           else

     

       78
       78
        
             let entries = IO.read_dir ctx dir_path in

     

       79
       79
        
             (* Check if this directory has variant subdirectories (00, 01, etc.) *)

     

       80
       80
       -
             let has_variants = List.exists (fun e ->

     

       81
       81
       -
               let subdir = Filename.concat dir_path e in

     

       82
       82
       -
               IO.is_directory ctx subdir &&

     

       83
       83
       -
               String.length e >= 2 &&

     

       84
       84
       -
               e.[0] >= '0' && e.[0] <= '9'

     

       85
       85
       -
             ) entries in

     

       80
       80
       +
             let has_variants =

     

       81
       81
       +
               List.exists

     

       82
       82
       +
                 (fun e ->

     

       83
       83
       +
                   let subdir = Filename.concat dir_path e in

     

       84
       84
       +
                   IO.is_directory ctx subdir

     

       85
       85
       +
                   && String.length e >= 2

     

       86
       86
       +
                   && e.[0] >= '0'

     

       87
       87
       +
                   && e.[0] <= '9')

     

       88
       88
       +
                 entries

     

       89
       89
       +
             in

     

       86
       90
        
       

     

       87
       91
        
             if has_variants then

     

       88
       92
        
               (* Load each variant subdirectory *)

     

       89
       89
       -
               let variants = entries

     

       93
       93
       +
               let variants =

     

       94
       94
       +
                 entries

     

       90
       95
        
                 |> List.filter (fun e ->

     

       91
       96
        
                     let subdir = Filename.concat dir_path e in

     

       92
       92
       -
                     IO.is_directory ctx subdir &&

     

       93
       93
       -
                     String.length e >= 2 &&

     

       94
       94
       -
                     e.[0] >= '0' && e.[0] <= '9')

     

       97
       97
       +
                     IO.is_directory ctx subdir

     

       98
       98
       +
                     && String.length e >= 2

     

       99
       99
       +
                     && e.[0] >= '0'

     

       100
       100
       +
                     && e.[0] <= '9')

     

       95
       101
        
                 |> List.sort String.compare

     

       96
       102
        
               in

     

       97
       97
       -
               List.filter_map (fun variant ->

     

       98
       98
       -
                 let variant_path = Filename.concat dir_path variant in

     

       99
       99
       -
                 let variant_id = Printf.sprintf "%s:%s" test_id variant in

     

       100
       100
       -
                 load_test_dir ctx variant_id variant_path

     

       101
       101
       -
               ) variants

     

       103
       103
       +
               List.filter_map

     

       104
       104
       +
                 (fun variant ->

     

       105
       105
       +
                   let variant_path = Filename.concat dir_path variant in

     

       106
       106
       +
                   let variant_id = Printf.sprintf "%s:%s" test_id variant in

     

       107
       107
       +
                   load_test_dir ctx variant_id variant_path)

     

       108
       108
       +
                 variants

     

       102
       109
        
             else

     

       103
       110
        
               (* Single test in this directory *)

     

       104
       111
        
               match load_test_dir ctx test_id dir_path with

     

       105
       105
       -
               | Some t -> [t]

     

       112
       112
       +
               | Some t -> [ t ]

     

       106
       113
        
               | None -> []

     

       107
       114
        
       

     

       108
       115
        
         (** Load all tests from a test suite directory *)

     
···

       110
       117
        
           if not (IO.is_directory ctx test_suite_path) then []

     

       111
       118
        
           else

     

       112
       119
        
             let entries = IO.read_dir ctx test_suite_path in

     

       113
       113
       -
             let test_ids = entries

     

       120
       120
       +
             let test_ids =

     

       121
       121
       +
               entries

     

       114
       122
        
               |> List.filter (fun e ->

     

       115
       115
       -
                   IO.is_directory ctx (Filename.concat test_suite_path e) &&

     

       116
       116
       -
                   String.length e >= 4 &&

     

       117
       117
       -
                   e.[0] >= '0' && e.[0] <= 'Z')

     

       123
       123
       +
                   IO.is_directory ctx (Filename.concat test_suite_path e)

     

       124
       124
       +
                   && String.length e >= 4

     

       125
       125
       +
                   && e.[0] >= '0'

     

       126
       126
       +
                   && e.[0] <= 'Z')

     

       118
       127
        
               |> List.sort String.compare

     

       119
       128
        
             in

     

       120
       129
        
             List.concat_map (load_test_id ctx test_suite_path) test_ids

+27 -28

tests/test_suite_lib/tree_format.ml

···

       9
       9
        
       

     

       10
       10
        
       let escape_string s =

     

       11
       11
        
         let buf = Buffer.create (String.length s * 2) in

     

       12
       12
       -
         String.iter (fun c ->

     

       13
       13
       -
           match c with

     

       14
       14
       -
           | '\n' -> Buffer.add_string buf "\\n"

     

       15
       15
       -
           | '\t' -> Buffer.add_string buf "\\t"

     

       16
       16
       -
           | '\r' -> Buffer.add_string buf "\\r"

     

       17
       17
       -
           | '\\' -> Buffer.add_string buf "\\\\"

     

       18
       18
       -
           | '\x00' -> Buffer.add_string buf "\\0"

     

       19
       19
       -
           | '\x07' -> Buffer.add_string buf "\\a"

     

       20
       20
       -
           | '\x08' -> Buffer.add_string buf "\\b"

     

       21
       21
       -
           | '\x0b' -> Buffer.add_string buf "\\v"

     

       22
       22
       -
           | '\x0c' -> Buffer.add_string buf "\\f"

     

       23
       23
       -
           | '\x1b' -> Buffer.add_string buf "\\e"

     

       24
       24
       -
           | '\xa0' -> Buffer.add_string buf "\\_"

     

       25
       25
       -
           | c -> Buffer.add_char buf c

     

       26
       26
       -
         ) s;

     

       12
       12
       +
         String.iter

     

       13
       13
       +
           (fun c ->

     

       14
       14
       +
             match c with

     

       15
       15
       +
             | '\n' -> Buffer.add_string buf "\\n"

     

       16
       16
       +
             | '\t' -> Buffer.add_string buf "\\t"

     

       17
       17
       +
             | '\r' -> Buffer.add_string buf "\\r"

     

       18
       18
       +
             | '\\' -> Buffer.add_string buf "\\\\"

     

       19
       19
       +
             | '\x00' -> Buffer.add_string buf "\\0"

     

       20
       20
       +
             | '\x07' -> Buffer.add_string buf "\\a"

     

       21
       21
       +
             | '\x08' -> Buffer.add_string buf "\\b"

     

       22
       22
       +
             | '\x0b' -> Buffer.add_string buf "\\v"

     

       23
       23
       +
             | '\x0c' -> Buffer.add_string buf "\\f"

     

       24
       24
       +
             | '\x1b' -> Buffer.add_string buf "\\e"

     

       25
       25
       +
             | '\xa0' -> Buffer.add_string buf "\\_"

     

       26
       26
       +
             | c -> Buffer.add_char buf c)

     

       27
       27
       +
           s;

     

       27
       28
        
         Buffer.contents buf

     

       28
       29
        
       

     

       29
       30
        
       let style_char = function

     
···

       39
       40
        
         | Event.Stream_start _ -> "+STR"

     

       40
       41
        
         | Event.Stream_end -> "-STR"

     

       41
       42
        
         | Event.Document_start { implicit; _ } ->

     

       42
       42
       -
             if implicit then "+DOC"

     

       43
       43
       -
             else "+DOC ---"

     

       44
       44
       -
         | Event.Document_end { implicit } ->

     

       45
       45
       -
             if implicit then "-DOC"

     

       46
       46
       -
             else "-DOC ..."

     

       43
       43
       +
             if implicit then "+DOC" else "+DOC ---"

     

       44
       44
       +
         | Event.Document_end { implicit } -> if implicit then "-DOC" else "-DOC ..."

     

       47
       45
        
         | Event.Mapping_start { anchor; tag; style; _ } ->

     

       48
       46
        
             let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in

     

       49
       47
        
             let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in

     
···

       60
       58
        
             let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in

     

       61
       59
        
             let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in

     

       62
       60
        
             let style_c = style_char style in

     

       63
       63
       -
             Printf.sprintf "=VAL%s%s %c%s" anchor_str tag_str style_c (escape_string value)

     

       64
       64
       -
         | Event.Alias { anchor } ->

     

       65
       65
       -
             Printf.sprintf "=ALI *%s" anchor

     

       61
       61
       +
             Printf.sprintf "=VAL%s%s %c%s" anchor_str tag_str style_c

     

       62
       62
       +
               (escape_string value)

     

       63
       63
       +
         | Event.Alias { anchor } -> Printf.sprintf "=ALI *%s" anchor

     

       66
       64
        
       

     

       67
       65
        
       let of_spanned_events events =

     

       68
       66
        
         let buf = Buffer.create 256 in

     

       69
       69
       -
         List.iter (fun (e : Event.spanned) ->

     

       70
       70
       -
           let line = format_event e in

     

       71
       71
       -
           Buffer.add_string buf line;

     

       72
       72
       -
           Buffer.add_char buf '\n'

     

       73
       73
       -
         ) events;

     

       67
       67
       +
         List.iter

     

       68
       68
       +
           (fun (e : Event.spanned) ->

     

       69
       69
       +
             let line = format_event e in

     

       70
       70
       +
             Buffer.add_string buf line;

     

       71
       71
       +
             Buffer.add_char buf '\n')

     

       72
       72
       +
           events;

     

       74
       73
        
         Buffer.contents buf

+283 -108

tests/test_yamlrw.ml

···

       24
       24
        
         Alcotest.(check int) "token count" 8 (List.length token_types);

     

       25
       25
        
         (* Stream_start, Block_mapping_start, Key, Scalar, Value, Scalar, Block_end, Stream_end *)

     

       26
       26
        
         match token_types with

     

       27
       27
       -
         | Token.Stream_start _ :: Token.Block_mapping_start :: Token.Key ::

     

       28
       28
       -
           Token.Scalar { value = "hello"; _ } :: Token.Value ::

     

       29
       29
       -
           Token.Scalar { value = "world"; _ } :: Token.Block_end :: Token.Stream_end :: [] ->

     

       27
       27
       +
         | [

     

       28
       28
       +
          Token.Stream_start _;

     

       29
       29
       +
          Token.Block_mapping_start;

     

       30
       30
       +
          Token.Key;

     

       31
       31
       +
          Token.Scalar { value = "hello"; _ };

     

       32
       32
       +
          Token.Value;

     

       33
       33
       +
          Token.Scalar { value = "world"; _ };

     

       34
       34
       +
          Token.Block_end;

     

       35
       35
       +
          Token.Stream_end;

     

       36
       36
       +
         ] ->

     

       30
       37
        
             ()

     

       31
       31
       -
         | _ ->

     

       32
       32
       -
             Alcotest.fail "unexpected token sequence"

     

       38
       38
       +
         | _ -> Alcotest.fail "unexpected token sequence"

     

       33
       39
        
       

     

       34
       40
        
       let test_scanner_sequence () =

     

       35
       41
        
         let scanner = Scanner.of_string "- one\n- two\n- three" in

     
···

       39
       45
        
       let test_scanner_flow () =

     

       40
       46
        
         let scanner = Scanner.of_string "[1, 2, 3]" in

     

       41
       47
        
         let tokens = Scanner.to_list scanner in

     

       42
       42
       -
         let has_flow_start = List.exists (fun (t : Token.spanned) ->

     

       43
       43
       -
           match t.token with Token.Flow_sequence_start -> true | _ -> false

     

       44
       44
       -
         ) tokens in

     

       48
       48
       +
         let has_flow_start =

     

       49
       49
       +
           List.exists

     

       50
       50
       +
             (fun (t : Token.spanned) ->

     

       51
       51
       +
               match t.token with Token.Flow_sequence_start -> true | _ -> false)

     

       52
       52
       +
             tokens

     

       53
       53
       +
         in

     

       45
       54
        
         Alcotest.(check bool) "has flow sequence start" true has_flow_start

     

       46
       55
        
       

     

       47
       47
       -
       let scanner_tests = [

     

       48
       48
       -
         "simple mapping", `Quick, test_scanner_simple;

     

       49
       49
       -
         "sequence", `Quick, test_scanner_sequence;

     

       50
       50
       -
         "flow sequence", `Quick, test_scanner_flow;

     

       51
       51
       -
       ]

     

       56
       56
       +
       let scanner_tests =

     

       57
       57
       +
         [

     

       58
       58
       +
           ("simple mapping", `Quick, test_scanner_simple);

     

       59
       59
       +
           ("sequence", `Quick, test_scanner_sequence);

     

       60
       60
       +
           ("flow sequence", `Quick, test_scanner_flow);

     

       61
       61
       +
         ]

     

       52
       62
        
       

     

       53
       63
        
       (** Parser tests *)

     

       54
       64
        
       

     
···

       56
       66
        
         let parser = Parser.of_string "key: value" in

     

       57
       67
        
         let events = Parser.to_list parser in

     

       58
       68
        
         Alcotest.(check bool) "has events" true (List.length events > 0);

     

       59
       59
       -
         let has_stream_start = List.exists (fun (e : Event.spanned) ->

     

       60
       60
       -
           match e.event with Event.Stream_start _ -> true | _ -> false

     

       61
       61
       -
         ) events in

     

       69
       69
       +
         let has_stream_start =

     

       70
       70
       +
           List.exists

     

       71
       71
       +
             (fun (e : Event.spanned) ->

     

       72
       72
       +
               match e.event with Event.Stream_start _ -> true | _ -> false)

     

       73
       73
       +
             events

     

       74
       74
       +
         in

     

       62
       75
        
         Alcotest.(check bool) "has stream start" true has_stream_start

     

       63
       76
        
       

     

       64
       77
        
       let test_parser_sequence_events () =

     

       65
       78
        
         let parser = Parser.of_string "- a\n- b" in

     

       66
       79
        
         let events = Parser.to_list parser in

     

       67
       67
       -
         let has_seq_start = List.exists (fun (e : Event.spanned) ->

     

       68
       68
       -
           match e.event with Event.Sequence_start _ -> true | _ -> false

     

       69
       69
       -
         ) events in

     

       80
       80
       +
         let has_seq_start =

     

       81
       81
       +
           List.exists

     

       82
       82
       +
             (fun (e : Event.spanned) ->

     

       83
       83
       +
               match e.event with Event.Sequence_start _ -> true | _ -> false)

     

       84
       84
       +
             events

     

       85
       85
       +
         in

     

       70
       86
        
         Alcotest.(check bool) "has sequence start" true has_seq_start

     

       71
       87
        
       

     

       72
       72
       -
       let parser_tests = [

     

       73
       73
       -
         "parse events", `Quick, test_parser_events;

     

       74
       74
       -
         "sequence events", `Quick, test_parser_sequence_events;

     

       75
       75
       -
       ]

     

       88
       88
       +
       let parser_tests =

     

       89
       89
       +
         [

     

       90
       90
       +
           ("parse events", `Quick, test_parser_events);

     

       91
       91
       +
           ("sequence events", `Quick, test_parser_sequence_events);

     

       92
       92
       +
         ]

     

       76
       93
        
       

     

       77
       94
        
       (** Value parsing tests *)

     

       78
       95
        
       

     
···

       93
       110
        
         check_value "float" (`Float 3.14) (of_string "3.14")

     

       94
       111
        
       

     

       95
       112
        
       let test_parse_string () =

     

       96
       96
       -
         check_value "plain" (`String "hello") (of_string "hello world" |> function `String s -> `String (String.sub s 0 5) | v -> v);

     

       113
       113
       +
         check_value "plain" (`String "hello")

     

       114
       114
       +
           ( of_string "hello world" |> function

     

       115
       115
       +
             | `String s -> `String (String.sub s 0 5)

     

       116
       116
       +
             | v -> v );

     

       97
       117
        
         check_value "quoted" (`String "hello") (of_string {|"hello"|})

     

       98
       118
        
       

     

       99
       119
        
       let test_parse_sequence () =

     

       100
       120
        
         let result = of_string "- one\n- two\n- three" in

     

       101
       121
        
         match result with

     

       102
       102
       -
         | `A [_; _; _] -> ()

     

       122
       122
       +
         | `A [ _; _; _ ] -> ()

     

       103
       123
        
         | _ -> Alcotest.fail "expected sequence with 3 elements"

     

       104
       124
        
       

     

       105
       125
        
       let test_parse_mapping () =

     
···

       118
       138
        
       |} in

     

       119
       139
        
         let result = of_string yaml in

     

       120
       140
        
         match result with

     

       121
       121
       -
         | `O [("person", `O _)] -> ()

     

       141
       141
       +
         | `O [ ("person", `O _) ] -> ()

     

       122
       142
        
         | _ -> Alcotest.fail "expected nested structure"

     

       123
       143
        
       

     

       124
       144
        
       let test_parse_flow_sequence () =

     

       125
       145
        
         let result = of_string "[1, 2, 3]" in

     

       126
       146
        
         match result with

     

       127
       127
       -
         | `A [`Float 1.0; `Float 2.0; `Float 3.0] -> ()

     

       147
       147
       +
         | `A [ `Float 1.0; `Float 2.0; `Float 3.0 ] -> ()

     

       128
       148
        
         | _ -> Alcotest.fail "expected flow sequence [1, 2, 3]"

     

       129
       149
        
       

     

       130
       150
        
       let test_parse_flow_mapping () =

     

       131
       151
        
         let result = of_string "{a: 1, b: 2}" in

     

       132
       152
        
         match result with

     

       133
       133
       -
         | `O [("a", `Float 1.0); ("b", `Float 2.0)] -> ()

     

       153
       153
       +
         | `O [ ("a", `Float 1.0); ("b", `Float 2.0) ] -> ()

     

       134
       154
        
         | _ -> Alcotest.fail "expected flow mapping {a: 1, b: 2}"

     

       135
       155
        
       

     

       136
       156
        
       let test_parse_flow_mapping_trailing_comma () =

     

       137
       157
        
         let result = of_string "{ a: 1, }" in

     

       138
       158
        
         match result with

     

       139
       139
       -
         | `O [("a", `Float 1.0)] -> ()

     

       159
       159
       +
         | `O [ ("a", `Float 1.0) ] -> ()

     

       140
       160
        
         | `O pairs ->

     

       141
       141
       -
             Alcotest.failf "expected 1 pair but got %d pairs (trailing comma should not create empty entry)"

     

       161
       161
       +
             Alcotest.failf

     

       162
       162
       +
               "expected 1 pair but got %d pairs (trailing comma should not create \

     

       163
       163
       +
                empty entry)"

     

       142
       164
        
               (List.length pairs)

     

       143
       165
        
         | _ -> Alcotest.fail "expected flow mapping with 1 pair"

     

       144
       166
        
       

     

       145
       145
       -
       let value_tests = [

     

       146
       146
       -
         "parse null", `Quick, test_parse_null;

     

       147
       147
       -
         "parse bool", `Quick, test_parse_bool;

     

       148
       148
       -
         "parse number", `Quick, test_parse_number;

     

       149
       149
       -
         "parse string", `Quick, test_parse_string;

     

       150
       150
       -
         "parse sequence", `Quick, test_parse_sequence;

     

       151
       151
       -
         "parse mapping", `Quick, test_parse_mapping;

     

       152
       152
       -
         "parse nested", `Quick, test_parse_nested;

     

       153
       153
       -
         "parse flow sequence", `Quick, test_parse_flow_sequence;

     

       154
       154
       -
         "parse flow mapping", `Quick, test_parse_flow_mapping;

     

       155
       155
       -
         "flow mapping trailing comma", `Quick, test_parse_flow_mapping_trailing_comma;

     

       156
       156
       -
       ]

     

       167
       167
       +
       let value_tests =

     

       168
       168
       +
         [

     

       169
       169
       +
           ("parse null", `Quick, test_parse_null);

     

       170
       170
       +
           ("parse bool", `Quick, test_parse_bool);

     

       171
       171
       +
           ("parse number", `Quick, test_parse_number);

     

       172
       172
       +
           ("parse string", `Quick, test_parse_string);

     

       173
       173
       +
           ("parse sequence", `Quick, test_parse_sequence);

     

       174
       174
       +
           ("parse mapping", `Quick, test_parse_mapping);

     

       175
       175
       +
           ("parse nested", `Quick, test_parse_nested);

     

       176
       176
       +
           ("parse flow sequence", `Quick, test_parse_flow_sequence);

     

       177
       177
       +
           ("parse flow mapping", `Quick, test_parse_flow_mapping);

     

       178
       178
       +
           ( "flow mapping trailing comma",

     

       179
       179
       +
             `Quick,

     

       180
       180
       +
             test_parse_flow_mapping_trailing_comma );

     

       181
       181
       +
         ]

     

       157
       182
        
       

     

       158
       183
        
       (** Emitter tests *)

     

       159
       184
        
       

     
···

       162
       187
        
         Alcotest.(check bool) "contains null" true (String.length result > 0)

     

       163
       188
        
       

     

       164
       189
        
       let starts_with prefix s =

     

       165
       165
       -
         String.length s >= String.length prefix &&

     

       166
       166
       -
         String.sub s 0 (String.length prefix) = prefix

     

       190
       190
       +
         String.length s >= String.length prefix

     

       191
       191
       +
         && String.sub s 0 (String.length prefix) = prefix

     

       167
       192
        
       

     

       168
       193
        
       let test_emit_mapping () =

     

       169
       169
       -
         let value = `O [("name", `String "Alice"); ("age", `Float 30.0)] in

     

       194
       194
       +
         let value = `O [ ("name", `String "Alice"); ("age", `Float 30.0) ] in

     

       170
       195
        
         let result = to_string value in

     

       171
       196
        
         let trimmed = String.trim result in

     

       172
       172
       -
         Alcotest.(check bool) "contains name" true (starts_with "name" trimmed || starts_with "\"name\"" trimmed)

     

       197
       197
       +
         Alcotest.(check bool)

     

       198
       198
       +
           "contains name" true

     

       199
       199
       +
           (starts_with "name" trimmed || starts_with "\"name\"" trimmed)

     

       173
       200
        
       

     

       174
       201
        
       let test_roundtrip_simple () =

     

       175
       202
        
         let yaml = "name: Alice" in

     
···

       187
       214
        
             ()

     

       188
       215
        
         | _ -> Alcotest.fail "roundtrip failed"

     

       189
       216
        
       

     

       190
       190
       -
       let emitter_tests = [

     

       191
       191
       -
         "emit null", `Quick, test_emit_null;

     

       192
       192
       -
         "emit mapping", `Quick, test_emit_mapping;

     

       193
       193
       -
         "roundtrip simple", `Quick, test_roundtrip_simple;

     

       194
       194
       -
         "roundtrip sequence", `Quick, test_roundtrip_sequence;

     

       195
       195
       -
       ]

     

       217
       217
       +
       let emitter_tests =

     

       218
       218
       +
         [

     

       219
       219
       +
           ("emit null", `Quick, test_emit_null);

     

       220
       220
       +
           ("emit mapping", `Quick, test_emit_mapping);

     

       221
       221
       +
           ("roundtrip simple", `Quick, test_roundtrip_simple);

     

       222
       222
       +
           ("roundtrip sequence", `Quick, test_roundtrip_sequence);

     

       223
       223
       +
         ]

     

       196
       224
        
       

     

       197
       225
        
       (** YAML-specific tests *)

     

       198
       226
        
       

     
···

       204
       232
        
         | _ -> Alcotest.fail "expected scalar with anchor"

     

       205
       233
        
       

     

       206
       234
        
       let test_yaml_alias () =

     

       207
       207
       -
         let yaml = {|

     

       235
       235
       +
         let yaml =

     

       236
       236
       +
           {|

     

       208
       237
        
       defaults: &defaults

     

       209
       238
        
         timeout: 30

     

       210
       239
        
       production:

     

       211
       240
        
         <<: *defaults

     

       212
       241
        
         port: 8080

     

       213
       213
       -
       |} in

     

       242
       242
       +
       |}

     

       243
       243
       +
         in

     

       214
       244
        
         (* Just check it parses without error *)

     

       215
       245
        
         let _ = yaml_of_string yaml in

     

       216
       246
        
         ()

     

       217
       247
        
       

     

       218
       218
       -
       let yaml_tests = [

     

       219
       219
       -
         "yaml anchor", `Quick, test_yaml_anchor;

     

       220
       220
       -
         "yaml alias", `Quick, test_yaml_alias;

     

       221
       221
       -
       ]

     

       248
       248
       +
       let yaml_tests =

     

       249
       249
       +
         [

     

       250
       250
       +
           ("yaml anchor", `Quick, test_yaml_anchor);

     

       251
       251
       +
           ("yaml alias", `Quick, test_yaml_alias);

     

       252
       252
       +
         ]

     

       222
       253
        
       

     

       223
       254
        
       (** Multiline scalar tests *)

     

       224
       255
        
       

     
···

       230
       261
        
       |} in

     

       231
       262
        
         let result = of_string yaml in

     

       232
       263
        
         match result with

     

       233
       233
       -
         | `O [("description", `String _)] -> ()

     

       264
       264
       +
         | `O [ ("description", `String _) ] -> ()

     

       234
       265
        
         | _ -> Alcotest.fail "expected mapping with literal block"

     

       235
       266
        
       

     

       236
       267
        
       let test_folded_block () =

     
···

       241
       272
        
       |} in

     

       242
       273
        
         let result = of_string yaml in

     

       243
       274
        
         match result with

     

       244
       244
       -
         | `O [("description", `String _)] -> ()

     

       275
       275
       +
         | `O [ ("description", `String _) ] -> ()

     

       245
       276
        
         | _ -> Alcotest.fail "expected mapping with folded block"

     

       246
       277
        
       

     

       247
       247
       -
       let multiline_tests = [

     

       248
       248
       -
         "literal block", `Quick, test_literal_block;

     

       249
       249
       -
         "folded block", `Quick, test_folded_block;

     

       250
       250
       -
       ]

     

       278
       278
       +
       let multiline_tests =

     

       279
       279
       +
         [

     

       280
       280
       +
           ("literal block", `Quick, test_literal_block);

     

       281
       281
       +
           ("folded block", `Quick, test_folded_block);

     

       282
       282
       +
         ]

     

       251
       283
        
       

     

       252
       284
        
       (** Error handling tests *)

     

       253
       285
        
       

     
···

       255
       287
        
         try

     

       256
       288
        
           let _ = of_string "key: [unclosed" in

     

       257
       289
        
           Alcotest.fail "expected error"

     

       258
       258
       -
         with

     

       259
       259
       -
         | Yamlrw_error e ->

     

       260
       260
       -
             Alcotest.(check bool) "has span" true (e.span <> None)

     

       290
       290
       +
         with Yamlrw_error e -> Alcotest.(check bool) "has span" true (e.span <> None)

     

       261
       291
        
       

     

       262
       262
       -
       let error_tests = [

     

       263
       263
       -
         "error position", `Quick, test_error_position;

     

       264
       264
       -
       ]

     

       292
       292
       +
       let error_tests = [ ("error position", `Quick, test_error_position) ]

     

       265
       293
        
       

     

       266
       294
        
       (** Alias expansion limit tests (billion laughs protection) *)

     

       267
       295
        
       

     

       268
       296
        
       let test_node_limit () =

     

       269
       297
        
         (* Small bomb that would expand to 9^4 = 6561 nodes *)

     

       270
       270
       -
         let yaml = {|

     

       298
       298
       +
         let yaml =

     

       299
       299
       +
           {|

     

       271
       300
        
       a: &a [1,2,3,4,5,6,7,8,9]

     

       272
       301
        
       b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]

     

       273
       302
        
       c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]

     

       274
       303
        
       d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]

     

       275
       275
       -
       |} in

     

       304
       304
       +
       |}

     

       305
       305
       +
         in

     

       276
       306
        
         (* Should fail with a small node limit *)

     

       277
       307
        
         try

     

       278
       308
        
           let _ = of_string ~max_nodes:100 yaml in

     

       279
       309
        
           Alcotest.fail "expected node limit error"

     

       280
       280
       -
         with

     

       281
       281
       -
         | Yamlrw_error e ->

     

       282
       282
       -
             (match e.Error.kind with

     

       283
       283
       -
              | Error.Alias_expansion_node_limit _ -> ()

     

       284
       284
       -
              | _ -> Alcotest.fail "expected Alias_expansion_node_limit error")

     

       310
       310
       +
         with Yamlrw_error e -> (

     

       311
       311
       +
           match e.Error.kind with

     

       312
       312
       +
           | Error.Alias_expansion_node_limit _ -> ()

     

       313
       313
       +
           | _ -> Alcotest.fail "expected Alias_expansion_node_limit error")

     

       285
       314
        
       

     

       286
       315
        
       let test_depth_limit () =

     

       287
       316
        
         (* Create deeply nested alias chain:

     

       288
       317
        
            *e -> [*d,*d] -> [*c,*c] -> [*b,*b] -> [*a,*a] -> [x,y,z]

     

       289
       318
        
            Each alias resolution increases depth by 1 *)

     

       290
       290
       -
         let yaml = {|

     

       319
       319
       +
         let yaml =

     

       320
       320
       +
           {|

     

       291
       321
        
       a: &a [x, y, z]

     

       292
       322
        
       b: &b [*a, *a]

     

       293
       323
        
       c: &c [*b, *b]

     

       294
       324
        
       d: &d [*c, *c]

     

       295
       325
        
       e: &e [*d, *d]

     

       296
       326
        
       result: *e

     

       297
       297
       -
       |} in

     

       327
       327
       +
       |}

     

       328
       328
       +
         in

     

       298
       329
        
         (* Should fail with a small depth limit (depth 3 means max 3 alias hops) *)

     

       299
       330
        
         try

     

       300
       331
        
           let _ = of_string ~max_depth:3 yaml in

     

       301
       332
        
           Alcotest.fail "expected depth limit error"

     

       302
       302
       -
         with

     

       303
       303
       -
         | Yamlrw_error e ->

     

       304
       304
       -
             (match e.Error.kind with

     

       305
       305
       -
              | Error.Alias_expansion_depth_limit _ -> ()

     

       306
       306
       -
              | _ -> Alcotest.fail ("expected Alias_expansion_depth_limit error, got: " ^ Error.kind_to_string e.Error.kind))

     

       333
       333
       +
         with Yamlrw_error e -> (

     

       334
       334
       +
           match e.Error.kind with

     

       335
       335
       +
           | Error.Alias_expansion_depth_limit _ -> ()

     

       336
       336
       +
           | _ ->

     

       337
       337
       +
               Alcotest.fail

     

       338
       338
       +
                 ("expected Alias_expansion_depth_limit error, got: "

     

       339
       339
       +
                 ^ Error.kind_to_string e.Error.kind))

     

       307
       340
        
       

     

       308
       341
        
       let test_normal_aliases_work () =

     

       309
       342
        
         (* Normal alias usage should work fine *)

     

       310
       310
       -
         let yaml = {|

     

       343
       343
       +
         let yaml =

     

       344
       344
       +
           {|

     

       311
       345
        
       defaults: &defaults

     

       312
       346
        
         timeout: 30

     

       313
       347
        
         retries: 3

     

       314
       348
        
       production:

     

       315
       349
        
         <<: *defaults

     

       316
       350
        
         port: 8080

     

       317
       317
       -
       |} in

     

       351
       351
       +
       |}

     

       352
       352
       +
         in

     

       318
       353
        
         let result = of_string yaml in

     

       319
       319
       -
         match result with

     

       320
       320
       -
         | `O _ -> ()

     

       321
       321
       -
         | _ -> Alcotest.fail "expected mapping"

     

       354
       354
       +
         match result with `O _ -> () | _ -> Alcotest.fail "expected mapping"

     

       322
       355
        
       

     

       323
       356
        
       let test_resolve_aliases_false () =

     

       324
       357
        
         (* With resolve_aliases=false, aliases should remain unresolved *)

     
···

       329
       362
        
         let result = yaml_of_string ~resolve_aliases:false yaml in

     

       330
       363
        
         (* Check that alias is preserved *)

     

       331
       364
        
         match result with

     

       332
       332
       -
         | `O map ->

     

       365
       365
       +
         | `O map -> (

     

       333
       366
        
             let pairs = Mapping.members map in

     

       334
       334
       -
             (match List.assoc_opt (`Scalar (Scalar.make "b")) pairs with

     

       335
       335
       -
              | Some (`Alias "anchor") -> ()

     

       336
       336
       -
              | _ -> Alcotest.fail "expected alias to be preserved")

     

       367
       367
       +
             match List.assoc_opt (`Scalar (Scalar.make "b")) pairs with

     

       368
       368
       +
             | Some (`Alias "anchor") -> ()

     

       369
       369
       +
             | _ -> Alcotest.fail "expected alias to be preserved")

     

       337
       370
        
         | _ -> Alcotest.fail "expected mapping"

     

       338
       371
        
       

     

       339
       339
       -
       let alias_limit_tests = [

     

       340
       340
       -
         "node limit", `Quick, test_node_limit;

     

       341
       341
       -
         "depth limit", `Quick, test_depth_limit;

     

       342
       342
       -
         "normal aliases work", `Quick, test_normal_aliases_work;

     

       343
       343
       -
         "resolve_aliases false", `Quick, test_resolve_aliases_false;

     

       372
       372
       +
       let alias_limit_tests =

     

       373
       373
       +
         [

     

       374
       374
       +
           ("node limit", `Quick, test_node_limit);

     

       375
       375
       +
           ("depth limit", `Quick, test_depth_limit);

     

       376
       376
       +
           ("normal aliases work", `Quick, test_normal_aliases_work);

     

       377
       377
       +
           ("resolve_aliases false", `Quick, test_resolve_aliases_false);

     

       378
       378
       +
         ]

     

       379
       379
       +
       

     

       380
       380
       +
       (** Bug fix regression tests

     

       381
       381
       +
           These tests verify that issues fixed in ocaml-yaml don't occur in ocaml-yamlrw *)

     

       382
       382
       +
       

     

       383
       383
       +
       (* Test for roundtrip of special string values (ocaml-yaml fix 225387d)

     

       384
       384
       +
          Strings like "true", "1.0", "null" etc. must be quoted on output so that

     

       385
       385
       +
          they round-trip correctly as strings, not as booleans/numbers/null *)

     

       386
       386
       +
       let test_roundtrip_string_true () =

     

       387
       387
       +
         let original = `String "true" in

     

       388
       388
       +
         let emitted = to_string original in

     

       389
       389
       +
         let parsed = of_string emitted in

     

       390
       390
       +
         check_value "String 'true' roundtrips" original parsed

     

       391
       391
       +
       

     

       392
       392
       +
       let test_roundtrip_string_false () =

     

       393
       393
       +
         let original = `String "false" in

     

       394
       394
       +
         let emitted = to_string original in

     

       395
       395
       +
         let parsed = of_string emitted in

     

       396
       396
       +
         check_value "String 'false' roundtrips" original parsed

     

       397
       397
       +
       

     

       398
       398
       +
       let test_roundtrip_string_null () =

     

       399
       399
       +
         let original = `String "null" in

     

       400
       400
       +
         let emitted = to_string original in

     

       401
       401
       +
         let parsed = of_string emitted in

     

       402
       402
       +
         check_value "String 'null' roundtrips" original parsed

     

       403
       403
       +
       

     

       404
       404
       +
       let test_roundtrip_string_number () =

     

       405
       405
       +
         let original = `String "1.0" in

     

       406
       406
       +
         let emitted = to_string original in

     

       407
       407
       +
         let parsed = of_string emitted in

     

       408
       408
       +
         check_value "String '1.0' roundtrips" original parsed

     

       409
       409
       +
       

     

       410
       410
       +
       let test_roundtrip_string_integer () =

     

       411
       411
       +
         let original = `String "42" in

     

       412
       412
       +
         let emitted = to_string original in

     

       413
       413
       +
         let parsed = of_string emitted in

     

       414
       414
       +
         check_value "String '42' roundtrips" original parsed

     

       415
       415
       +
       

     

       416
       416
       +
       let test_roundtrip_string_yes () =

     

       417
       417
       +
         let original = `String "yes" in

     

       418
       418
       +
         let emitted = to_string original in

     

       419
       419
       +
         let parsed = of_string emitted in

     

       420
       420
       +
         check_value "String 'yes' roundtrips" original parsed

     

       421
       421
       +
       

     

       422
       422
       +
       let test_roundtrip_string_no () =

     

       423
       423
       +
         let original = `String "no" in

     

       424
       424
       +
         let emitted = to_string original in

     

       425
       425
       +
         let parsed = of_string emitted in

     

       426
       426
       +
         check_value "String 'no' roundtrips" original parsed

     

       427
       427
       +
       

     

       428
       428
       +
       (* Test for integer display without decimal point (ocaml-yaml fix 999b1aa)

     

       429
       429
       +
          Float values that are integers should be emitted as "42" not "42." or "42.0" *)

     

       430
       430
       +
       let test_emit_integer_float () =

     

       431
       431
       +
         let value = `Float 42.0 in

     

       432
       432
       +
         let result = to_string value in

     

       433
       433
       +
         (* Check the result doesn't contain "42." or "42.0" *)

     

       434
       434
       +
         Alcotest.(check bool) "no trailing dot"

     

       435
       435
       +
           true (not (String.length result >= 3 &&

     

       436
       436
       +
                      result.[0] = '4' && result.[1] = '2' && result.[2] = '.'))

     

       437
       437
       +
       

     

       438
       438
       +
       let test_emit_negative_integer_float () =

     

       439
       439
       +
         let value = `Float (-17.0) in

     

       440
       440
       +
         let result = to_string value in

     

       441
       441
       +
         let parsed = of_string result in

     

       442
       442
       +
         check_value "negative integer float roundtrips" value parsed

     

       443
       443
       +
       

     

       444
       444
       +
       (* Test for special YAML floats: .nan, .inf, -.inf *)

     

       445
       445
       +
       let test_parse_special_floats () =

     

       446
       446
       +
         let inf_result = of_string ".inf" in

     

       447
       447
       +
         (match inf_result with

     

       448
       448
       +
          | `Float f when Float.is_infinite f && f > 0.0 -> ()

     

       449
       449
       +
          | _ -> Alcotest.fail "expected positive infinity");

     

       450
       450
       +
         let neg_inf_result = of_string "-.inf" in

     

       451
       451
       +
         (match neg_inf_result with

     

       452
       452
       +
          | `Float f when Float.is_infinite f && f < 0.0 -> ()

     

       453
       453
       +
          | _ -> Alcotest.fail "expected negative infinity");

     

       454
       454
       +
         let nan_result = of_string ".nan" in

     

       455
       455
       +
         (match nan_result with

     

       456
       456
       +
          | `Float f when Float.is_nan f -> ()

     

       457
       457
       +
          | _ -> Alcotest.fail "expected NaN")

     

       458
       458
       +
       

     

       459
       459
       +
       (* Test that bare "inf", "nan", "infinity" are NOT parsed as floats

     

       460
       460
       +
          (ocaml-yaml issue - OCaml's Float.of_string accepts these but YAML doesn't) *)

     

       461
       461
       +
       let test_bare_inf_nan_are_strings () =

     

       462
       462
       +
         let inf_result = of_string "inf" in

     

       463
       463
       +
         (match inf_result with

     

       464
       464
       +
          | `String "inf" -> ()

     

       465
       465
       +
          | `Float _ -> Alcotest.fail "'inf' should be string, not float"

     

       466
       466
       +
          | _ -> Alcotest.fail "expected string 'inf'");

     

       467
       467
       +
         let nan_result = of_string "nan" in

     

       468
       468
       +
         (match nan_result with

     

       469
       469
       +
          | `String "nan" -> ()

     

       470
       470
       +
          | `Float _ -> Alcotest.fail "'nan' should be string, not float"

     

       471
       471
       +
          | _ -> Alcotest.fail "expected string 'nan'");

     

       472
       472
       +
         let infinity_result = of_string "infinity" in

     

       473
       473
       +
         (match infinity_result with

     

       474
       474
       +
          | `String "infinity" -> ()

     

       475
       475
       +
          | `Float _ -> Alcotest.fail "'infinity' should be string, not float"

     

       476
       476
       +
          | _ -> Alcotest.fail "expected string 'infinity'")

     

       477
       477
       +
       

     

       478
       478
       +
       (* Test for quoted scalar preservation *)

     

       479
       479
       +
       let test_quoted_scalar_preserved () =

     

       480
       480
       +
         (* When a scalar is quoted, it should be preserved as a string even if

     

       481
       481
       +
            it looks like a number/boolean *)

     

       482
       482
       +
         check_value "double-quoted true is string"

     

       483
       483
       +
           (`String "true") (of_string {|"true"|});

     

       484
       484
       +
         check_value "single-quoted 42 is string"

     

       485
       485
       +
           (`String "42") (of_string "'42'");

     

       486
       486
       +
         check_value "double-quoted null is string"

     

       487
       487
       +
           (`String "null") (of_string {|"null"|})

     

       488
       488
       +
       

     

       489
       489
       +
       (* Test complex roundtrip with mixed types *)

     

       490
       490
       +
       let test_complex_roundtrip () =

     

       491
       491
       +
         let original = `O [

     

       492
       492
       +
           ("string_true", `String "true");

     

       493
       493
       +
           ("bool_true", `Bool true);

     

       494
       494
       +
           ("string_42", `String "42");

     

       495
       495
       +
           ("int_42", `Float 42.0);

     

       496
       496
       +
           ("string_null", `String "null");

     

       497
       497
       +
           ("actual_null", `Null);

     

       498
       498
       +
         ] in

     

       499
       499
       +
         let emitted = to_string original in

     

       500
       500
       +
         let parsed = of_string emitted in

     

       501
       501
       +
         check_value "complex roundtrip preserves types" original parsed

     

       502
       502
       +
       

     

       503
       503
       +
       let bugfix_regression_tests = [

     

       504
       504
       +
         "roundtrip string 'true'", `Quick, test_roundtrip_string_true;

     

       505
       505
       +
         "roundtrip string 'false'", `Quick, test_roundtrip_string_false;

     

       506
       506
       +
         "roundtrip string 'null'", `Quick, test_roundtrip_string_null;

     

       507
       507
       +
         "roundtrip string '1.0'", `Quick, test_roundtrip_string_number;

     

       508
       508
       +
         "roundtrip string '42'", `Quick, test_roundtrip_string_integer;

     

       509
       509
       +
         "roundtrip string 'yes'", `Quick, test_roundtrip_string_yes;

     

       510
       510
       +
         "roundtrip string 'no'", `Quick, test_roundtrip_string_no;

     

       511
       511
       +
         "emit integer float without decimal", `Quick, test_emit_integer_float;

     

       512
       512
       +
         "emit negative integer float", `Quick, test_emit_negative_integer_float;

     

       513
       513
       +
         "parse special floats (.inf, -.inf, .nan)", `Quick, test_parse_special_floats;

     

       514
       514
       +
         "bare inf/nan/infinity are strings", `Quick, test_bare_inf_nan_are_strings;

     

       515
       515
       +
         "quoted scalars preserved as strings", `Quick, test_quoted_scalar_preserved;

     

       516
       516
       +
         "complex roundtrip preserves types", `Quick, test_complex_roundtrip;

     

       344
       517
        
       ]

     

       345
       518
        
       

     

       346
       519
        
       (** Run all tests *)

     

       347
       520
        
       

     

       348
       521
        
       let () =

     

       349
       349
       -
         Alcotest.run "yamlrw" [

     

       350
       350
       -
           "scanner", scanner_tests;

     

       351
       351
       -
           "parser", parser_tests;

     

       352
       352
       -
           "value", value_tests;

     

       353
       353
       -
           "emitter", emitter_tests;

     

       354
       354
       -
           "yaml", yaml_tests;

     

       355
       355
       -
           "multiline", multiline_tests;

     

       356
       356
       -
           "errors", error_tests;

     

       357
       357
       -
           "alias_limits", alias_limit_tests;

     

       358
       358
       -
         ]

     

       522
       522
       +
         Alcotest.run "yamlrw"

     

       523
       523
       +
           [

     

       524
       524
       +
             ("scanner", scanner_tests);

     

       525
       525
       +
             ("parser", parser_tests);

     

       526
       526
       +
             ("value", value_tests);

     

       527
       527
       +
             ("emitter", emitter_tests);

     

       528
       528
       +
             ("yaml", yaml_tests);

     

       529
       529
       +
             ("multiline", multiline_tests);

     

       530
       530
       +
             ("errors", error_tests);

     

       531
       531
       +
             ("alias_limits", alias_limit_tests);

     

       532
       532
       +
             ("bugfix_regression", bugfix_regression_tests);

     

       533
       533
       +
           ]

yamlrw-eio.opam

···

       14
       14
        
         "yamlrw"

     

       15
       15
        
         "bytesrw-eio"

     

       16
       16
        
         "eio" {>= "1.1"}

     

       17
       17
       +
         "eio_main" {with-test}

     

       17
       18
        
         "odoc" {with-doc}

     

       18
       19
        
       ]

     

       19
       20
        
       build: [

yamlrw.opam

···

       14
       14
        
         "bytesrw"

     

       15
       15
        
         "cmdliner"

     

       16
       16
        
         "odoc" {with-doc}

     

       17
       17
       +
         "jsonm" {with-test}

     

       17
       18
        
         "alcotest" {with-test}

     

       18
       19
        
       ]

     

       19
       20
        
       build: [

Compare changes