commit d8a8639da53928fa13b78411bad6127456f50a15 · anil.recoil.org/ocaml-yamlrw

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

+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

+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

+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 ( = ) a.version b.version &&

     

       56
       56
       -
         List.equal ( = ) 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

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

+209 -211

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
       -
                    if t.need_separator then begin

     

       291
       291
       -
                      (* We just finished a nested structure (array/mapping),

     

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

     

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

     

       293
       293
       -
                      write t ", ";

     

       294
       294
       -
                      write_anchor t anchor;

     

       295
       295
       -
                      write_tag t ~implicit:plain_implicit tag;

     

       296
       296
       -
                      write_scalar t ~style value;

     

       297
       297
       -
                      write t ": ";

     

       298
       298
       -
                      t.need_separator <- false;

     

       299
       299
       -
                      t.state <- In_flow_mapping_value

     

       300
       300
       -
                    end else begin

     

       301
       301
       -
                      (* Normal value scalar *)

     

       302
       302
       -
                      write_anchor t anchor;

     

       303
       303
       -
                      write_tag t ~implicit:plain_implicit tag;

     

       304
       304
       -
                      write_scalar t ~style value;

     

       305
       305
       -
                      t.need_separator <- true;

     

       306
       306
       -
                      t.state <- In_flow_mapping_key

     

       307
       307
       -
                    end

     

       308
       308
       -
                | _ ->

     

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

     

       310
       310
       -
                    t.need_separator <- true;

     

       311
       311
       -
                    write_anchor t anchor;

     

       312
       312
       -
                    write_tag t ~implicit:plain_implicit tag;

     

       313
       313
       -
                    write_scalar t ~style value)

     

       314
       314
       -
             end else begin

     

       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

     

       315
       310
        
               match t.state with

     

       316
       311
        
               | In_block_sequence _ ->

     

       317
       312
        
                   write_indent t;

     
···

       347
       342
        
                   write_scalar t ~style value;

     

       348
       343
        
                   write_newline t

     

       349
       344
        
             end

     

       350
       350
       -
       

     

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

     

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

     

       353
       347
        
             if t.flow_level > 0 then begin

     

       354
       354
       -
               (match t.state with

     

       355
       355
       -
                | In_flow_mapping_key ->

     

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

     

       357
       357
       -
                    write_anchor t anchor;

     

       358
       358
       -
                    write_tag t ~implicit tag;

     

       359
       359
       -
                    write_char t '[';

     

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

     

       361
       361
       -
                    t.need_separator <- false;

     

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

     

       363
       363
       -
                    t.state <- In_flow_sequence

     

       364
       364
       -
                | In_flow_mapping_value ->

     

       365
       365
       -
                    write_anchor t anchor;

     

       366
       366
       -
                    write_tag t ~implicit tag;

     

       367
       367
       -
                    write_char t '[';

     

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

     

       369
       369
       -
                    t.need_separator <- false;

     

       370
       370
       -
                    push_state t In_flow_mapping_key;

     

       371
       371
       -
                    t.state <- In_flow_sequence

     

       372
       372
       -
                | _ ->

     

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

     

       374
       374
       -
                    write_anchor t anchor;

     

       375
       375
       -
                    write_tag t ~implicit tag;

     

       376
       376
       -
                    write_char t '[';

     

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

     

       378
       378
       -
                    t.need_separator <- false;

     

       379
       379
       -
                    push_state t In_flow_sequence)

     

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

     

       381
       377
        
               match t.state with

     

       382
       378
        
               | In_block_sequence _ ->

     

       383
       379
        
                   write_indent t;

     
···

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

     

       390
       386
        
                     t.need_separator <- false;

     

       391
       387
        
                     push_state t In_flow_sequence

     

       392
       392
       -
                   end else begin

     

       388
       388
       +
                   end

     

       389
       389
       +
                   else begin

     

       393
       390
        
                     write_newline t;

     

       394
       391
        
                     push_state t (In_block_sequence t.indent);

     

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

     
···

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

     

       424
       421
        
                     t.state <- In_block_mapping_key indent;

     

       425
       422
        
                     push_state t In_flow_sequence

     

       426
       426
       -
                   end else begin

     

       423
       423
       +
                   end

     

       424
       424
       +
                   else begin

     

       427
       425
        
                     write_newline t;

     

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

     

       429
       427
        
                     t.state <- In_block_mapping_key indent;

     
···

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

     

       439
       437
        
                     t.need_separator <- false;

     

       440
       438
        
                     push_state t In_flow_sequence

     

       441
       441
       -
                   end else begin

     

       439
       439
       +
                   end

     

       440
       440
       +
                   else begin

     

       442
       441
        
                     push_state t (In_block_sequence t.indent);

     

       443
       442
        
                     t.state <- In_block_sequence t.indent

     

       444
       443
        
                   end

     

       445
       444
        
             end

     

       446
       446
       -
       

     

       447
       445
        
         | Event.Sequence_end ->

     

       448
       446
        
             if t.flow_level > 0 then begin

     

       449
       447
        
               write_char t ']';

     
···

       451
       449
        
               t.need_separator <- true;

     

       452
       450
        
               pop_state t;

     

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

     

       454
       454
       -
               (match t.state with

     

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

     

       456
       456
       -
                | _ -> ())

     

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

     

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

     

       459
       458
        
               pop_state t

     

       460
       459
        
             end

     

       461
       461
       -
       

     

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

     

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

     

       464
       462
        
             if t.flow_level > 0 then begin

     

       465
       465
       -
               (match t.state with

     

       466
       466
       -
                | In_flow_mapping_key ->

     

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

     

       468
       468
       -
                    write_anchor t anchor;

     

       469
       469
       -
                    write_tag t ~implicit tag;

     

       470
       470
       -
                    write_char t '{';

     

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

     

       472
       472
       -
                    t.need_separator <- false;

     

       473
       473
       -
                    push_state t In_flow_mapping_value;

     

       474
       474
       -
                    t.state <- In_flow_mapping_key

     

       475
       475
       -
                | In_flow_mapping_value ->

     

       476
       476
       -
                    write_anchor t anchor;

     

       477
       477
       -
                    write_tag t ~implicit tag;

     

       478
       478
       -
                    write_char t '{';

     

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

     

       480
       480
       -
                    t.need_separator <- false;

     

       481
       481
       -
                    push_state t In_flow_mapping_key;

     

       482
       482
       -
                    t.state <- In_flow_mapping_key

     

       483
       483
       -
                | _ ->

     

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

     

       485
       485
       -
                    write_anchor t anchor;

     

       486
       486
       -
                    write_tag t ~implicit tag;

     

       487
       487
       -
                    write_char t '{';

     

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

     

       489
       489
       -
                    t.need_separator <- false;

     

       490
       490
       -
                    push_state t In_flow_mapping_key)

     

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

     

       492
       491
        
               match t.state with

     

       493
       492
        
               | In_block_sequence _ ->

     

       494
       493
        
                   write_indent t;

     
···

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

     

       501
       500
        
                     t.need_separator <- false;

     

       502
       501
        
                     push_state t In_flow_mapping_key

     

       503
       503
       -
                   end else begin

     

       502
       502
       +
                   end

     

       503
       503
       +
                   else begin

     

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

     

       505
       505
        
                     push_state t (In_block_sequence t.indent);

     

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

     
···

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

     

       536
       536
        
                     t.state <- In_block_mapping_key indent;

     

       537
       537
        
                     push_state t In_flow_mapping_key

     

       538
       538
       -
                   end else begin

     

       538
       538
       +
                   end

     

       539
       539
       +
                   else begin

     

       539
       540
        
                     write_newline t;

     

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

     

       541
       542
        
                     t.state <- In_block_mapping_key indent;

     
···

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

     

       551
       552
        
                     t.need_separator <- false;

     

       552
       553
        
                     push_state t In_flow_mapping_key

     

       553
       553
       -
                   end else begin

     

       554
       554
       +
                   end

     

       555
       555
       +
                   else begin

     

       554
       556
        
                     push_state t (In_block_mapping_key t.indent);

     

       555
       557
        
                     t.state <- In_block_mapping_key t.indent

     

       556
       558
        
                   end

     

       557
       559
        
             end

     

       558
       558
       -
       

     

       559
       560
        
         | Event.Mapping_end ->

     

       560
       561
        
             if t.flow_level > 0 then begin

     

       561
       562
        
               write_char t '}';

     
···

       563
       564
        
               t.need_separator <- true;

     

       564
       565
        
               pop_state t;

     

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

     

       566
       566
       -
               (match t.state with

     

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

     

       568
       568
       -
                | _ -> ())

     

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

     

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

     

       571
       573
        
               pop_state t

     

       572
       574
        
             end

     

       573
       575
        
       

     

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

     

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

     

       576
       578
        
       let buffer t =

     

       577
       577
       -
         match t.sink with

     

       578
       578
       -
         | Buffer_sink buf -> Some buf

     

       579
       579
       -
         | Writer_sink _ -> None

     

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

     

       580
       580
        
       

     

       581
       581
        
       (** Get config *)

     

       582
       582
        
       let config t = t.config

     

       583
       583
        
       

     

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

     

       585
       585
        
       let is_streaming t =

     

       586
       586
       -
         match t.sink with

     

       587
       587
       -
         | Writer_sink _ -> true

     

       588
       588
       -
         | Buffer_sink _ -> false

     

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

     

       589
       587
        
       

     

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

     

       591
       589
        
       let flush t =

+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

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

+10 -18

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 }

     

       44
       38
        
       

     

       45
       39
        
       let pp_opt_str = Option.value ~default:"none"

     

       46
       40
        
       

     

       47
       41
        
       let pp fmt = function

     

       48
       42
        
         | Stream_start { encoding } ->

     

       49
       43
        
             Format.fprintf fmt "stream-start(%a)" Encoding.pp encoding

     

       50
       50
       -
         | Stream_end ->

     

       51
       51
       -
             Format.fprintf fmt "stream-end"

     

       44
       44
       +
         | Stream_end -> Format.fprintf fmt "stream-end"

     

       52
       45
        
         | Document_start { version; implicit } ->

     

       53
       53
       -
             let version_str = match version with

     

       46
       46
       +
             let version_str =

     

       47
       47
       +
               match version with

     

       54
       48
        
               | None -> "none"

     

       55
       49
        
               | Some (maj, min) -> Printf.sprintf "%d.%d" maj min

     

       56
       50
        
             in

     

       57
       57
       -
             Format.fprintf fmt "document-start(version=%s, implicit=%b)" version_str implicit

     

       51
       51
       +
             Format.fprintf fmt "document-start(version=%s, implicit=%b)" version_str

     

       52
       52
       +
               implicit

     

       58
       53
        
         | Document_end { implicit } ->

     

       59
       54
        
             Format.fprintf fmt "document-end(implicit=%b)" implicit

     

       60
       60
       -
         | Alias { anchor } ->

     

       61
       61
       -
             Format.fprintf fmt "alias(%s)" anchor

     

       55
       55
       +
         | Alias { anchor } -> Format.fprintf fmt "alias(%s)" anchor

     

       62
       56
        
         | Scalar { anchor; tag; value; style; _ } ->

     

       63
       57
        
             Format.fprintf fmt "scalar(anchor=%s, tag=%s, style=%a, value=%S)"

     

       64
       58
        
               (pp_opt_str anchor) (pp_opt_str tag) Scalar_style.pp style value

     

       65
       59
        
         | Sequence_start { anchor; tag; implicit; style } ->

     

       66
       60
        
             Format.fprintf fmt "sequence-start(anchor=%s, tag=%s, implicit=%b, style=%a)"

     

       67
       61
        
               (pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style

     

       68
       68
       -
         | Sequence_end ->

     

       69
       69
       -
             Format.fprintf fmt "sequence-end"

     

       62
       62
       +
         | Sequence_end -> Format.fprintf fmt "sequence-end"

     

       70
       63
        
         | Mapping_start { anchor; tag; implicit; style } ->

     

       71
       64
        
             Format.fprintf fmt "mapping-start(anchor=%s, tag=%s, implicit=%b, style=%a)"

     

       72
       65
        
               (pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style

     

       73
       73
       -
         | Mapping_end ->

     

       74
       74
       -
             Format.fprintf fmt "mapping-end"

     

       66
       66
       +
         | Mapping_end -> Format.fprintf fmt "mapping-end"

     

       75
       67
        
       

     

       76
       68
        
       let pp_spanned fmt { event; span } =

     

       77
       69
        
         Format.fprintf fmt "%a at %a" pp event Span.pp span

+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

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

+138 -162

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

     

       121
       121
       -
       

     

       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)

     

       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)

     

       134
       123
        
       

     

       135
       124
        
       (** Internal: parse all documents from a parser *)

     

       136
       125
        
       let parse_all_documents parser =

     
···

       149
       138
        
       

     

       150
       139
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       151
       140
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       152
       152
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       153
       153
       -
       *)

     

       154
       154
       -
       let value_of_string

     

       155
       155
       -
           ?(resolve_aliases = true)

     

       141
       141
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       142
       142
       +
       let value_of_string ?(resolve_aliases = true)

     

       156
       143
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       157
       157
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       158
       158
       -
           s =

     

       144
       144
       +
           ?(max_depth = Yaml.default_max_alias_depth) s =

     

       159
       145
        
         let docs = parse_all_documents (Parser.of_string s) in

     

       160
       146
        
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       161
       147
        
         match Document.root doc with

     

       162
       148
        
         | None -> `Null

     

       163
       149
        
         | Some yaml ->

     

       164
       164
       -
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

       150
       150
       +
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth

     

       151
       151
       +
               yaml

     

       165
       152
        
       

     

       166
       153
        
       (** Load single document as Yaml.

     

       167
       154
        
       

     

       168
       155
        
           @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)

     

       169
       156
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       170
       170
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       171
       171
       -
       *)

     

       172
       172
       -
       let yaml_of_string

     

       173
       173
       -
           ?(resolve_aliases = false)

     

       157
       157
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       158
       158
       +
       let yaml_of_string ?(resolve_aliases = false)

     

       174
       159
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       175
       175
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       176
       176
       -
           s =

     

       160
       160
       +
           ?(max_depth = Yaml.default_max_alias_depth) s =

     

       177
       161
        
         let docs = parse_all_documents (Parser.of_string s) in

     

       178
       162
        
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       179
       163
        
         match Document.root doc with

     

       180
       164
        
         | None -> `Scalar (Scalar.make "")

     

       181
       165
        
         | Some yaml ->

     

       182
       182
       -
             if resolve_aliases then

     

       183
       183
       -
               Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       184
       184
       -
             else

     

       185
       185
       -
               yaml

     

       166
       166
       +
             if resolve_aliases then Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       167
       167
       +
             else yaml

     

       186
       168
        
       

     

       187
       169
        
       (** Load all documents *)

     

       188
       170
        
       let documents_of_string s =

     
···

       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 =

     

       182
       182
       +
           ?(max_depth = Yaml.default_max_alias_depth) reader =

     

       204
       183
        
         let docs = parse_all_documents (Parser.of_reader reader) in

     

       205
       184
        
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       206
       185
        
         match Document.root doc with

     

       207
       186
        
         | None -> `Null

     

       208
       187
        
         | Some yaml ->

     

       209
       209
       -
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

       188
       188
       +
             Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth

     

       189
       189
       +
               yaml

     

       210
       190
        
       

     

       211
       191
        
       (** Load single document as Yaml from a Bytes.Reader.

     

       212
       192
        
       

     

       213
       193
        
           @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)

     

       214
       194
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       215
       215
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       216
       216
       -
       *)

     

       217
       217
       -
       let yaml_of_reader

     

       218
       218
       -
           ?(resolve_aliases = false)

     

       195
       195
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       196
       196
       +
       let yaml_of_reader ?(resolve_aliases = false)

     

       219
       197
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       220
       220
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       221
       221
       -
           reader =

     

       198
       198
       +
           ?(max_depth = Yaml.default_max_alias_depth) reader =

     

       222
       199
        
         let docs = parse_all_documents (Parser.of_reader reader) in

     

       223
       200
        
         let doc = single_document_or_error docs ~empty:(Document.make None) in

     

       224
       201
        
         match Document.root doc with

     

       225
       202
        
         | None -> `Scalar (Scalar.make "")

     

       226
       203
        
         | Some yaml ->

     

       227
       227
       -
             if resolve_aliases then

     

       228
       228
       -
               Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       229
       229
       -
             else

     

       230
       230
       -
               yaml

     

       204
       204
       +
             if resolve_aliases then Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       205
       205
       +
             else yaml

     

       231
       206
        
       

     

       232
       207
        
       (** Load all documents from a Bytes.Reader *)

     

       233
       208
        
       let documents_of_reader reader =

     
···

       245
       220
        
         let rec loop () =

     

       246
       221
        
           match next_event () with

     

       247
       222
        
           | None -> None

     

       248
       248
       -
           | Some ev ->

     

       223
       223
       +
           | Some ev -> (

     

       249
       224
        
               process_event state ev;

     

       250
       225
        
               match ev.event with

     

       251
       251
       -
               | Event.Document_end _ ->

     

       252
       252
       -
                   (match state.documents with

     

       253
       253
       -
                    | doc :: _ ->

     

       254
       254
       -
                        state.documents <- [];

     

       255
       255
       -
                        Some (extract doc)

     

       256
       256
       -
                    | [] -> 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)

     

       257
       232
        
               | Event.Stream_end -> None

     

       258
       258
       -
               | _ -> loop ()

     

       233
       233
       +
               | _ -> loop ())

     

       259
       234
        
         in

     

       260
       235
        
         loop ()

     

       261
       236
        
       

     
···

       267
       242
        
       

     

       268
       243
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       269
       244
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       270
       270
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       271
       271
       -
       *)

     

       272
       272
       -
       let load_value

     

       273
       273
       -
           ?(resolve_aliases = true)

     

       245
       245
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       246
       246
       +
       let load_value ?(resolve_aliases = true)

     

       274
       247
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       275
       275
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       276
       276
       -
           parser =

     

       277
       277
       -
         load_generic (fun doc ->

     

       278
       278
       -
           match Document.root doc with

     

       279
       279
       -
           | None -> `Null

     

       280
       280
       -
           | Some yaml ->

     

       281
       281
       -
               Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

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

     

       283
       257
        
       

     

       284
       258
        
       (** Load single Yaml from parser *)

     

       285
       259
        
       let load_yaml parser =

     

       286
       286
       -
         load_generic (fun doc ->

     

       287
       287
       -
           Document.root doc |> Option.value ~default:(`Scalar (Scalar.make ""))

     

       288
       288
       -
         ) parser

     

       260
       260
       +
         load_generic

     

       261
       261
       +
           (fun doc ->

     

       262
       262
       +
             Document.root doc |> Option.value ~default:(`Scalar (Scalar.make "")))

     

       263
       263
       +
           parser

     

       289
       264
        
       

     

       290
       265
        
       (** Load single Document from parser *)

     

       291
       291
       -
       let load_document parser =

     

       292
       292
       -
         load_generic Fun.id parser

     

       266
       266
       +
       let load_document parser = load_generic Fun.id parser

     

       293
       267
        
       

     

       294
       268
        
       (** Iterate over documents *)

     

       295
       269
        
       let iter_documents f parser =

     

       296
       270
        
         let rec loop () =

     

       297
       271
        
           match load_document parser with

     

       298
       272
        
           | None -> ()

     

       299
       299
       -
           | Some doc -> f doc; loop ()

     

       273
       273
       +
           | Some doc ->

     

       274
       274
       +
               f doc;

     

       275
       275
       +
               loop ()

     

       300
       276
        
         in

     

       301
       277
        
         loop ()

     

       302
       278
        
       

     

       303
       279
        
       (** Fold over documents *)

     

       304
       280
        
       let fold_documents f init parser =

     

       305
       281
        
         let rec loop acc =

     

       306
       306
       -
           match load_document parser with

     

       307
       307
       -
           | None -> acc

     

       308
       308
       -
           | Some doc -> loop (f acc doc)

     

       282
       282
       +
           match load_document parser with None -> acc | Some doc -> loop (f acc doc)

     

       309
       283
        
         in

     

       310
       284
        
         loop init

     

       285
       285
       +
       

     

       311
       286
        
       

     

       312
       287
        
       (** Load single Value from event source.

     

       313
       288
        
       

     

       314
       289
        
           @param resolve_aliases Whether to resolve aliases (default true)

     

       315
       290
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       316
       316
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       317
       317
       -
       *)

     

       318
       318
       -
       let value_of_parser

     

       319
       319
       -
           ?(resolve_aliases = true)

     

       291
       291
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       292
       292
       +
       let value_of_parser ?(resolve_aliases = true)

     

       320
       293
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       321
       321
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       322
       322
       -
           next_event =

     

       323
       323
       -
         match load_generic_fn (fun doc ->

     

       324
       324
       -
           match Document.root doc with

     

       325
       325
       -
           | None -> `Null

     

       326
       326
       -
           | Some yaml ->

     

       327
       327
       -
               Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml

     

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

     

       329
       305
        
         | Some v -> v

     

       330
       306
        
         | None -> `Null

     

       331
       307
        
       

     
···

       333
       309
        
       

     

       334
       310
        
           @param resolve_aliases Whether to resolve aliases (default false)

     

       335
       311
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       336
       336
       -
           @param max_depth Maximum alias nesting depth (default 100)

     

       337
       337
       -
       *)

     

       338
       338
       -
       let yaml_of_parser

     

       339
       339
       -
           ?(resolve_aliases = false)

     

       312
       312
       +
           @param max_depth Maximum alias nesting depth (default 100) *)

     

       313
       313
       +
       let yaml_of_parser ?(resolve_aliases = false)

     

       340
       314
        
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       341
       341
       -
           ?(max_depth = Yaml.default_max_alias_depth)

     

       342
       342
       -
           next_event =

     

       343
       343
       -
         match load_generic_fn (fun doc ->

     

       344
       344
       -
           match Document.root doc with

     

       345
       345
       -
           | None -> `Scalar (Scalar.make "")

     

       346
       346
       -
           | Some yaml ->

     

       347
       347
       -
               if resolve_aliases then

     

       348
       348
       -
                 Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       349
       349
       -
               else

     

       350
       350
       -
                 yaml

     

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

     

       352
       327
        
         | Some v -> v

     

       353
       328
        
         | None -> `Scalar (Scalar.make "")

     

       354
       329
        
       

     

       355
       330
        
       (** Load single Document from event source *)

     

       356
       356
       -
       let document_of_parser next_event =

     

       357
       357
       -
         load_generic_fn Fun.id next_event

     

       331
       331
       +
       let document_of_parser next_event = load_generic_fn Fun.id next_event

     

       358
       332
        
       

     

       359
       333
        
       (** Load all documents from event source *)

     

       360
       334
        
       let documents_of_parser next_event =

     
···

       373
       347
        
         let rec loop () =

     

       374
       348
        
           match document_of_parser next_event with

     

       375
       349
        
           | None -> ()

     

       376
       376
       -
           | Some doc -> f doc; loop ()

     

       350
       350
       +
           | Some doc ->

     

       351
       351
       +
               f doc;

     

       352
       352
       +
               loop ()

     

       377
       353
        
         in

     

       378
       354
        
         loop ()

     

       379
       355

+38 -41

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 }

     

       36
       36
       -
       let map f t = { t with members = List.map (fun (k, v) -> f k 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 }

     

       37
       31
        
       

     

       38
       38
       -
       let length t = List.length t.members

     

       32
       32
       +
       let map_values f t =

     

       33
       33
       +
         { t with members = List.map (fun (k, v) -> (k, f v)) t.members }

     

       39
       34
        
       

     

       35
       35
       +
       let map f t = { t with members = List.map (fun (k, v) -> f k v) t.members }

     

       36
       36
       +
       let length t = List.length t.members

     

       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 =

     
···

       62
       52
        
         Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;

     

       63
       53
        
         Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;

     

       64
       54
        
         Format.fprintf fmt "members={@,";

     

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

     

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

     

       67
       67
       -
           Format.fprintf fmt "@[<hv 2>%a:@ %a@]" pp_key k pp_val v

     

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

     

       69
       60
        
         Format.fprintf fmt "@]@,})"

     

       70
       61
        
       

     

       71
       62
        
       let equal eq_k eq_v a b =

     

       72
       72
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       73
       73
       -
         Option.equal String.equal a.tag b.tag &&

     

       74
       74
       -
         a.implicit = b.implicit &&

     

       75
       75
       -
         Layout_style.equal a.style b.style &&

     

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

     

       77
       70
        
       

     

       78
       71
        
       let compare cmp_k cmp_v a b =

     

       79
       72
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       80
       80
       -
         if c <> 0 then c else

     

       81
       81
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       82
       82
       -
         if c <> 0 then c else

     

       83
       83
       -
         let c = Bool.compare a.implicit b.implicit in

     

       84
       84
       -
         if c <> 0 then c else

     

       85
       85
       -
         let c = Layout_style.compare a.style b.style in

     

       86
       86
       -
         if c <> 0 then c else

     

       87
       87
       -
         let cmp_pair (k1, v1) (k2, v2) =

     

       88
       88
       -
           let c = cmp_k k1 k2 in

     

       89
       89
       -
           if c <> 0 then c else cmp_v v1 v2

     

       90
       90
       -
         in

     

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

+266 -305

lib/parser.ml

···

       10
       10
        
         | Stream_start

     

       11
       11
        
         | Implicit_document_start

     

       12
       12
        
         | Document_content

     

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

     

       14
       15
        
         | Document_end

     

       15
       16
        
         | Block_sequence_first_entry

     

       16
       17
        
         | Block_sequence_entry

     
···

       36
       37
        
         mutable tag_directives : (string * string) list;

     

       37
       38
        
         mutable current_token : Token.spanned option;

     

       38
       39
        
         mutable finished : bool;

     

       39
       39
       -
         mutable explicit_doc_end : bool;  (** True if last doc ended with explicit ... *)

     

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

     

       41
       44
        
       }

     

       42
       45
        
       

     

       43
       43
       -
       let create scanner = {

     

       44
       44
       -
         scanner;

     

       45
       45
       -
         state = Stream_start;

     

       46
       46
       -
         states = [];

     

       47
       47
       -
         version = None;

     

       48
       48
       -
         tag_directives = [

     

       49
       49
       -
           ("!", "!");

     

       50
       50
       -
           ("!!", "tag:yaml.org,2002:");

     

       51
       51
       -
         ];

     

       52
       52
       -
         current_token = None;

     

       53
       53
       -
         finished = false;

     

       54
       54
       -
         explicit_doc_end = false;

     

       55
       55
       -
         stream_start = true;

     

       56
       56
       -
       }

     

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

     

       57
       58
        
       

     

       58
       59
        
       let of_string s = create (Scanner.of_string s)

     

       59
       60
        
       let of_scanner = create

     
···

       64
       65
        
       let current_token t =

     

       65
       66
        
         match t.current_token with

     

       66
       67
        
         | Some tok -> tok

     

       67
       67
       -
         | None ->

     

       68
       68
       +
         | None -> (

     

       68
       69
        
             let tok = Scanner.next t.scanner in

     

       69
       70
        
             t.current_token <- tok;

     

       70
       70
       -
             match tok with

     

       71
       71
       -
             | Some tok -> tok

     

       72
       72
       -
             | None -> Error.raise Unexpected_eof

     

       71
       71
       +
             match tok with Some tok -> tok | None -> Error.raise Unexpected_eof)

     

       73
       72
        
       

     

       74
       73
        
       (** Peek at current token *)

     

       75
       74
        
       let peek_token t =

     
···

       80
       79
        
             t.current_token

     

       81
       80
        
       

     

       82
       81
        
       (** Skip current token *)

     

       83
       83
       -
       let skip_token t =

     

       84
       84
       -
         t.current_token <- None

     

       82
       82
       +
       let skip_token t = t.current_token <- None

     

       85
       83
        
       

     

       86
       84
        
       (** Check if current token matches predicate *)

     

       87
       85
        
       let check t pred =

     

       88
       88
       -
         match peek_token t with

     

       89
       89
       -
         | Some tok -> pred tok.token

     

       90
       90
       -
         | None -> false

     

       86
       86
       +
         match peek_token t with Some tok -> pred tok.token | None -> false

     

       87
       87
       +
       

     

       91
       88
        
       

     

       92
       89
        
       (** Push state onto stack *)

     

       93
       93
       -
       let push_state t s =

     

       94
       94
       -
         t.states <- s :: t.states

     

       90
       90
       +
       let push_state t s = t.states <- s :: t.states

     

       95
       91
        
       

     

       96
       92
        
       (** Pop state from stack *)

     

       97
       93
        
       let pop_state t =

     
···

       115
       111
        
       (** Process directives at document start *)

     

       116
       112
        
       let process_directives t =

     

       117
       113
        
         t.version <- None;

     

       118
       118
       -
         t.tag_directives <- [("!", "!"); ("!!", "tag:yaml.org,2002:")];

     

       114
       114
       +
         t.tag_directives <- [ ("!", "!"); ("!!", "tag:yaml.org,2002:") ];

     

       119
       115
        
       

     

       120
       120
       -
         while check t (function

     

       121
       121
       -
           | Token.Version_directive _ | Token.Tag_directive _ -> true

     

       122
       122
       -
           | _ -> false)

     

       116
       116
       +
         while

     

       117
       117
       +
           check t (function

     

       118
       118
       +
             | Token.Version_directive _ | Token.Tag_directive _ -> true

     

       119
       119
       +
             | _ -> false)

     

       123
       120
        
         do

     

       124
       121
        
           let tok = current_token t in

     

       125
       122
        
           skip_token t;

     

       126
       123
        
           match tok.token with

     

       127
       124
        
           | Token.Version_directive { major; minor } ->

     

       128
       125
        
               if t.version <> None then

     

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

     

       130
       128
        
               t.version <- Some (major, minor)

     

       131
       129
        
           | Token.Tag_directive { handle; prefix } ->

     

       132
       130
        
               (* Skip empty tag directives (these are reserved/unknown directives that were ignored) *)

     

       133
       133
       -
               if handle = "" && prefix = "" then

     

       134
       134
       -
                 () (* Ignore reserved directives *)

     

       131
       131
       +
               if handle = "" && prefix = "" then () (* Ignore reserved directives *)

     

       135
       132
        
               else begin

     

       136
       136
       -
                 if List.mem_assoc handle t.tag_directives &&

     

       137
       137
       -
                    handle <> "!" && handle <> "!!" then

     

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

     

       139
       139
        
                 t.tag_directives <- (handle, prefix) :: t.tag_directives

     

       140
       140
        
               end

     

       141
       141
        
           | _ -> ()

     
···

       146
       146
        
         let anchor = ref None in

     

       147
       147
        
         let tag = ref None in

     

       148
       148
        
       

     

       149
       149
       -
         while check t (function

     

       150
       150
       -
           | Token.Anchor _ | Token.Tag _ -> true

     

       151
       151
       -
           | _ -> false)

     

       149
       149
       +
         while

     

       150
       150
       +
           check t (function Token.Anchor _ | Token.Tag _ -> true | _ -> false)

     

       152
       151
        
         do

     

       153
       152
        
           let tok = current_token t in

     

       154
       153
        
           skip_token t;

     
···

       172
       171
        
       

     

       173
       172
        
       (** Empty scalar event *)

     

       174
       173
        
       let empty_scalar_event ~anchor ~tag span =

     

       175
       175
       -
         Event.Scalar {

     

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

     

       183
       184
        
       

     

       184
       185
        
       (** Parse stream start *)

     

       185
       186
        
       let parse_stream_start t =

     
···

       188
       189
        
         match tok.token with

     

       189
       190
        
         | Token.Stream_start encoding ->

     

       190
       191
        
             t.state <- Implicit_document_start;

     

       191
       191
       -
             Event.Stream_start { encoding }, tok.span

     

       192
       192
       -
         | _ ->

     

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

     

       194
       194
        
       

     

       195
       195
        
       (** Parse document start (implicit or explicit) *)

     

       196
       196
        
       let parse_document_start t ~implicit =

     
···

       199
       199
        
         if not implicit then begin

     

       200
       200
        
           let tok = current_token t in

     

       201
       201
        
           match tok.token with

     

       202
       202
       -
           | Token.Document_start ->

     

       203
       203
       -
               skip_token t

     

       204
       204
       -
           | _ ->

     

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

     

       206
       204
        
         end;

     

       207
       205
        
       

     

       208
       208
       -
         let span = match peek_token t with

     

       206
       206
       +
         let span =

     

       207
       207
       +
           match peek_token t with

     

       209
       208
        
           | Some tok -> tok.span

     

       210
       209
        
           | None -> Span.point Position.initial

     

       211
       210
        
         in

     
···

       214
       213
        
         t.stream_start <- false;

     

       215
       214
        
         push_state t Document_end;

     

       216
       215
        
         t.state <- Document_content;

     

       217
       217
       -
         Event.Document_start { version = t.version; implicit }, span

     

       216
       216
       +
         (Event.Document_start { version = t.version; implicit }, span)

     

       218
       217
        
       

     

       219
       218
        
       (** Parse document end *)

     

       220
       219
        
       let parse_document_end t =

     

       221
       221
       -
         let implicit = not (check t (function Token.Document_end -> true | _ -> false)) in

     

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

     

       223
       225
        
           | Some tok -> tok.span

     

       224
       226
        
           | None -> Span.point Position.initial

     

       225
       227
        
         in

     
···

       229
       231
        
         (* Track if this document ended explicitly with ... *)

     

       230
       232
        
         t.explicit_doc_end <- not implicit;

     

       231
       233
        
         t.state <- Implicit_document_start;

     

       232
       232
       -
         Event.Document_end { implicit }, span

     

       234
       234
       +
         (Event.Document_end { implicit }, span)

     

       233
       235
        
       

     

       234
       236
        
       (** Parse node in various contexts *)

     

       235
       237
        
       let parse_node t ~block ~indentless =

     
···

       238
       240
        
         | Token.Alias name ->

     

       239
       241
        
             skip_token t;

     

       240
       242
        
             t.state <- pop_state t;

     

       241
       241
       -
             Event.Alias { anchor = name }, tok.span

     

       242
       242
       -
       

     

       243
       243
       -
         | Token.Anchor _ | Token.Tag _ ->

     

       243
       243
       +
             (Event.Alias { anchor = name }, tok.span)

     

       244
       244
       +
         | Token.Anchor _ | Token.Tag _ -> (

     

       244
       245
        
             let anchor, tag = parse_properties t in

     

       245
       246
        
             let tok = current_token t in

     

       246
       246
       -
             (match tok.token with

     

       247
       247
       -
              | Token.Block_entry when indentless ->

     

       248
       248
       -
                  t.state <- Indentless_sequence_entry;

     

       249
       249
       -
                  Event.Sequence_start {

     

       250
       250
       -
                    anchor; tag;

     

       251
       251
       -
                    implicit = tag = None;

     

       252
       252
       -
                    style = `Block;

     

       253
       253
       -
                  }, tok.span

     

       254
       254
       -
       

     

       255
       255
       -
              | Token.Block_sequence_start when block ->

     

       256
       256
       -
                  t.state <- Block_sequence_first_entry;

     

       257
       257
       -
                  skip_token t;

     

       258
       258
       -
                  Event.Sequence_start {

     

       259
       259
       -
                    anchor; tag;

     

       260
       260
       -
                    implicit = tag = None;

     

       261
       261
       -
                    style = `Block;

     

       262
       262
       -
                  }, tok.span

     

       263
       263
       -
       

     

       264
       264
       -
              | Token.Block_mapping_start when block ->

     

       265
       265
       -
                  t.state <- Block_mapping_first_key;

     

       266
       266
       -
                  skip_token t;

     

       267
       267
       -
                  Event.Mapping_start {

     

       268
       268
       -
                    anchor; tag;

     

       269
       269
       -
                    implicit = tag = None;

     

       270
       270
       -
                    style = `Block;

     

       271
       271
       -
                  }, tok.span

     

       272
       272
       -
       

     

       273
       273
       -
              | Token.Flow_sequence_start ->

     

       274
       274
       -
                  t.state <- Flow_sequence_first_entry;

     

       275
       275
       -
                  skip_token t;

     

       276
       276
       -
                  Event.Sequence_start {

     

       277
       277
       -
                    anchor; tag;

     

       278
       278
       -
                    implicit = tag = None;

     

       279
       279
       -
                    style = `Flow;

     

       280
       280
       -
                  }, tok.span

     

       281
       281
       -
       

     

       282
       282
       -
              | Token.Flow_mapping_start ->

     

       283
       283
       -
                  t.state <- Flow_mapping_first_key;

     

       284
       284
       -
                  skip_token t;

     

       285
       285
       -
                  Event.Mapping_start {

     

       286
       286
       -
                    anchor; tag;

     

       287
       287
       -
                    implicit = tag = None;

     

       288
       288
       -
                    style = `Flow;

     

       289
       289
       -
                  }, tok.span

     

       290
       290
       -
       

     

       291
       291
       -
              | Token.Scalar { style; value } ->

     

       292
       292
       -
                  skip_token t;

     

       293
       293
       -
                  t.state <- pop_state t;

     

       294
       294
       -
                  let plain_implicit = tag = None && style = `Plain in

     

       295
       295
       -
                  let quoted_implicit = tag = None && style <> `Plain in

     

       296
       296
       -
                  Event.Scalar {

     

       297
       297
       -
                    anchor; tag; value;

     

       298
       298
       -
                    plain_implicit; quoted_implicit; style;

     

       299
       299
       -
                  }, tok.span

     

       300
       300
       -
       

     

       301
       301
       -
              | _ ->

     

       302
       302
       -
                  (* Empty node *)

     

       303
       303
       -
                  t.state <- pop_state t;

     

       304
       304
       -
                  empty_scalar_event ~anchor ~tag tok.span)

     

       305
       305
       -
       

     

       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)

     

       306
       289
        
         | Token.Block_sequence_start when block ->

     

       307
       290
        
             t.state <- Block_sequence_first_entry;

     

       308
       291
        
             skip_token t;

     

       309
       309
       -
             Event.Sequence_start {

     

       310
       310
       -
               anchor = None; tag = None;

     

       311
       311
       -
               implicit = true;

     

       312
       312
       -
               style = `Block;

     

       313
       313
       -
             }, tok.span

     

       314
       314
       -
       

     

       292
       292
       +
             ( Event.Sequence_start

     

       293
       293
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       294
       294
       +
               tok.span )

     

       315
       295
        
         | Token.Block_mapping_start when block ->

     

       316
       296
        
             t.state <- Block_mapping_first_key;

     

       317
       297
        
             skip_token t;

     

       318
       318
       -
             Event.Mapping_start {

     

       319
       319
       -
               anchor = None; tag = None;

     

       320
       320
       -
               implicit = true;

     

       321
       321
       -
               style = `Block;

     

       322
       322
       -
             }, tok.span

     

       323
       323
       -
       

     

       298
       298
       +
             ( Event.Mapping_start

     

       299
       299
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       300
       300
       +
               tok.span )

     

       324
       301
        
         | Token.Flow_sequence_start ->

     

       325
       302
        
             t.state <- Flow_sequence_first_entry;

     

       326
       303
        
             skip_token t;

     

       327
       327
       -
             Event.Sequence_start {

     

       328
       328
       -
               anchor = None; tag = None;

     

       329
       329
       -
               implicit = true;

     

       330
       330
       -
               style = `Flow;

     

       331
       331
       -
             }, tok.span

     

       332
       332
       -
       

     

       304
       304
       +
             ( Event.Sequence_start

     

       305
       305
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       306
       306
       +
               tok.span )

     

       333
       307
        
         | Token.Flow_mapping_start ->

     

       334
       308
        
             t.state <- Flow_mapping_first_key;

     

       335
       309
        
             skip_token t;

     

       336
       336
       -
             Event.Mapping_start {

     

       337
       337
       -
               anchor = None; tag = None;

     

       338
       338
       -
               implicit = true;

     

       339
       339
       -
               style = `Flow;

     

       340
       340
       -
             }, tok.span

     

       341
       341
       -
       

     

       310
       310
       +
             ( Event.Mapping_start

     

       311
       311
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       312
       312
       +
               tok.span )

     

       342
       313
        
         | Token.Block_entry when indentless ->

     

       343
       314
        
             t.state <- Indentless_sequence_entry;

     

       344
       344
       -
             Event.Sequence_start {

     

       345
       345
       -
               anchor = None; tag = None;

     

       346
       346
       -
               implicit = true;

     

       347
       347
       -
               style = `Block;

     

       348
       348
       -
             }, tok.span

     

       349
       349
       -
       

     

       315
       315
       +
             ( Event.Sequence_start

     

       316
       316
       +
                 { anchor = None; tag = None; implicit = true; style = `Block },

     

       317
       317
       +
               tok.span )

     

       350
       318
        
         | Token.Scalar { style; value } ->

     

       351
       319
        
             skip_token t;

     

       352
       320
        
             t.state <- pop_state t;

     

       353
       321
        
             let plain_implicit = style = `Plain in

     

       354
       322
        
             let quoted_implicit = style <> `Plain in

     

       355
       355
       -
             Event.Scalar {

     

       356
       356
       -
               anchor = None; tag = None; value;

     

       357
       357
       -
               plain_implicit; quoted_implicit; style;

     

       358
       358
       -
             }, tok.span

     

       359
       359
       -
       

     

       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 )

     

       360
       333
        
         | _ ->

     

       361
       334
        
             (* Empty node *)

     

       362
       335
        
             t.state <- pop_state t;

     
···

       368
       341
        
         match tok.token with

     

       369
       342
        
         | Token.Block_entry ->

     

       370
       343
        
             skip_token t;

     

       371
       371
       -
             if check t (function

     

       372
       372
       -
               | Token.Block_entry | Token.Block_end -> true

     

       373
       373
       -
               | _ -> false)

     

       344
       344
       +
             if

     

       345
       345
       +
               check t (function

     

       346
       346
       +
                 | Token.Block_entry | Token.Block_end -> true

     

       347
       347
       +
                 | _ -> false)

     

       374
       348
        
             then begin

     

       375
       349
        
               t.state <- Block_sequence_entry;

     

       376
       350
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       377
       377
       -
             end else begin

     

       351
       351
       +
             end

     

       352
       352
       +
             else begin

     

       378
       353
        
               push_state t Block_sequence_entry;

     

       379
       354
        
               parse_node t ~block:true ~indentless:false

     

       380
       355
        
             end

     

       381
       356
        
         | Token.Block_end ->

     

       382
       357
        
             skip_token t;

     

       383
       358
        
             t.state <- pop_state t;

     

       384
       384
       -
             Event.Sequence_end, tok.span

     

       385
       385
       -
         | _ ->

     

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

     

       387
       361
        
       

     

       388
       362
        
       (** Parse block mapping key *)

     

       389
       363
        
       let parse_block_mapping_key t =

     
···

       391
       365
        
         match tok.token with

     

       392
       366
        
         | Token.Key ->

     

       393
       367
        
             skip_token t;

     

       394
       394
       -
             if check t (function

     

       395
       395
       -
               | Token.Key | Token.Value | Token.Block_end -> true

     

       396
       396
       -
               | _ -> false)

     

       368
       368
       +
             if

     

       369
       369
       +
               check t (function

     

       370
       370
       +
                 | Token.Key | Token.Value | Token.Block_end -> true

     

       371
       371
       +
                 | _ -> false)

     

       397
       372
        
             then begin

     

       398
       373
        
               t.state <- Block_mapping_value;

     

       399
       374
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       400
       400
       -
             end else begin

     

       375
       375
       +
             end

     

       376
       376
       +
             else begin

     

       401
       377
        
               push_state t Block_mapping_value;

     

       402
       378
        
               parse_node t ~block:true ~indentless:true

     

       403
       379
        
             end

     
···

       408
       384
        
         | Token.Block_end ->

     

       409
       385
        
             skip_token t;

     

       410
       386
        
             t.state <- pop_state t;

     

       411
       411
       -
             Event.Mapping_end, tok.span

     

       412
       412
       -
         | _ ->

     

       413
       413
       -
             Error.raise_span tok.span Expected_key

     

       387
       387
       +
             (Event.Mapping_end, tok.span)

     

       388
       388
       +
         | _ -> Error.raise_span tok.span Expected_key

     

       414
       389
        
       

     

       415
       390
        
       (** Parse block mapping value *)

     

       416
       391
        
       let parse_block_mapping_value t =

     
···

       418
       393
        
         match tok.token with

     

       419
       394
        
         | Token.Value ->

     

       420
       395
        
             skip_token t;

     

       421
       421
       -
             if check t (function

     

       422
       422
       -
               | Token.Key | Token.Value | Token.Block_end -> true

     

       423
       423
       -
               | _ -> false)

     

       396
       396
       +
             if

     

       397
       397
       +
               check t (function

     

       398
       398
       +
                 | Token.Key | Token.Value | Token.Block_end -> true

     

       399
       399
       +
                 | _ -> false)

     

       424
       400
        
             then begin

     

       425
       401
        
               t.state <- Block_mapping_key;

     

       426
       402
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       427
       427
       -
             end else begin

     

       403
       403
       +
             end

     

       404
       404
       +
             else begin

     

       428
       405
        
               push_state t Block_mapping_key;

     

       429
       406
        
               parse_node t ~block:true ~indentless:true

     

       430
       407
        
             end

     
···

       439
       416
        
         match tok.token with

     

       440
       417
        
         | Token.Block_entry ->

     

       441
       418
        
             skip_token t;

     

       442
       442
       -
             if check t (function

     

       443
       443
       -
               | Token.Block_entry | Token.Key | Token.Value | Token.Block_end -> true

     

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

     

       445
       424
        
             then begin

     

       446
       425
        
               t.state <- Indentless_sequence_entry;

     

       447
       426
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       448
       448
       -
             end else begin

     

       427
       427
       +
             end

     

       428
       428
       +
             else begin

     

       449
       429
        
               push_state t Indentless_sequence_entry;

     

       450
       430
        
               parse_node t ~block:true ~indentless:false

     

       451
       431
        
             end

     

       452
       432
        
         | _ ->

     

       453
       433
        
             t.state <- pop_state t;

     

       454
       454
       -
             Event.Sequence_end, tok.span

     

       434
       434
       +
             (Event.Sequence_end, tok.span)

     

       455
       435
        
       

     

       456
       436
        
       (** Parse flow sequence *)

     

       457
       437
        
       let rec parse_flow_sequence_entry t ~first =

     
···

       460
       440
        
         | Token.Flow_sequence_end ->

     

       461
       441
        
             skip_token t;

     

       462
       442
        
             t.state <- pop_state t;

     

       463
       463
       -
             Event.Sequence_end, tok.span

     

       443
       443
       +
             (Event.Sequence_end, tok.span)

     

       464
       444
        
         | Token.Flow_entry when not first ->

     

       465
       445
        
             skip_token t;

     

       466
       446
        
             parse_flow_sequence_entry_internal t

     

       467
       467
       -
         | _ when first ->

     

       468
       468
       -
             parse_flow_sequence_entry_internal t

     

       469
       469
       -
         | _ ->

     

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

     

       471
       449
        
       

     

       472
       450
        
       and parse_flow_sequence_entry_internal t =

     

       473
       451
        
         let tok = current_token t in

     
···

       476
       454
        
             (* Trailing comma case - don't emit empty scalar, just go back to sequence entry state *)

     

       477
       455
        
             skip_token t;

     

       478
       456
        
             t.state <- pop_state t;

     

       479
       479
       -
             Event.Sequence_end, tok.span

     

       457
       457
       +
             (Event.Sequence_end, tok.span)

     

       480
       458
        
         | Token.Flow_entry ->

     

       481
       459
        
             (* Double comma or comma after comma - invalid *)

     

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

     

       483
       462
        
         | Token.Key ->

     

       484
       463
        
             skip_token t;

     

       485
       464
        
             t.state <- Flow_sequence_entry_mapping_key;

     

       486
       486
       -
             Event.Mapping_start {

     

       487
       487
       -
               anchor = None; tag = None;

     

       488
       488
       -
               implicit = true;

     

       489
       489
       -
               style = `Flow;

     

       490
       490
       -
             }, tok.span

     

       465
       465
       +
             ( Event.Mapping_start

     

       466
       466
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       467
       467
       +
               tok.span )

     

       491
       468
        
         | Token.Value ->

     

       492
       469
        
             (* Implicit empty key mapping: [ : value ] *)

     

       493
       470
        
             t.state <- Flow_sequence_entry_mapping_key;

     

       494
       494
       -
             Event.Mapping_start {

     

       495
       495
       -
               anchor = None; tag = None;

     

       496
       496
       -
               implicit = true;

     

       497
       497
       -
               style = `Flow;

     

       498
       498
       -
             }, tok.span

     

       471
       471
       +
             ( Event.Mapping_start

     

       472
       472
       +
                 { anchor = None; tag = None; implicit = true; style = `Flow },

     

       473
       473
       +
               tok.span )

     

       499
       474
        
         | _ ->

     

       500
       475
        
             push_state t Flow_sequence_entry;

     

       501
       476
        
             parse_node t ~block:false ~indentless:false

     
···

       503
       478
        
       (** Parse flow sequence entry mapping *)

     

       504
       479
        
       let parse_flow_sequence_entry_mapping_key t =

     

       505
       480
        
         let tok = current_token t in

     

       506
       506
       -
         if check t (function

     

       507
       507
       -
           | Token.Value | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       508
       508
       -
           | _ -> false)

     

       481
       481
       +
         if

     

       482
       482
       +
           check t (function

     

       483
       483
       +
             | Token.Value | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       484
       484
       +
             | _ -> false)

     

       509
       485
        
         then begin

     

       510
       486
        
           t.state <- Flow_sequence_entry_mapping_value;

     

       511
       487
        
           empty_scalar_event ~anchor:None ~tag:None tok.span

     

       512
       512
       -
         end else begin

     

       488
       488
       +
         end

     

       489
       489
       +
         else begin

     

       513
       490
        
           push_state t Flow_sequence_entry_mapping_value;

     

       514
       491
        
           parse_node t ~block:false ~indentless:false

     

       515
       492
        
         end

     
···

       519
       496
        
         match tok.token with

     

       520
       497
        
         | Token.Value ->

     

       521
       498
        
             skip_token t;

     

       522
       522
       -
             if check t (function

     

       523
       523
       -
               | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       524
       524
       -
               | _ -> false)

     

       499
       499
       +
             if

     

       500
       500
       +
               check t (function

     

       501
       501
       +
                 | Token.Flow_entry | Token.Flow_sequence_end -> true

     

       502
       502
       +
                 | _ -> false)

     

       525
       503
        
             then begin

     

       526
       504
        
               t.state <- Flow_sequence_entry_mapping_end;

     

       527
       505
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       528
       528
       -
             end else begin

     

       506
       506
       +
             end

     

       507
       507
       +
             else begin

     

       529
       508
        
               push_state t Flow_sequence_entry_mapping_end;

     

       530
       509
        
               parse_node t ~block:false ~indentless:false

     

       531
       510
        
             end

     
···

       536
       515
        
       let parse_flow_sequence_entry_mapping_end t =

     

       537
       516
        
         let tok = current_token t in

     

       538
       517
        
         t.state <- Flow_sequence_entry;

     

       539
       539
       -
         Event.Mapping_end, tok.span

     

       518
       518
       +
         (Event.Mapping_end, tok.span)

     

       540
       519
        
       

     

       541
       520
        
       (** Parse flow mapping *)

     

       542
       521
        
       let rec parse_flow_mapping_key t ~first =

     
···

       545
       524
        
         | Token.Flow_mapping_end ->

     

       546
       525
        
             skip_token t;

     

       547
       526
        
             t.state <- pop_state t;

     

       548
       548
       -
             Event.Mapping_end, tok.span

     

       527
       527
       +
             (Event.Mapping_end, tok.span)

     

       549
       528
        
         | Token.Flow_entry when not first ->

     

       550
       529
        
             skip_token t;

     

       551
       530
        
             parse_flow_mapping_key_internal t

     

       552
       552
       -
         | _ when first ->

     

       553
       553
       -
             parse_flow_mapping_key_internal t

     

       554
       554
       -
         | _ ->

     

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

     

       556
       533
        
       

     

       557
       534
        
       and parse_flow_mapping_key_internal t =

     

       558
       535
        
         let tok = current_token t in

     
···

       561
       538
        
             (* Trailing comma case - don't emit empty scalar, just return to key state *)

     

       562
       539
        
             skip_token t;

     

       563
       540
        
             t.state <- pop_state t;

     

       564
       564
       -
             Event.Mapping_end, tok.span

     

       541
       541
       +
             (Event.Mapping_end, tok.span)

     

       565
       542
        
         | Token.Flow_entry ->

     

       566
       543
        
             (* Double comma or comma after comma - invalid *)

     

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

     

       568
       546
        
         | Token.Key ->

     

       569
       547
        
             skip_token t;

     

       570
       570
       -
             if check t (function

     

       571
       571
       -
               | Token.Value | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       572
       572
       -
               | _ -> false)

     

       548
       548
       +
             if

     

       549
       549
       +
               check t (function

     

       550
       550
       +
                 | Token.Value | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       551
       551
       +
                 | _ -> false)

     

       573
       552
        
             then begin

     

       574
       553
        
               t.state <- Flow_mapping_value;

     

       575
       554
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       576
       576
       -
             end else begin

     

       555
       555
       +
             end

     

       556
       556
       +
             else begin

     

       577
       557
        
               push_state t Flow_mapping_value;

     

       578
       558
        
               parse_node t ~block:false ~indentless:false

     

       579
       559
        
             end

     
···

       586
       566
        
         if empty then begin

     

       587
       567
        
           t.state <- Flow_mapping_key;

     

       588
       568
        
           empty_scalar_event ~anchor:None ~tag:None tok.span

     

       589
       589
       -
         end else

     

       569
       569
       +
         end

     

       570
       570
       +
         else

     

       590
       571
        
           match tok.token with

     

       591
       572
        
           | Token.Value ->

     

       592
       573
        
               skip_token t;

     

       593
       593
       -
               if check t (function

     

       594
       594
       -
                 | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       595
       595
       -
                 | _ -> false)

     

       574
       574
       +
               if

     

       575
       575
       +
                 check t (function

     

       576
       576
       +
                   | Token.Flow_entry | Token.Flow_mapping_end -> true

     

       577
       577
       +
                   | _ -> false)

     

       596
       578
        
               then begin

     

       597
       579
        
                 t.state <- Flow_mapping_key;

     

       598
       580
        
                 empty_scalar_event ~anchor:None ~tag:None tok.span

     

       599
       599
       -
               end else begin

     

       581
       581
       +
               end

     

       582
       582
       +
               else begin

     

       600
       583
        
                 push_state t Flow_mapping_key;

     

       601
       584
        
                 parse_node t ~block:false ~indentless:false

     

       602
       585
        
               end

     
···

       607
       590
        
       (** Main state machine dispatcher *)

     

       608
       591
        
       let rec parse t =

     

       609
       592
        
         match t.state with

     

       610
       610
       -
         | Stream_start ->

     

       611
       611
       -
             parse_stream_start t

     

       612
       612
       -
       

     

       613
       613
       -
         | Implicit_document_start ->

     

       593
       593
       +
         | Stream_start -> parse_stream_start t

     

       594
       594
       +
         | Implicit_document_start -> (

     

       614
       595
        
             (* Skip any document end markers before checking what's next *)

     

       615
       596
        
             while check t (function Token.Document_end -> true | _ -> false) do

     

       616
       616
       -
               t.explicit_doc_end <- true;  (* Seeing ... counts as explicit end *)

     

       597
       597
       +
               t.explicit_doc_end <- true;

     

       598
       598
       +
               (* Seeing ... counts as explicit end *)

     

       617
       599
        
               skip_token t

     

       618
       600
        
             done;

     

       619
       601
        
       

     

       620
       602
        
             let tok = current_token t in

     

       621
       621
       -
             (match tok.token with

     

       622
       622
       -
              | Token.Stream_end ->

     

       623
       623
       -
                  skip_token t;

     

       624
       624
       -
                  t.state <- End;

     

       625
       625
       -
                  t.finished <- true;

     

       626
       626
       -
                  Event.Stream_end, tok.span

     

       627
       627
       -
              | Token.Version_directive _ | Token.Tag_directive _ ->

     

       628
       628
       -
                  (* Directives are only allowed at stream start or after explicit ... (MUS6/01) *)

     

       629
       629
       -
                  if not t.stream_start && not t.explicit_doc_end then

     

       630
       630
       -
                    Error.raise_span tok.span (Invalid_directive "directives require explicit document end '...' before them");

     

       631
       631
       -
                  parse_document_start t ~implicit:false

     

       632
       632
       -
              | Token.Document_start ->

     

       633
       633
       -
                  parse_document_start t ~implicit:false

     

       634
       634
       -
              (* These tokens are invalid at document start - they indicate leftover junk *)

     

       635
       635
       -
              | Token.Flow_sequence_end | Token.Flow_mapping_end | Token.Flow_entry

     

       636
       636
       -
              | Token.Block_end | Token.Value ->

     

       637
       637
       -
                  Error.raise_span tok.span (Unexpected_token "unexpected token at document start")

     

       638
       638
       -
              | _ ->

     

       639
       639
       -
                  parse_document_start t ~implicit:true)

     

       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)

     

       640
       623
        
       

     

       641
       624
        
         | Document_content ->

     

       642
       642
       -
             if check t (function

     

       643
       643
       -
               | Token.Version_directive _ | Token.Tag_directive _

     

       644
       644
       -
               | Token.Document_start | Token.Document_end | Token.Stream_end -> true

     

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

     

       646
       631
        
             then begin

     

       647
       632
        
               let tok = current_token t in

     

       648
       633
        
               t.state <- pop_state t;

     

       649
       634
        
               empty_scalar_event ~anchor:None ~tag:None tok.span

     

       650
       650
       -
             end else begin

     

       635
       635
       +
             end

     

       636
       636
       +
             else begin

     

       651
       637
        
               (* Push Document_content_done so we return there after parsing the node.

     

       652
       638
        
                  This allows us to check for unexpected content after the node. *)

     

       653
       639
        
               push_state t Document_content_done;

     

       654
       640
        
               parse_node t ~block:true ~indentless:false

     

       655
       641
        
             end

     

       656
       656
       -
       

     

       657
       642
        
         | Document_content_done ->

     

       658
       643
        
             (* After parsing a node in document content, check for unexpected content *)

     

       659
       659
       -
             if check t (function

     

       660
       660
       -
               | Token.Version_directive _ | Token.Tag_directive _

     

       661
       661
       -
               | Token.Document_start | Token.Document_end | Token.Stream_end -> true

     

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

     

       663
       650
        
             then begin

     

       664
       651
        
               (* Valid document boundary - continue to Document_end *)

     

       665
       652
        
               t.state <- pop_state t;

     

       666
       666
       -
               parse t  (* Continue to emit the next event *)

     

       667
       667
       -
             end else begin

     

       653
       653
       +
               parse t (* Continue to emit the next event *)

     

       654
       654
       +
             end

     

       655
       655
       +
             else begin

     

       668
       656
        
               (* Unexpected content after document value - this is an error (KS4U, BS4K) *)

     

       669
       657
        
               let tok = current_token t in

     

       670
       658
        
               Error.raise_span tok.span

     

       671
       659
        
                 (Unexpected_token "content not allowed after document value")

     

       672
       660
        
             end

     

       673
       673
       -
       

     

       674
       674
       -
         | Document_end ->

     

       675
       675
       -
             parse_document_end t

     

       661
       661
       +
         | Document_end -> parse_document_end t

     

       676
       662
        
       

     

       677
       663
        
         | Block_sequence_first_entry ->

     

       678
       664
        
             t.state <- Block_sequence_entry;

     

       679
       665
        
             parse_block_sequence_entry t

     

       680
       680
       -
       

     

       681
       681
       -
         | Block_sequence_entry ->

     

       682
       682
       -
             parse_block_sequence_entry t

     

       683
       683
       -
       

     

       684
       684
       -
         | Indentless_sequence_entry ->

     

       685
       685
       -
             parse_indentless_sequence_entry t

     

       686
       686
       -
       

     

       666
       666
       +
         | Block_sequence_entry -> parse_block_sequence_entry t

     

       667
       667
       +
         | Indentless_sequence_entry -> parse_indentless_sequence_entry t

     

       687
       668
        
         | Block_mapping_first_key ->

     

       688
       669
        
             t.state <- Block_mapping_key;

     

       689
       670
        
             parse_block_mapping_key t

     

       690
       690
       -
       

     

       691
       691
       -
         | Block_mapping_key ->

     

       692
       692
       -
             parse_block_mapping_key t

     

       693
       693
       -
       

     

       694
       694
       -
         | Block_mapping_value ->

     

       695
       695
       -
             parse_block_mapping_value t

     

       696
       696
       -
       

     

       697
       697
       -
         | Flow_sequence_first_entry ->

     

       698
       698
       -
             parse_flow_sequence_entry t ~first:true

     

       699
       699
       -
       

     

       700
       700
       -
         | Flow_sequence_entry ->

     

       701
       701
       -
             parse_flow_sequence_entry t ~first:false

     

       702
       702
       -
       

     

       703
       703
       -
         | Flow_sequence_entry_mapping_key ->

     

       704
       704
       -
             parse_flow_sequence_entry_mapping_key t

     

       705
       705
       -
       

     

       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

     

       706
       676
        
         | Flow_sequence_entry_mapping_value ->

     

       707
       677
        
             parse_flow_sequence_entry_mapping_value t

     

       708
       708
       -
       

     

       709
       709
       -
         | Flow_sequence_entry_mapping_end ->

     

       710
       710
       -
             parse_flow_sequence_entry_mapping_end t

     

       711
       711
       -
       

     

       712
       712
       -
         | Flow_mapping_first_key ->

     

       713
       713
       -
             parse_flow_mapping_key t ~first:true

     

       714
       714
       -
       

     

       715
       715
       -
         | Flow_mapping_key ->

     

       716
       716
       -
             parse_flow_mapping_key t ~first:false

     

       717
       717
       -
       

     

       718
       718
       -
         | Flow_mapping_value ->

     

       719
       719
       -
             parse_flow_mapping_value t ~empty:false

     

       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

     

       720
       682
        
       

     

       721
       683
        
         | End ->

     

       722
       684
        
             let span = Span.point Position.initial in

     

       723
       685
        
             t.finished <- true;

     

       724
       724
       -
             Event.Stream_end, span

     

       686
       686
       +
             (Event.Stream_end, span)

     

       725
       687
        
       

     

       726
       688
        
       (** Get next event *)

     

       727
       689
        
       let next t =

     
···

       735
       697
        
         let rec loop () =

     

       736
       698
        
           match next t with

     

       737
       699
        
           | None -> ()

     

       738
       738
       -
           | Some ev -> f ev; loop ()

     

       700
       700
       +
           | Some ev ->

     

       701
       701
       +
               f ev;

     

       702
       702
       +
               loop ()

     

       739
       703
        
         in

     

       740
       704
        
         loop ()

     

       741
       705
        
       

     

       742
       706
        
       (** Fold over all events *)

     

       743
       707
        
       let fold f init t =

     

       744
       708
        
         let rec loop acc =

     

       745
       745
       -
           match next t with

     

       746
       746
       -
           | None -> acc

     

       747
       747
       -
           | Some ev -> loop (f acc ev)

     

       709
       709
       +
           match next t with None -> acc | Some ev -> loop (f acc ev)

     

       748
       710
        
         in

     

       749
       711
        
         loop init

     

       750
       712
        
       

     

       751
       713
        
       (** Convert to list *)

     

       752
       752
       -
       let to_list t =

     

       753
       753
       -
         fold (fun acc ev -> ev :: acc) [] t |> List.rev

     

       714
       714
       +
       let to_list t = fold (fun acc ev -> ev :: acc) [] t |> List.rev

+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

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

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 }

     
···

       41
       36
        
         Format.fprintf fmt ", style=%a)" Scalar_style.pp t.style

     

       42
       37
        
       

     

       43
       38
        
       let equal a b =

     

       44
       44
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       45
       45
       -
         Option.equal String.equal a.tag b.tag &&

     

       46
       46
       -
         String.equal a.value b.value &&

     

       47
       47
       -
         a.plain_implicit = b.plain_implicit &&

     

       48
       48
       -
         a.quoted_implicit = b.quoted_implicit &&

     

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

     

       50
       45
        
       

     

       51
       46
        
       let compare a b =

     

       52
       47
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       53
       53
       -
         if c <> 0 then c else

     

       54
       54
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       55
       55
       -
         if c <> 0 then c else

     

       56
       56
       -
         let c = String.compare a.value b.value in

     

       57
       57
       -
         if c <> 0 then c else

     

       58
       58
       -
         let c = Bool.compare a.plain_implicit b.plain_implicit in

     

       59
       59
       -
         if c <> 0 then c else

     

       60
       60
       -
         let c = Bool.compare a.quoted_implicit b.quoted_implicit in

     

       61
       61
       -
         if c <> 0 then c else

     

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

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

+536 -399

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

     

       20
       20
       +
       (** Indent level tracking *)

     

       21
       21
        
       

     

       22
       22
        
       type t = {

     

       23
       23
        
         input : Input.t;

     
···

       27
       27
        
         mutable stream_started : bool;

     

       28
       28
        
         mutable stream_ended : bool;

     

       29
       29
        
         mutable indent_stack : indent list;  (** Stack of indentation levels *)

     

       30
       30
       -
         mutable flow_level : int;            (** Nesting depth in \[\] or \{\} *)

     

       31
       31
       -
         mutable flow_indent : int;           (** Column where outermost flow collection started *)

     

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

     

       33
       35
        
         mutable allow_simple_key : bool;

     

       34
       34
       -
         mutable leading_whitespace : bool;   (** True when at start of line (only whitespace seen) *)

     

       35
       35
       -
         mutable document_has_content : bool; (** True if we've emitted content tokens in current document *)

     

       36
       36
       -
         mutable adjacent_value_allowed_at : Position.t option; (** Position where adjacent : is allowed *)

     

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

     

       38
       44
        
       }

     

       39
       45
        
       

     

       40
       46
        
       let create input =

     
···

       48
       54
        
           indent_stack = [];

     

       49
       55
        
           flow_level = 0;

     

       50
       56
        
           flow_indent = 0;

     

       51
       51
       -
           simple_keys = [None];  (* One entry for the base level *)

     

       57
       57
       +
           simple_keys = [ None ];

     

       58
       58
       +
           (* One entry for the base level *)

     

       52
       59
        
           allow_simple_key = true;

     

       53
       53
       -
           leading_whitespace = true;  (* Start at beginning of stream *)

     

       60
       60
       +
           leading_whitespace = true;

     

       61
       61
       +
           (* Start at beginning of stream *)

     

       54
       62
        
           document_has_content = false;

     

       55
       63
        
           adjacent_value_allowed_at = None;

     

       56
       64
        
           flow_mapping_stack = [];

     
···

       59
       67
        
       let of_string s = create (Input.of_string s)

     

       60
       68
        
       let of_input = create

     

       61
       69
        
       let of_reader r = create (Input.of_reader r)

     

       62
       62
       -
       

     

       63
       70
        
       let position t = Input.position t.input

     

       64
       71
        
       

     

       65
       72
        
       (** Add a token to the queue *)

     
···

       72
       79
        
       

     

       73
       80
        
       (** Get current indent level *)

     

       74
       81
        
       let current_indent t =

     

       75
       75
       -
         match t.indent_stack with

     

       76
       76
       -
         | [] -> -1

     

       77
       77
       -
         | { indent; _ } :: _ -> indent

     

       82
       82
       +
         match t.indent_stack with [] -> -1 | { indent; _ } :: _ -> indent

     

       78
       83
        
       

     

       79
       79
       -
       (** Skip whitespace to end of line, checking for valid comments.

     

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

     

       81
       86
        
       let skip_whitespace_and_comment t =

     

       82
       87
        
         let has_whitespace = ref false in

     

       83
       88
        
         (* Skip blanks (spaces and tabs) *)

     
···

       98
       103
        
                 Error.raise_at (Input.mark t.input) Invalid_comment

     

       99
       104
        
           end;

     

       100
       105
        
           (* Skip to end of line *)

     

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

     

       102
       107
        
             ignore (Input.next t.input)

     

       103
       108
        
           done

     

       104
       109
        
         end

     
···

       109
       114
        
         let found_space = ref false in

     

       110
       115
        
         while Input.next_is_blank t.input do

     

       111
       116
        
           (match Input.peek t.input with

     

       112
       112
       -
            | Some '\t' -> found_tab := true

     

       113
       113
       -
            | Some ' ' -> found_space := true

     

       114
       114
       -
            | _ -> ());

     

       117
       117
       +
           | Some '\t' -> found_tab := true

     

       118
       118
       +
           | Some ' ' -> found_space := true

     

       119
       119
       +
           | _ -> ());

     

       115
       120
        
           ignore (Input.next t.input)

     

       116
       121
        
         done;

     

       117
       122
        
         (!found_tab, !found_space)

     
···

       120
       125
        
       let rec skip_to_next_token t =

     

       121
       126
        
         (* Check for tabs used as indentation in block context *)

     

       122
       127
        
         (match Input.peek t.input with

     

       123
       123
       -
          | Some '\t' when t.flow_level = 0 && t.leading_whitespace &&

     

       124
       124
       -
                           (column t - 1) < current_indent t ->

     

       125
       125
       -
              (* Tab found in indentation zone - this is invalid *)

     

       126
       126
       -
              (* Skip to end of line to check if line has content *)

     

       127
       127
       -
              let start_pos = Input.mark t.input in

     

       128
       128
       -
              while Input.next_is_blank t.input do

     

       129
       129
       -
                ignore (Input.next t.input)

     

       130
       130
       -
              done;

     

       131
       131
       -
              (* If we have content on this line with a tab, raise error *)

     

       132
       132
       -
              if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then

     

       133
       133
       -
                Error.raise_at start_pos Tab_in_indentation

     

       134
       134
       -
          | _ -> ());

     

       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
       +
         | _ -> ());

     

       135
       141
        
       

     

       136
       142
        
         (* Skip blanks and validate comments *)

     

       137
       143
        
         skip_whitespace_and_comment t;

     
···

       158
       164
        
                 ignore (Input.next t.input)

     

       159
       165
        
               done;

     

       160
       166
        
               (* If only tabs were used (no spaces) and column < flow_indent, error *)

     

       161
       161
       -
               if not (Input.next_is_break t.input) && not (Input.is_eof t.input) &&

     

       162
       162
       -
                  column t < t.flow_indent then

     

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

     

       164
       172
        
             end;

     

       165
       173
        
             skip_to_next_token t

     

       166
       166
       -
           end else begin

     

       174
       174
       +
           end

     

       175
       175
       +
           else begin

     

       167
       176
        
             ignore (Input.next t.input);

     

       168
       177
        
             skip_to_next_token t

     

       169
       178
        
           end

     
···

       174
       183
        
         if t.flow_level = 0 && col > current_indent t then begin

     

       175
       184
        
           t.indent_stack <- { indent = col; needs_block_end = true } :: t.indent_stack;

     

       176
       185
        
           true

     

       177
       177
       -
         end else

     

       178
       178
       -
           false

     

       186
       186
       +
         end

     

       187
       187
       +
         else false

     

       179
       188
        
       

     

       180
       189
        
       (** Unroll indentation to given column *)

     

       181
       190
        
       let unroll_indent t col =

     

       182
       182
       -
         while t.flow_level = 0 &&

     

       183
       183
       -
               match t.indent_stack with

     

       184
       184
       -
               | { indent; needs_block_end = true; _ } :: _ when indent > col -> true

     

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

     

       186
       197
        
         do

     

       187
       198
        
           match t.indent_stack with

     

       188
       199
        
           | { indent = _; needs_block_end = true; _ } :: rest ->

     
···

       199
       210
        
           (* A simple key is required only if we're in a block context,

     

       200
       211
        
              at the current indentation level, AND the current indent needs a block end.

     

       201
       212
        
              This matches saphyr's logic and prevents false positives for values. *)

     

       202
       202
       -
           let required = t.flow_level = 0 &&

     

       203
       203
       -
                          match t.indent_stack with

     

       204
       204
       -
                          | { indent; needs_block_end = true; _ } :: _ ->

     

       205
       205
       -
                              indent = column t

     

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

     

       207
       219
        
           in

     

       208
       208
       -
           let sk = {

     

       209
       209
       -
             sk_possible = true;

     

       210
       210
       -
             sk_required = required;

     

       211
       211
       -
             sk_token_number = t.token_number;

     

       212
       212
       -
             sk_position = Input.position t.input;

     

       213
       213
       -
           } 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
       +
             }

     

       227
       227
       +
           in

     

       214
       228
        
           (* Remove any existing simple key at current level *)

     

       215
       215
       -
           t.simple_keys <- (

     

       216
       216
       -
             match t.simple_keys with

     

       229
       229
       +
           t.simple_keys <-

     

       230
       230
       +
             (match t.simple_keys with

     

       217
       231
        
             | _ :: rest -> Some sk :: rest

     

       218
       218
       -
             | [] -> [Some sk]

     

       219
       219
       -
           )

     

       232
       232
       +
             | [] -> [ Some sk ])

     

       220
       233
        
         end

     

       221
       234
        
       

     

       222
       235
        
       (** Remove simple key at current level *)

     
···

       229
       242
        
       

     

       230
       243
        
       (** Stale simple keys that span too many tokens *)

     

       231
       244
        
       let stale_simple_keys t =

     

       232
       232
       -
         t.simple_keys <- List.map (fun sk_opt ->

     

       233
       233
       -
           match sk_opt with

     

       234
       234
       -
           | Some sk when sk.sk_possible &&

     

       235
       235
       -
                          (Input.position t.input).line > sk.sk_position.line &&

     

       236
       236
       -
                          t.flow_level = 0 ->

     

       237
       237
       -
               if sk.sk_required then

     

       238
       238
       -
                 Error.raise_at sk.sk_position Expected_key;

     

       239
       239
       -
               None

     

       240
       240
       -
           | _ -> sk_opt

     

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

     

       242
       257
        
       

     

       243
       258
        
       (** Read anchor or alias name *)

     

       244
       259
        
       let scan_anchor_alias t =

     
···

       251
       266
        
            This matches the saphyr implementation: is_yaml_non_space && !is_flow *)

     

       252
       267
        
         while

     

       253
       268
        
           match Input.peek t.input with

     

       254
       254
       -
           | Some c when not (Input.is_whitespace c) &&

     

       255
       255
       -
                         not (Input.is_flow_indicator c) &&

     

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

     

       257
       273
        
               Buffer.add_char buf c;

     

       258
       274
        
               ignore (Input.next t.input);

     

       259
       275
        
               true

     

       260
       276
        
           | _ -> false

     

       261
       261
       -
         do () done;

     

       277
       277
       +
         do

     

       278
       278
       +
           ()

     

       279
       279
       +
         done;

     

       262
       280
        
         let name = Buffer.contents buf in

     

       263
       281
        
         if String.length name = 0 then

     

       264
       282
        
           Error.raise_at start (Invalid_anchor "empty anchor name");

     
···

       270
       288
        
         let buf = Buffer.create 16 in

     

       271
       289
        
         (* Expect ! *)

     

       272
       290
        
         (match Input.peek t.input with

     

       273
       273
       -
          | Some '!' ->

     

       274
       274
       -
              Buffer.add_char buf '!';

     

       275
       275
       -
              ignore (Input.next t.input)

     

       276
       276
       -
          | _ -> 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 '!'"));

     

       277
       295
        
         (* Read word chars *)

     

       278
       296
        
         while

     

       279
       297
        
           match Input.peek t.input with

     
···

       282
       300
        
               ignore (Input.next t.input);

     

       283
       301
        
               true

     

       284
       302
        
           | _ -> false

     

       285
       285
       -
         do () done;

     

       303
       303
       +
         do

     

       304
       304
       +
           ()

     

       305
       305
       +
         done;

     

       286
       306
        
         (* Check for secondary ! *)

     

       287
       307
        
         (match Input.peek t.input with

     

       288
       288
       -
          | Some '!' ->

     

       289
       289
       -
              Buffer.add_char buf '!';

     

       290
       290
       -
              ignore (Input.next t.input)

     

       291
       291
       -
          | _ -> ());

     

       308
       308
       +
         | Some '!' ->

     

       309
       309
       +
             Buffer.add_char buf '!';

     

       310
       310
       +
             ignore (Input.next t.input)

     

       311
       311
       +
         | _ -> ());

     

       292
       312
        
         Buffer.contents buf

     

       293
       313
        
       

     

       294
       314
        
       (** Scan tag suffix (after handle) *)

     
···

       298
       318
        
         in

     

       299
       319
        
         let hex_val c =

     

       300
       320
        
           match c with

     

       301
       301
       -
           | '0'..'9' -> Char.code c - Char.code '0'

     

       302
       302
       -
           | 'A'..'F' -> Char.code c - Char.code 'A' + 10

     

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

     

       304
       324
        
           | _ -> 0

     

       305
       325
        
         in

     

       306
       326
        
         let buf = Buffer.create 32 in

     

       307
       327
        
         while

     

       308
       328
        
           match Input.peek t.input with

     

       309
       309
       -
           | Some '%' ->

     

       329
       329
       +
           | Some '%' -> (

     

       310
       330
        
               (* Percent-encoded character *)

     

       311
       331
        
               ignore (Input.next t.input);

     

       312
       312
       -
               (match Input.peek t.input, Input.peek_nth t.input 1 with

     

       313
       313
       -
                | Some c1, Some c2 when is_hex_digit c1 && is_hex_digit c2 ->

     

       314
       314
       -
                    ignore (Input.next t.input);

     

       315
       315
       -
                    ignore (Input.next t.input);

     

       316
       316
       -
                    let code = (hex_val c1) * 16 + (hex_val c2) in

     

       317
       317
       -
                    Buffer.add_char buf (Char.chr code);

     

       318
       318
       -
                    true

     

       319
       319
       -
                | _ ->

     

       320
       320
       -
                    (* Invalid percent encoding - keep the % *)

     

       321
       321
       -
                    Buffer.add_char buf '%';

     

       322
       322
       -
                    true)

     

       323
       323
       -
           | Some c when not (Input.is_whitespace c) &&

     

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

     

       325
       345
        
               Buffer.add_char buf c;

     

       326
       346
        
               ignore (Input.next t.input);

     

       327
       347
        
               true

     

       328
       348
        
           | _ -> false

     

       329
       329
       -
         do () done;

     

       349
       349
       +
         do

     

       350
       350
       +
           ()

     

       351
       351
       +
         done;

     

       330
       352
        
         Buffer.contents buf

     

       331
       353
        
       

     

       332
       354
        
       (** Scan a tag *)

     

       333
       355
        
       let scan_tag t =

     

       334
       356
        
         let start = Input.mark t.input in

     

       335
       335
       -
         ignore (Input.next t.input); (* consume ! *)

     

       357
       357
       +
         ignore (Input.next t.input);

     

       358
       358
       +
         (* consume ! *)

     

       336
       359
        
         let handle, suffix =

     

       337
       360
        
           match Input.peek t.input with

     

       338
       361
        
           | Some '<' ->

     
···

       346
       369
        
                     Buffer.add_char buf c;

     

       347
       370
        
                     ignore (Input.next t.input);

     

       348
       371
        
                     true

     

       349
       349
       -
                 | None -> Error.raise_at (Input.mark t.input) (Invalid_tag "unclosed verbatim tag")

     

       350
       350
       -
               do () done;

     

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

     

       352
       380
        
               ("", Buffer.contents buf)

     

       353
       381
        
           | Some c when Input.is_whitespace c || Input.is_flow_indicator c ->

     

       354
       382
        
               (* Non-specific tag: ! *)

     

       355
       383
        
               ("!", "")

     

       356
       384
        
           | Some '!' ->

     

       357
       385
        
               (* Secondary handle: !! *)

     

       358
       358
       -
               ignore (Input.next t.input); (* consume second ! *)

     

       386
       386
       +
               ignore (Input.next t.input);

     

       387
       387
       +
               (* consume second ! *)

     

       359
       388
        
               let suffix = scan_tag_suffix t in

     

       360
       389
        
               ("!!", suffix)

     

       361
       361
       -
           | _ ->

     

       390
       390
       +
           | _ -> (

     

       362
       391
        
               (* Primary handle or just suffix: !foo or !e!foo *)

     

       363
       392
        
               (* Read alphanumeric characters *)

     

       364
       393
        
               let buf = Buffer.create 16 in

     
···

       369
       398
        
                     ignore (Input.next t.input);

     

       370
       399
        
                     true

     

       371
       400
        
                 | _ -> false

     

       372
       372
       -
               do () done;

     

       401
       401
       +
               do

     

       402
       402
       +
                 ()

     

       403
       403
       +
               done;

     

       373
       404
        
               (* Check if next character is ! - if so, this is a named handle *)

     

       374
       374
       -
               (match Input.peek t.input with

     

       375
       375
       -
                | Some '!' ->

     

       376
       376
       -
                    (* Named handle like !e! *)

     

       377
       377
       -
                    ignore (Input.next t.input);

     

       378
       378
       -
                    let handle_name = Buffer.contents buf in

     

       379
       379
       -
                    let suffix = scan_tag_suffix t in

     

       380
       380
       -
                    ("!" ^ handle_name ^ "!", suffix)

     

       381
       381
       -
                | _ ->

     

       382
       382
       -
                    (* Just ! followed by suffix *)

     

       383
       383
       -
                    ("!", 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))

     

       384
       415
        
         in

     

       385
       416
        
         (* Validate that tag is followed by whitespace, break, or (in flow) flow indicator *)

     

       386
       417
        
         (match Input.peek t.input with

     

       387
       387
       -
          | None -> ()  (* EOF is ok *)

     

       388
       388
       -
          | Some c when Input.is_whitespace c || Input.is_break c -> ()

     

       389
       389
       -
          | Some c when t.flow_level > 0 && Input.is_flow_indicator c -> ()

     

       390
       390
       -
          | _ -> 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"));

     

       391
       424
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       392
       425
        
         (handle, suffix, span)

     

       393
       426
        
       

     

       394
       427
        
       (** Scan single-quoted scalar *)

     

       395
       428
        
       let scan_single_quoted t =

     

       396
       429
        
         let start = Input.mark t.input in

     

       397
       397
       -
         ignore (Input.next t.input); (* consume opening single-quote *)

     

       430
       430
       +
         ignore (Input.next t.input);

     

       431
       431
       +
         (* consume opening single-quote *)

     

       398
       432
        
         let buf = Buffer.create 64 in

     

       399
       399
       -
         let whitespace = Buffer.create 16 in (* Track trailing whitespace *)

     

       433
       433
       +
         let whitespace = Buffer.create 16 in

     

       434
       434
       +
         (* Track trailing whitespace *)

     

       400
       435
        
       

     

       401
       436
        
         let flush_whitespace () =

     

       402
       437
        
           if Buffer.length whitespace > 0 then begin

     
···

       408
       443
        
         let rec loop () =

     

       409
       444
        
           match Input.peek t.input with

     

       410
       445
        
           | None -> Error.raise_at start Unclosed_single_quote

     

       411
       411
       -
           | Some '\'' ->

     

       446
       446
       +
           | Some '\'' -> (

     

       412
       447
        
               ignore (Input.next t.input);

     

       413
       448
        
               (* Check for escaped quote ('') *)

     

       414
       414
       -
               (match Input.peek t.input with

     

       415
       415
       -
                | Some '\'' ->

     

       416
       416
       -
                    flush_whitespace ();

     

       417
       417
       -
                    Buffer.add_char buf '\'';

     

       418
       418
       -
                    ignore (Input.next t.input);

     

       419
       419
       -
                    loop ()

     

       420
       420
       -
                | _ ->

     

       421
       421
       -
                    (* End of string - flush any trailing whitespace *)

     

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

     

       423
       458
        
           | Some ' ' | Some '\t' ->

     

       424
       459
        
               (* Track whitespace - don't add to buf yet *)

     

       425
       460
        
               Buffer.add_char whitespace (Option.get (Input.peek t.input));

     
···

       439
       474
        
               (* Check indentation: continuation must be > block indent (QB6E, DK95) *)

     

       440
       475
        
               let col = column t in

     

       441
       476
        
               let indent = current_indent t in

     

       442
       442
       -
               if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then

     

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

     

       444
       485
        
               (* Count empty lines (consecutive line breaks) *)

     

       445
       486
        
               let empty_lines = ref 0 in

     

       446
       487
        
               while Input.next_is_break t.input do

     
···

       454
       495
        
                 (* Check indentation after each empty line too *)

     

       455
       496
        
                 let col = column t in

     

       456
       497
        
                 let indent = current_indent t in

     

       457
       457
       -
                 if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then

     

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

     

       459
       506
        
               done;

     

       460
       507
        
               (* Apply folding rules *)

     

       461
       508
        
               if !empty_lines > 0 then begin

     
···

       463
       510
        
                 for _ = 1 to !empty_lines do

     

       464
       511
        
                   Buffer.add_char buf '\n'

     

       465
       512
        
                 done

     

       466
       466
       -
               end else

     

       513
       513
       +
               end

     

       514
       514
       +
               else

     

       467
       515
        
                 (* Single break: fold to space (even at start of string) *)

     

       468
       516
        
                 Buffer.add_char buf ' ';

     

       469
       517
        
               loop ()

     
···

       486
       534
        
           | Some c when Input.is_hex c ->

     

       487
       535
        
               Buffer.add_char buf c;

     

       488
       536
        
               ignore (Input.next t.input)

     

       489
       489
       -
           | _ ->

     

       490
       490
       -
               Error.raise_at start (Invalid_hex_escape (Buffer.contents buf))

     

       537
       537
       +
           | _ -> Error.raise_at start (Invalid_hex_escape (Buffer.contents buf))

     

       491
       538
        
         done;

     

       492
       539
        
         let code = int_of_string ("0x" ^ Buffer.contents buf) in

     

       493
       493
       -
         if code <= 0x7F then

     

       494
       494
       -
           String.make 1 (Char.chr code)

     

       540
       540
       +
         if code <= 0x7F then String.make 1 (Char.chr code)

     

       495
       541
        
         else if code <= 0x7FF then

     

       496
       542
        
           let b1 = 0xC0 lor (code lsr 6) in

     

       497
       543
        
           let b2 = 0x80 lor (code land 0x3F) in

     
···

       500
       546
        
           let b1 = 0xE0 lor (code lsr 12) in

     

       501
       547
        
           let b2 = 0x80 lor ((code lsr 6) land 0x3F) in

     

       502
       548
        
           let b3 = 0x80 lor (code land 0x3F) in

     

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

     

       504
       551
        
         else

     

       505
       552
        
           let b1 = 0xF0 lor (code lsr 18) in

     

       506
       553
        
           let b2 = 0x80 lor ((code lsr 12) land 0x3F) in

     

       507
       554
        
           let b3 = 0x80 lor ((code lsr 6) land 0x3F) in

     

       508
       555
        
           let b4 = 0x80 lor (code land 0x3F) in

     

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

     

       510
       558
        
       

     

       511
       559
        
       (** Scan double-quoted scalar *)

     

       512
       560
        
       let scan_double_quoted t =

     

       513
       561
        
         let start = Input.mark t.input in

     

       514
       514
       -
         ignore (Input.next t.input); (* consume opening double-quote *)

     

       562
       562
       +
         ignore (Input.next t.input);

     

       563
       563
       +
         (* consume opening double-quote *)

     

       515
       564
        
         let buf = Buffer.create 64 in

     

       516
       516
       -
         let whitespace = Buffer.create 16 in  (* Track pending whitespace *)

     

       565
       565
       +
         let whitespace = Buffer.create 16 in

     

       566
       566
       +
         (* Track pending whitespace *)

     

       517
       567
        
       

     

       518
       568
        
         let flush_whitespace () =

     

       519
       569
        
           if Buffer.length whitespace > 0 then begin

     
···

       529
       579
        
               (* Flush trailing whitespace before closing quote to preserve it *)

     

       530
       580
        
               flush_whitespace ();

     

       531
       581
        
               ignore (Input.next t.input)

     

       532
       532
       -
           | Some ' ' | Some '\t' as c_opt ->

     

       582
       582
       +
           | (Some ' ' | Some '\t') as c_opt ->

     

       533
       583
        
               (* Track whitespace - don't add to buf yet *)

     

       534
       584
        
               let c = match c_opt with Some c -> c | None -> assert false in

     

       535
       585
        
               Buffer.add_char whitespace c;

     
···

       537
       587
        
               loop ()

     

       538
       588
        
           | Some '\\' ->

     

       539
       589
        
               (* Escape sequence - this is non-whitespace content *)

     

       540
       540
       -
               flush_whitespace ();  (* Commit any pending whitespace *)

     

       590
       590
       +
               flush_whitespace ();

     

       591
       591
       +
               (* Commit any pending whitespace *)

     

       541
       592
        
               ignore (Input.next t.input);

     

       542
       593
        
               (match Input.peek t.input with

     

       543
       543
       -
                | None -> Error.raise_at start (Invalid_escape_sequence "\\<EOF>")

     

       544
       544
       -
                | Some '0' -> Buffer.add_char buf '\x00'; ignore (Input.next t.input)

     

       545
       545
       -
                | Some 'a' -> Buffer.add_char buf '\x07'; ignore (Input.next t.input)

     

       546
       546
       -
                | Some 'b' -> Buffer.add_char buf '\x08'; ignore (Input.next t.input)

     

       547
       547
       -
                | Some 't' | Some '\t' -> Buffer.add_char buf '\t'; ignore (Input.next t.input)

     

       548
       548
       -
                | Some 'n' -> Buffer.add_char buf '\n'; ignore (Input.next t.input)

     

       549
       549
       -
                | Some 'v' -> Buffer.add_char buf '\x0B'; ignore (Input.next t.input)

     

       550
       550
       -
                | Some 'f' -> Buffer.add_char buf '\x0C'; ignore (Input.next t.input)

     

       551
       551
       -
                | Some 'r' -> Buffer.add_char buf '\r'; ignore (Input.next t.input)

     

       552
       552
       -
                | Some 'e' -> Buffer.add_char buf '\x1B'; ignore (Input.next t.input)

     

       553
       553
       -
                | Some ' ' -> Buffer.add_char buf ' '; ignore (Input.next t.input)

     

       554
       554
       -
                | Some '"' -> Buffer.add_char buf '"'; ignore (Input.next t.input)

     

       555
       555
       -
                | Some '/' -> Buffer.add_char buf '/'; ignore (Input.next t.input)

     

       556
       556
       -
                | Some '\\' -> Buffer.add_char buf '\\'; ignore (Input.next t.input)

     

       557
       557
       -
                | Some 'N' -> Buffer.add_string buf "\xC2\x85"; ignore (Input.next t.input) (* NEL *)

     

       558
       558
       -
                | Some '_' -> Buffer.add_string buf "\xC2\xA0"; ignore (Input.next t.input) (* NBSP *)

     

       559
       559
       -
                | Some 'L' -> Buffer.add_string buf "\xE2\x80\xA8"; ignore (Input.next t.input) (* LS *)

     

       560
       560
       -
                | Some 'P' -> Buffer.add_string buf "\xE2\x80\xA9"; ignore (Input.next t.input) (* PS *)

     

       561
       561
       -
                | Some 'x' ->

     

       562
       562
       -
                    ignore (Input.next t.input);

     

       563
       563
       -
                    Buffer.add_string buf (decode_hex t 2)

     

       564
       564
       -
                | Some 'u' ->

     

       565
       565
       -
                    ignore (Input.next t.input);

     

       566
       566
       -
                    Buffer.add_string buf (decode_hex t 4)

     

       567
       567
       -
                | Some 'U' ->

     

       568
       568
       -
                    ignore (Input.next t.input);

     

       569
       569
       -
                    Buffer.add_string buf (decode_hex t 8)

     

       570
       570
       -
                | Some '\n' | Some '\r' ->

     

       571
       571
       -
                    (* Line continuation escape *)

     

       572
       572
       -
                    Input.consume_break t.input;

     

       573
       573
       -
                    while Input.next_is_blank t.input do

     

       574
       574
       -
                      ignore (Input.next t.input)

     

       575
       575
       -
                    done

     

       576
       576
       -
                | Some c ->

     

       577
       577
       -
                    Error.raise_at (Input.mark t.input)

     

       578
       578
       -
                      (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)));

     

       579
       664
        
               loop ()

     

       580
       665
        
           | Some '\n' | Some '\r' ->

     

       581
       666
        
               (* Line break: discard any pending trailing whitespace *)

     
···

       596
       681
        
                 if Input.next_is_break t.input then begin

     

       597
       682
        
                   Input.consume_break t.input;

     

       598
       683
        
                   incr empty_lines;

     

       599
       599
       -
                   started_with_tab := false  (* Reset for next line *)

     

       600
       600
       -
                 end else

     

       601
       601
       -
                   continue := false

     

       684
       684
       +
                   started_with_tab := false (* Reset for next line *)

     

       685
       685
       +
                 end

     

       686
       686
       +
                 else continue := false

     

       602
       687
        
               done;

     

       603
       688
        
               (* Check for document boundary - this terminates the quoted string *)

     

       604
       689
        
               if Input.at_document_boundary t.input then

     
···

       609
       694
        
               let indent = current_indent t in

     

       610
       695
        
               let start_col = start.column in

     

       611
       696
        
               (* DK95/01: if continuation started with tabs and column < start column, error *)

     

       612
       612
       -
               if not (Input.is_eof t.input) && !started_with_tab && col < start_col then

     

       613
       613
       -
                 Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar");

     

       614
       614
       -
               if not (Input.is_eof t.input) && col <= indent && indent >= 0 then

     

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

     

       616
       706
        
               (* Per YAML spec: single break = space, break + empty lines = newlines *)

     

       617
       707
        
               if !empty_lines > 0 then begin

     

       618
       708
        
                 (* Empty lines: output N newlines where N = number of empty lines *)

     

       619
       709
        
                 for _ = 1 to !empty_lines do

     

       620
       710
        
                   Buffer.add_char buf '\n'

     

       621
       711
        
                 done

     

       622
       622
       -
               end else

     

       712
       712
       +
               end

     

       713
       713
       +
               else

     

       623
       714
        
                 (* Single break folds to space *)

     

       624
       715
        
                 Buffer.add_char buf ' ';

     

       625
       716
        
               loop ()

     

       626
       717
        
           | Some c ->

     

       627
       718
        
               (* Non-whitespace character *)

     

       628
       628
       -
               flush_whitespace ();  (* Commit any pending whitespace *)

     

       719
       719
       +
               flush_whitespace ();

     

       720
       720
       +
               (* Commit any pending whitespace *)

     

       629
       721
        
               Buffer.add_char buf c;

     

       630
       722
        
               ignore (Input.next t.input);

     

       631
       723
        
               loop ()

     
···

       637
       729
        
       (** Check if character can appear in plain scalar at this position *)

     

       638
       730
        
       let can_continue_plain t c ~in_flow =

     

       639
       731
        
         match c with

     

       640
       640
       -
         | ':' ->

     

       732
       732
       +
         | ':' -> (

     

       641
       733
        
             (* : is OK if not followed by whitespace or flow indicator *)

     

       642
       642
       -
             (match Input.peek_nth t.input 1 with

     

       643
       643
       -
              | None -> true

     

       644
       644
       -
              | Some c2 when Input.is_whitespace c2 -> false

     

       645
       645
       -
              | Some c2 when in_flow && Input.is_flow_indicator c2 -> false

     

       646
       646
       -
              | _ -> true)

     

       647
       647
       -
         | '#' ->

     

       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
       +
         | '#' -> (

     

       648
       740
        
             (* # is a comment indicator only if preceded by whitespace *)

     

       649
       741
        
             (* Check the previous character to determine if this is a comment *)

     

       650
       650
       -
             (match Input.peek_back t.input with

     

       651
       651
       -
              | None -> true  (* At start - can't be comment indicator, allow it *)

     

       652
       652
       -
              | Some c when Input.is_whitespace c -> false  (* Preceded by whitespace - comment *)

     

       653
       653
       -
              | Some c when Input.is_break c -> false  (* At start of line - comment *)

     

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

     

       655
       748
        
         | c when in_flow && Input.is_flow_indicator c -> false

     

       656
       749
        
         | _ when Input.is_break c -> false

     

       657
       750
        
         | _ -> true

     
···

       663
       756
        
         let indent = current_indent t in

     

       664
       757
        
         (* In flow context, scalars must be indented more than the current block indent.

     

       665
       758
        
            This ensures that content at block indent or less ends the flow context. *)

     

       666
       666
       -
         if in_flow && (column t - 1) < indent then

     

       759
       759
       +
         if in_flow && column t - 1 < indent then

     

       667
       760
        
           Error.raise_at start Invalid_flow_indentation;

     

       668
       761
        
         let buf = Buffer.create 64 in

     

       669
       762
        
         let spaces = Buffer.create 16 in

     

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

     

       671
       765
        
         let leading_blanks = ref false in

     

       672
       766
        
       

     

       673
       767
        
         let rec scan_line () =

     
···

       684
       778
        
                 if Buffer.length spaces > 0 then begin

     

       685
       779
        
                   if !leading_blanks then begin

     

       686
       780
        
                     (* Fold line break *)

     

       687
       687
       -
                     if Buffer.contents spaces = "\n" then

     

       688
       688
       -
                       Buffer.add_char buf ' '

     

       781
       781
       +
                     if Buffer.contents spaces = "\n" then Buffer.add_char buf ' '

     

       689
       782
        
                     else begin

     

       690
       783
        
                       (* Multiple breaks - preserve all but first *)

     

       691
       784
        
                       let s = Buffer.contents spaces in

     

       692
       785
        
                       Buffer.add_substring buf s 1 (String.length s - 1)

     

       693
       786
        
                     end

     

       694
       694
       -
                   end else

     

       695
       695
       -
                     Buffer.add_buffer buf spaces;

     

       787
       787
       +
                   end

     

       788
       788
       +
                   else Buffer.add_buffer buf spaces;

     

       696
       789
        
                   Buffer.clear spaces

     

       697
       790
        
                 end;

     

       698
       791
        
                 (* Add any pending whitespace from within the line *)

     
···

       719
       812
        
             if !leading_blanks then begin

     

       720
       813
        
               (* We already had a break - this is an additional break (empty line) *)

     

       721
       814
        
               Buffer.add_char spaces '\n'

     

       722
       722
       -
             end else begin

     

       815
       815
       +
             end

     

       816
       816
       +
             else begin

     

       723
       817
        
               (* First line break *)

     

       724
       818
        
               Buffer.clear spaces;

     

       725
       819
        
               Buffer.add_char spaces '\n';

     
···

       739
       833
        
             (* However, allow empty lines (line breaks) to continue even if dedented *)

     

       740
       834
        
             if Input.next_is_break t.input then

     

       741
       835
        
               scan_lines () (* Empty line - continue *)

     

       742
       742
       -
             else if not in_flow && col <= indent then

     

       743
       743
       -
               () (* Stop - dedented or at parent level in block context *)

     

       744
       744
       -
             else if Input.at_document_boundary t.input then

     

       745
       745
       -
               () (* Stop - document boundary *)

     

       746
       746
       -
             else

     

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

     

       748
       841
        
           end

     

       749
       842
        
         in

     

       750
       843
        
       

     
···

       755
       848
        
           let len = String.length value in

     

       756
       849
        
           let rec find_end i =

     

       757
       850
        
             if i < 0 then 0

     

       758
       758
       -
             else match value.[i] with

     

       759
       759
       -
               | ' ' | '\t' -> find_end (i - 1)

     

       760
       760
       -
               | _ -> i + 1

     

       851
       851
       +
             else match value.[i] with ' ' | '\t' -> find_end (i - 1) | _ -> i + 1

     

       761
       852
        
           in

     

       762
       853
        
           let end_pos = find_end (len - 1) in

     

       763
       854
        
           String.sub value 0 end_pos

     
···

       769
       860
        
       (** Scan block scalar (literal | or folded >) *)

     

       770
       861
        
       let scan_block_scalar t literal =

     

       771
       862
        
         let start = Input.mark t.input in

     

       772
       772
       -
         ignore (Input.next t.input); (* consume | or > *)

     

       863
       863
       +
         ignore (Input.next t.input);

     

       864
       864
       +
       

     

       865
       865
       +
         (* consume | or > *)

     

       773
       866
        
       

     

       774
       867
        
         (* Parse header: optional indentation indicator and chomping *)

     

       775
       868
        
         let explicit_indent = ref None in

     
···

       777
       870
        
       

     

       778
       871
        
         (* First character of header *)

     

       779
       872
        
         (match Input.peek t.input with

     

       780
       780
       -
          | Some c when Input.is_digit c && c <> '0' ->

     

       781
       781
       -
              explicit_indent := Some (Char.code c - Char.code '0');

     

       782
       782
       -
              ignore (Input.next t.input)

     

       783
       783
       -
          | Some '-' -> chomping := Chomping.Strip; ignore (Input.next t.input)

     

       784
       784
       -
          | Some '+' -> chomping := Chomping.Keep; ignore (Input.next t.input)

     

       785
       785
       -
          | _ -> ());

     

       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
       +
         | _ -> ());

     

       786
       883
        
       

     

       787
       884
        
         (* Second character of header *)

     

       788
       885
        
         (match Input.peek t.input with

     

       789
       789
       -
          | Some c when Input.is_digit c && c <> '0' && !explicit_indent = None ->

     

       790
       790
       -
              explicit_indent := Some (Char.code c - Char.code '0');

     

       791
       791
       -
              ignore (Input.next t.input)

     

       792
       792
       -
          | Some '-' when !chomping = Chomping.Clip ->

     

       793
       793
       -
              chomping := Chomping.Strip; ignore (Input.next t.input)

     

       794
       794
       -
          | Some '+' when !chomping = Chomping.Clip ->

     

       795
       795
       -
              chomping := Chomping.Keep; ignore (Input.next t.input)

     

       796
       796
       -
          | _ -> ());

     

       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
       +
         | _ -> ());

     

       797
       896
        
       

     

       798
       897
        
         (* Skip whitespace and optional comment *)

     

       799
       898
        
         skip_whitespace_and_comment t;

     

       800
       899
        
       

     

       801
       900
        
         (* Consume line break *)

     

       802
       802
       -
         if Input.next_is_break t.input then

     

       803
       803
       -
           Input.consume_break t.input

     

       901
       901
       +
         if Input.next_is_break t.input then Input.consume_break t.input

     

       804
       902
        
         else if not (Input.is_eof t.input) then

     

       805
       903
        
           Error.raise_at (Input.mark t.input)

     

       806
       904
        
             (Invalid_block_scalar_header "expected newline after header");

     
···

       808
       906
        
         let base_indent = current_indent t in

     

       809
       907
        
         (* base_indent is the indent level from the stack, -1 if empty.

     

       810
       908
        
            It's used directly for comparisons in implicit indent case. *)

     

       811
       811
       -
         let content_indent = ref (

     

       812
       812
       -
           match !explicit_indent with

     

       813
       813
       -
           | Some n ->

     

       814
       814
       -
               (* 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.

     

       815
       914
        
                  content_indent = (base_indent - 1) + n, but at least n for document level. *)

     

       816
       816
       -
               let base_level = max 0 (base_indent - 1) in

     

       817
       817
       -
               base_level + n

     

       818
       818
       -
           | None -> 0  (* Will be determined by first non-empty line *)

     

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

     

       820
       919
        
       

     

       821
       920
        
         let buf = Buffer.create 256 in

     

       822
       921
        
         let trailing_breaks = Buffer.create 16 in

     

       823
       823
       -
         let leading_blank = ref false in  (* Was the previous line "more indented"? *)

     

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

     

       825
       926
        
       

     

       826
       927
        
         (* Skip to content indentation, skipping empty lines.

     

       827
       928
        
            Returns the number of spaces actually skipped (important for detecting dedentation). *)

     
···

       829
       930
        
           if !content_indent > 0 then begin

     

       830
       931
        
             (* Explicit indent - skip up to content_indent spaces *)

     

       831
       932
        
             let spaces_skipped = ref 0 in

     

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

     

       833
       936
        
               incr spaces_skipped;

     

       834
       937
        
               ignore (Input.next t.input)

     

       835
       938
        
             done;

     
···

       840
       943
        
               Buffer.add_char trailing_breaks '\n';

     

       841
       944
        
               Input.consume_break t.input;

     

       842
       945
        
               skip_to_content_indent ()

     

       843
       843
       -
             end else if !spaces_skipped < !content_indent then begin

     

       946
       946
       +
             end

     

       947
       947
       +
             else if !spaces_skipped < !content_indent then begin

     

       844
       948
        
               (* Line starts with fewer spaces than content_indent - dedented *)

     

       845
       949
        
               !spaces_skipped

     

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

     

       847
       952
        
               (* Line has spaces/tabs beyond content_indent - could be whitespace content or empty line.

     

       848
       953
        
                  For literal scalars, whitespace-only lines ARE content (not empty).

     

       849
       954
        
                  For folded scalars, whitespace-only lines that are "more indented" are preserved. *)

     
···

       853
       958
        
               else begin

     

       854
       959
        
                 (* Folded: check if rest is only blanks *)

     

       855
       960
        
                 let idx = ref 0 in

     

       856
       856
       -
                 while match Input.peek_nth t.input !idx with

     

       857
       857
       -
                       | Some c when Input.is_blank c -> incr idx; true

     

       858
       858
       -
                       | _ -> false

     

       859
       859
       -
                 do () done;

     

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

     

       861
       971
        
                 | None | Some '\n' | Some '\r' ->

     

       862
       972
        
                     (* Empty/whitespace-only line in folded - skip spaces *)

     

       863
       973
        
                     while Input.next_is_blank t.input do

     
···

       870
       980
        
                     (* Has non-whitespace content *)

     

       871
       981
        
                     !content_indent

     

       872
       982
        
               end

     

       873
       873
       -
             end else

     

       874
       874
       -
               !content_indent

     

       875
       875
       -
           end else begin

     

       983
       983
       +
             end

     

       984
       984
       +
             else !content_indent

     

       985
       985
       +
           end

     

       986
       986
       +
           else begin

     

       876
       987
        
             (* Implicit indent - skip empty lines without consuming spaces.

     

       877
       988
        
                Note: Only SPACES count as indentation. Tabs are content, not indentation.

     

       878
       989
        
                So we only check for spaces when determining if a line is "empty". *)

     
···

       880
       991
        
               Buffer.add_char trailing_breaks '\n';

     

       881
       992
        
               Input.consume_break t.input;

     

       882
       993
        
               skip_to_content_indent ()

     

       883
       883
       -
             end else if Input.next_is (( = ) ' ') t.input then begin

     

       994
       994
       +
             end

     

       995
       995
       +
             else if Input.next_is (( = ) ' ') t.input then begin

     

       884
       996
        
               (* Check if line is empty (only spaces before break) *)

     

       885
       997
        
               let idx = ref 0 in

     

       886
       886
       -
               while match Input.peek_nth t.input !idx with

     

       887
       887
       -
                     | Some ' ' -> incr idx; true

     

       888
       888
       -
                     | _ -> false

     

       889
       889
       -
               do () done;

     

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

     

       891
       1008
        
               | None | Some '\n' | Some '\r' ->

     

       892
       1009
        
                   (* Line has only spaces - empty line *)

     

       893
       1010
        
                   (* Track max indent of empty lines for later validation *)

     

       894
       894
       -
                   if !idx > !max_empty_line_indent then

     

       895
       895
       -
                     max_empty_line_indent := !idx;

     

       1011
       1011
       +
                   if !idx > !max_empty_line_indent then max_empty_line_indent := !idx;

     

       896
       1012
        
                   while Input.next_is (( = ) ' ') t.input do

     

       897
       1013
        
                     ignore (Input.next t.input)

     

       898
       1014
        
                   done;

     
···

       902
       1018
        
               | _ ->

     

       903
       1019
        
                   (* Has content (including tabs which are content, not indentation) *)

     

       904
       1020
        
                   0

     

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

     

       906
       1023
        
               (* Tab at start of line in implicit indent mode - this is an error (Y79Y)

     

       907
       1024
        
                  because tabs cannot be used as indentation in YAML *)

     

       908
       1025
        
               Error.raise_at (Input.mark t.input) Tab_in_indentation

     

       909
       909
       -
             end else

     

       1026
       1026
       +
             end

     

       1027
       1027
       +
             else

     

       910
       1028
        
               (* Not at break or space - other content character *)

     

       911
       1029
        
               0

     

       912
       1030
        
           end

     
···

       938
       1056
        
             let should_process =

     

       939
       1057
        
               if !content_indent = 0 then begin

     

       940
       1058
        
                 (* For implicit indent, content must be more indented than base_level. *)

     

       941
       941
       -
                 if line_indent <= base_level then

     

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

     

       943
       1061
        
                 else begin

     

       944
       1062
        
                   (* Validate: first content line must be indented at least as much as

     

       945
       1063
        
                      the maximum indent seen on empty lines before it (5LLU, S98Z, W9L4) *)

     

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

     

       947
       1066
        
                     Error.raise_at (Input.mark t.input)

     

       948
       948
       -
                       (Invalid_block_scalar_header "wrongly indented line in block scalar");

     

       1067
       1067
       +
                       (Invalid_block_scalar_header

     

       1068
       1068
       +
                          "wrongly indented line in block scalar");

     

       949
       1069
        
                   content_indent := line_indent;

     

       950
       1070
        
                   true

     

       951
       1071
        
                 end

     

       952
       952
       -
               end else if line_indent < !content_indent then

     

       953
       953
       -
                 false  (* Dedented - done with content *)

     

       954
       954
       -
               else

     

       955
       955
       -
                 true

     

       1072
       1072
       +
               end

     

       1073
       1073
       +
               else if line_indent < !content_indent then false

     

       1074
       1074
       +
                 (* Dedented - done with content *)

     

       1075
       1075
       +
               else true

     

       956
       1076
        
             in

     

       957
       1077
        
       

     

       958
       1078
        
             if should_process then begin

     
···

       960
       1080
        
                  For folded scalars, lines that start with any whitespace (space or tab) after the

     

       961
       1081
        
                  content indentation are "more indented" and preserve breaks.

     

       962
       1082
        
                  Note: we check Input.next_is_blank BEFORE reading content to see if content starts with whitespace. *)

     

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

     

       964
       1086
        
       

     

       965
       1087
        
               (* Add trailing breaks to buffer *)

     

       966
       1088
        
               if Buffer.length buf > 0 then begin

     

       967
       1089
        
                 if Buffer.length trailing_breaks > 0 then begin

     

       968
       968
       -
                   if literal then

     

       969
       969
       -
                     Buffer.add_buffer buf trailing_breaks

     

       1090
       1090
       +
                   if literal then Buffer.add_buffer buf trailing_breaks

     

       970
       1091
        
                   else begin

     

       971
       1092
        
                     (* Folded scalar: fold only if both previous and current lines are not more-indented *)

     

       972
       972
       -
                     if not !leading_blank && not trailing_blank then begin

     

       1093
       1093
       +
                     if (not !leading_blank) && not trailing_blank then begin

     

       973
       1094
        
                       let breaks = Buffer.contents trailing_breaks in

     

       974
       974
       -
                       if String.length breaks = 1 then

     

       975
       975
       -
                         Buffer.add_char buf ' '

     

       976
       976
       -
                       else

     

       977
       977
       -
                         Buffer.add_substring buf breaks 1 (String.length breaks - 1)

     

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

     

       979
       1099
        
                       (* Preserve breaks for more-indented lines *)

     

       980
       1100
        
                       Buffer.add_buffer buf trailing_breaks

     

       981
       1101
        
                     end

     

       982
       1102
        
                   end

     

       983
       983
       -
                 end else if not literal then

     

       984
       984
       -
                   Buffer.add_char buf ' '

     

       985
       985
       -
               end else

     

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

     

       987
       1107
        
               Buffer.clear trailing_breaks;

     

       988
       1108
        
       

     

       989
       1109
        
               (* Add extra indentation for literal or more-indented folded lines *)

     

       990
       1110
        
               (* On the first line (when determining content_indent), we've already consumed all spaces,

     

       991
       1111
        
                  so we should NOT add any back. On subsequent lines, we add only the spaces beyond content_indent. *)

     

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

     

       993
       1114
        
                 for _ = 1 to !extra_spaces do

     

       994
       1115
        
                   Buffer.add_char buf ' '

     

       995
       1116
        
                 done

     

       996
       1117
        
               end;

     

       997
       1118
        
       

     

       998
       1119
        
               (* Read line content *)

     

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

     

       1000
       1123
        
                 Buffer.add_char buf (Input.next_exn t.input)

     

       1001
       1124
        
               done;

     

       1002
       1125
        
       

     
···

       1023
       1146
        
           | Chomping.Strip -> content

     

       1024
       1147
        
           | Chomping.Clip ->

     

       1025
       1148
        
               if String.length content > 0 then content ^ "\n" else content

     

       1026
       1026
       -
           | Chomping.Keep ->

     

       1027
       1027
       -
               content ^ Buffer.contents trailing_breaks

     

       1149
       1149
       +
           | Chomping.Keep -> content ^ Buffer.contents trailing_breaks

     

       1028
       1150
        
         in

     

       1029
       1151
        
       

     

       1030
       1152
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     
···

       1034
       1156
        
       (** Scan directive (after %) *)

     

       1035
       1157
        
       let scan_directive t =

     

       1036
       1158
        
         let start = Input.mark t.input in

     

       1037
       1037
       -
         ignore (Input.next t.input); (* consume % *)

     

       1159
       1159
       +
         ignore (Input.next t.input);

     

       1160
       1160
       +
       

     

       1161
       1161
       +
         (* consume % *)

     

       1038
       1162
        
       

     

       1039
       1163
        
         (* Read directive name *)

     

       1040
       1164
        
         let name_buf = Buffer.create 16 in

     
···

       1045
       1169
        
               ignore (Input.next t.input);

     

       1046
       1170
        
               true

     

       1047
       1171
        
           | _ -> false

     

       1048
       1048
       -
         do () done;

     

       1172
       1172
       +
         do

     

       1173
       1173
       +
           ()

     

       1174
       1174
       +
         done;

     

       1049
       1175
        
         let name = Buffer.contents name_buf in

     

       1050
       1176
        
       

     

       1051
       1177
        
         (* Skip blanks *)

     
···

       1060
       1186
        
             let minor = ref 0 in

     

       1061
       1187
        
             (* Read major version *)

     

       1062
       1188
        
             while Input.next_is_digit t.input do

     

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

     

       1064
       1191
        
             done;

     

       1065
       1192
        
             (* Expect . *)

     

       1066
       1193
        
             (match Input.peek t.input with

     

       1067
       1067
       -
              | Some '.' -> ignore (Input.next t.input)

     

       1068
       1068
       -
              | _ -> 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 '.'"));

     

       1069
       1198
        
             (* Read minor version *)

     

       1070
       1199
        
             while Input.next_is_digit t.input do

     

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

     

       1072
       1202
        
             done;

     

       1073
       1203
        
             (* Validate: only whitespace and comments allowed before line break (MUS6) *)

     

       1074
       1204
        
             skip_whitespace_and_comment t;

     

       1075
       1075
       -
             if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then

     

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

     

       1077
       1208
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1078
       1078
       -
             Token.Version_directive { major = !major; minor = !minor }, span

     

       1079
       1079
       -
       

     

       1209
       1209
       +
             (Token.Version_directive { major = !major; minor = !minor }, span)

     

       1080
       1210
        
         | "TAG" ->

     

       1081
       1211
        
             (* Tag directive: %TAG !foo! tag:example.com,2000: *)

     

       1082
       1212
        
             let handle = scan_tag_handle t in

     
···

       1093
       1223
        
                   ignore (Input.next t.input);

     

       1094
       1224
        
                   true

     

       1095
       1225
        
               | _ -> false

     

       1096
       1096
       -
             do () done;

     

       1226
       1226
       +
             do

     

       1227
       1227
       +
               ()

     

       1228
       1228
       +
             done;

     

       1097
       1229
        
             let prefix = Buffer.contents prefix_buf in

     

       1098
       1230
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1099
       1099
       -
             Token.Tag_directive { handle; prefix }, span

     

       1100
       1100
       -
       

     

       1231
       1231
       +
             (Token.Tag_directive { handle; prefix }, span)

     

       1101
       1232
        
         | _ ->

     

       1102
       1233
        
             (* Reserved/Unknown directive - skip to end of line and ignore *)

     

       1103
       1234
        
             (* Per YAML spec, reserved directives should be ignored with a warning *)

     

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

     

       1105
       1236
        
               ignore (Input.next t.input)

     

       1106
       1237
        
             done;

     

       1107
       1238
        
             let span = Span.make ~start ~stop:(Input.mark t.input) in

     

       1108
       1239
        
             (* Return an empty tag directive token to indicate directive was processed but ignored *)

     

       1109
       1109
       -
             Token.Tag_directive { handle = ""; prefix = "" }, span

     

       1240
       1240
       +
             (Token.Tag_directive { handle = ""; prefix = "" }, span)

     

       1110
       1241
        
       

     

       1111
       1242
        
       (** Fetch the next token(s) into the queue *)

     

       1112
       1243
        
       let rec fetch_next_token t =

     
···

       1120
       1251
        
         (* We're about to process actual content, not leading whitespace *)

     

       1121
       1252
        
         t.leading_whitespace <- false;

     

       1122
       1253
        
       

     

       1123
       1123
       -
         if Input.is_eof t.input then

     

       1124
       1124
       -
           fetch_stream_end t

     

       1125
       1125
       -
         else if Input.at_document_boundary t.input then

     

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

     

       1127
       1256
        
         else begin

     

       1128
       1257
        
           match Input.peek t.input with

     

       1129
       1258
        
           | None -> fetch_stream_end t

     

       1130
       1130
       -
           | Some '%' when (Input.position t.input).column = 1 ->

     

       1131
       1131
       -
               fetch_directive t

     

       1259
       1259
       +
           | Some '%' when (Input.position t.input).column = 1 -> fetch_directive t

     

       1132
       1260
        
           | Some '[' -> fetch_flow_collection_start t Token.Flow_sequence_start

     

       1133
       1261
        
           | Some '{' -> fetch_flow_collection_start t Token.Flow_mapping_start

     

       1134
       1262
        
           | Some ']' -> fetch_flow_collection_end t Token.Flow_sequence_end

     
···

       1136
       1264
        
           | Some ',' -> fetch_flow_entry t

     

       1137
       1265
        
           | Some '-' when t.flow_level = 0 && check_block_entry t ->

     

       1138
       1266
        
               fetch_block_entry t

     

       1139
       1139
       -
           | Some '?' when check_key t ->

     

       1140
       1140
       -
               fetch_key t

     

       1141
       1141
       -
           | Some ':' when check_value t ->

     

       1142
       1142
       -
               fetch_value t

     

       1267
       1267
       +
           | Some '?' when check_key t -> fetch_key t

     

       1268
       1268
       +
           | Some ':' when check_value t -> fetch_value t

     

       1143
       1269
        
           | Some '*' -> fetch_alias t

     

       1144
       1270
        
           | Some '&' -> fetch_anchor t

     

       1145
       1271
        
           | Some '!' -> fetch_tag t

     
···

       1147
       1273
        
           | Some '>' when t.flow_level = 0 -> fetch_block_scalar t false

     

       1148
       1274
        
           | Some '\'' -> fetch_single_quoted t

     

       1149
       1275
        
           | Some '"' -> fetch_double_quoted t

     

       1150
       1150
       -
           | Some '-' when can_start_plain t ->

     

       1151
       1151
       -
               fetch_plain_scalar t

     

       1152
       1152
       -
           | Some '?' when can_start_plain t ->

     

       1153
       1153
       -
               fetch_plain_scalar t

     

       1154
       1154
       -
           | Some ':' when can_start_plain t ->

     

       1155
       1155
       -
               fetch_plain_scalar t

     

       1156
       1156
       -
           | Some c when can_start_plain_char c t ->

     

       1157
       1157
       -
               fetch_plain_scalar t

     

       1158
       1158
       -
           | Some c ->

     

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

     

       1160
       1281
        
         end

     

       1161
       1282
        
       

     

       1162
       1283
        
       and fetch_stream_end t =

     
···

       1177
       1298
        
         let indicator = Input.peek_string t.input 3 in

     

       1178
       1299
        
         Input.skip t.input 3;

     

       1179
       1300
        
         let span = Span.make ~start ~stop:(Input.mark t.input) in

     

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

     

       1181
       1304
        
         (* Reset document content flag after document end marker *)

     

       1182
       1305
        
         if indicator = "..." then begin

     

       1183
       1306
        
           t.document_has_content <- false;

     

       1184
       1307
        
           (* After document end marker, skip whitespace and check for end of line or comment *)

     

       1185
       1185
       -
           while Input.next_is_blank t.input do ignore (Input.next t.input) done;

     

       1186
       1186
       -
           (match Input.peek t.input with

     

       1187
       1187
       -
            | None -> ()  (* EOF is ok *)

     

       1188
       1188
       -
            | Some c when Input.is_break c -> ()

     

       1189
       1189
       -
            | Some '#' -> ()  (* Comment is ok *)

     

       1190
       1190
       -
            | _ -> 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")

     

       1191
       1319
        
         end;

     

       1192
       1320
        
         emit t span token

     

       1193
       1321
        
       

     
···

       1198
       1326
        
            If we've emitted content in the current document, we need a document end marker first *)

     

       1199
       1327
        
         if t.document_has_content then

     

       1200
       1328
        
           Error.raise_at (Input.mark t.input)

     

       1201
       1201
       -
             (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 (...)");

     

       1202
       1332
        
         unroll_indent t (-1);

     

       1203
       1333
        
         remove_simple_key t;

     

       1204
       1334
        
         t.allow_simple_key <- false;

     
···

       1208
       1338
        
       and fetch_flow_collection_start t token_type =

     

       1209
       1339
        
         save_simple_key t;

     

       1210
       1340
        
         (* Record indent of outermost flow collection *)

     

       1211
       1211
       -
         if t.flow_level = 0 then

     

       1212
       1212
       -
           t.flow_indent <- column t;

     

       1341
       1341
       +
         if t.flow_level = 0 then t.flow_indent <- column t;

     

       1213
       1342
        
         t.flow_level <- t.flow_level + 1;

     

       1214
       1343
        
         (* Track whether this is a mapping or sequence *)

     

       1215
       1215
       -
         let is_mapping = (token_type = Token.Flow_mapping_start) in

     

       1344
       1344
       +
         let is_mapping = token_type = Token.Flow_mapping_start in

     

       1216
       1345
        
         t.flow_mapping_stack <- is_mapping :: t.flow_mapping_stack;

     

       1217
       1346
        
         t.allow_simple_key <- true;

     

       1218
       1347
        
         t.simple_keys <- None :: t.simple_keys;

     
···

       1225
       1354
        
       and fetch_flow_collection_end t token_type =

     

       1226
       1355
        
         remove_simple_key t;

     

       1227
       1356
        
         t.flow_level <- t.flow_level - 1;

     

       1228
       1228
       -
         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 | [] -> []);

     

       1229
       1359
        
         t.simple_keys <- (match t.simple_keys with _ :: rest -> rest | [] -> []);

     

       1230
       1360
        
         t.allow_simple_key <- false;

     

       1231
       1361
        
         let start = Input.mark t.input in

     
···

       1270
       1400
        
         ignore (Input.next t.input);

     

       1271
       1401
        
       

     

       1272
       1402
        
         (* Check for tabs after - : pattern like -\t- is invalid *)

     

       1273
       1273
       -
         let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in

     

       1403
       1403
       +
         let found_tabs, _found_spaces = skip_blanks_check_tabs t in

     

       1274
       1404
        
         if found_tabs then begin

     

       1275
       1405
        
           (* If we found tabs and next char is - followed by whitespace, error *)

     

       1276
       1406
        
           match Input.peek t.input with

     

       1277
       1277
       -
           | Some '-' ->

     

       1278
       1278
       -
               (match Input.peek_nth t.input 1 with

     

       1279
       1279
       -
                | None -> Error.raise_at start Tab_in_indentation

     

       1280
       1280
       -
                | Some c when Input.is_whitespace c ->

     

       1281
       1281
       -
                    Error.raise_at start Tab_in_indentation

     

       1282
       1282
       -
                | 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 _ -> ())

     

       1283
       1413
        
           | _ -> ()

     

       1284
       1414
        
         end;

     

       1285
       1415
        
       

     
···

       1289
       1419
        
       and check_key t =

     

       1290
       1420
        
         (* ? followed by whitespace or flow indicator in both block and flow *)

     

       1291
       1421
        
         match Input.peek_nth t.input 1 with

     

       1292
       1292
       -
           | None -> true

     

       1293
       1293
       -
           | Some c ->

     

       1294
       1294
       -
               Input.is_whitespace c ||

     

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

     

       1296
       1425
        
       

     

       1297
       1426
        
       and fetch_key t =

     

       1298
       1427
        
         if t.flow_level = 0 then begin

     
···

       1311
       1440
        
         ignore (Input.next t.input);

     

       1312
       1441
        
       

     

       1313
       1442
        
         (* Check for tabs after ? : pattern like ?\t- or ?\tkey is invalid *)

     

       1314
       1314
       -
         let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in

     

       1443
       1443
       +
         let found_tabs, _found_spaces = skip_blanks_check_tabs t in

     

       1315
       1444
        
         if found_tabs && t.flow_level = 0 then begin

     

       1316
       1445
        
           (* In block context, tabs after ? are not allowed *)

     

       1317
       1446
        
           Error.raise_at start Tab_in_indentation

     
···

       1324
       1453
        
         (* : followed by whitespace in block, or whitespace/flow indicator in flow, or adjacent value *)

     

       1325
       1454
        
         match Input.peek_nth t.input 1 with

     

       1326
       1455
        
         | None -> true

     

       1327
       1327
       -
         | Some c ->

     

       1328
       1328
       -
             Input.is_whitespace c ||

     

       1329
       1329
       -
             (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
       +
             ||

     

       1330
       1460
        
             (* Allow adjacent values in flow context at designated positions *)

     

       1331
       1331
       -
             (t.flow_level > 0 &&

     

       1332
       1332
       -
              match t.adjacent_value_allowed_at with

     

       1333
       1333
       -
              | Some pos -> pos.Position.line = (Input.position t.input).Position.line &&

     

       1334
       1334
       -
                            pos.Position.column = (Input.position t.input).Position.column

     

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

     

       1336
       1468
        
       

     

       1337
       1469
        
       and fetch_value t =

     

       1338
       1470
        
         let start = Input.mark t.input in

     
···

       1342
       1474
        
           | Some sk :: _ when sk.sk_possible ->

     

       1343
       1475
        
               (* In implicit flow mapping (inside a flow sequence), key and : must be on the same line.

     

       1344
       1476
        
                  In explicit flow mapping { }, key and : can span lines. *)

     

       1345
       1345
       -
               let is_implicit_flow_mapping = match t.flow_mapping_stack with

     

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

     

       1347
       1481
        
                 | _ -> false

     

       1348
       1482
        
               in

     

       1349
       1349
       -
               if is_implicit_flow_mapping && sk.sk_position.line < (Input.position t.input).line then

     

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

     

       1351
       1487
        
               (* Insert KEY token before the simple key value *)

     

       1352
       1488
        
               let key_span = Span.point sk.sk_position in

     

       1353
       1489
        
               let key_token = { Token.token = Token.Key; span = key_span } in

     
···

       1355
       1491
        
               let tokens = Queue.to_seq t.tokens |> Array.of_seq in

     

       1356
       1492
        
               Queue.clear t.tokens;

     

       1357
       1493
        
               let insert_pos = sk.sk_token_number - t.tokens_taken in

     

       1358
       1358
       -
               Array.iteri (fun i tok ->

     

       1359
       1359
       -
                 if i = insert_pos then Queue.add key_token t.tokens;

     

       1360
       1360
       -
                 Queue.add tok t.tokens

     

       1361
       1361
       -
               ) tokens;

     

       1362
       1362
       -
               if insert_pos >= Array.length tokens then

     

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

     

       1364
       1500
        
               t.token_number <- t.token_number + 1;

     

       1365
       1501
        
               (* Roll indent for implicit block mapping *)

     

       1366
       1502
        
               if t.flow_level = 0 then begin

     
···

       1371
       1507
        
                   let bm_token = { Token.token = Token.Block_mapping_start; span } in

     

       1372
       1508
        
                   let tokens = Queue.to_seq t.tokens |> Array.of_seq in

     

       1373
       1509
        
                   Queue.clear t.tokens;

     

       1374
       1374
       -
                   Array.iteri (fun i tok ->

     

       1375
       1375
       -
                     if i = insert_pos then Queue.add bm_token t.tokens;

     

       1376
       1376
       -
                     Queue.add tok t.tokens

     

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

     

       1378
       1515
        
                   if insert_pos >= Array.length tokens then

     

       1379
       1516
        
                     Queue.add bm_token t.tokens;

     

       1380
       1517
        
                   t.token_number <- t.token_number + 1

     

       1381
       1518
        
                 end

     

       1382
       1519
        
               end;

     

       1383
       1383
       -
               t.simple_keys <- None :: (List.tl t.simple_keys);

     

       1520
       1520
       +
               t.simple_keys <- None :: List.tl t.simple_keys;

     

       1384
       1521
        
               true

     

       1385
       1522
        
           | _ ->

     

       1386
       1523
        
               (* No simple key - this is a complex value (or empty key) *)

     
···

       1400
       1537
        
         remove_simple_key t;

     

       1401
       1538
        
         (* In block context without simple key, allow simple keys for compact mappings like ": moon: white"

     

       1402
       1539
        
            In flow context or after using a simple key, disallow simple keys *)

     

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

     

       1404
       1541
        
         t.document_has_content <- true;

     

       1405
       1542
        
         let start = Input.mark t.input in

     

       1406
       1543
        
         ignore (Input.next t.input);

     

       1407
       1544
        
       

     

       1408
       1545
        
         (* Check for tabs after : : patterns like :\t- or :\tkey: are invalid in block context (Y79Y/09)

     

       1409
       1546
        
            However, :\t bar (tab followed by space then content) is valid (6BCT) *)

     

       1410
       1410
       -
         let (found_tabs, found_spaces) = skip_blanks_check_tabs t in

     

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

     

       1412
       1549
        
           (* In block context, tabs-only after : followed by indicator or alphanumeric are not allowed *)

     

       1413
       1550
        
           match Input.peek t.input with

     

       1414
       1414
       -
           | Some ('-' | '?') ->

     

       1415
       1415
       -
               Error.raise_at start Tab_in_indentation

     

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

     

       1417
       1556
        
               (* Tab-only followed by alphanumeric - likely a key, which is invalid *)

     

       1418
       1557
        
               Error.raise_at start Tab_in_indentation

     

       1419
       1558
        
           | _ -> ()

     
···

       1430
       1569
        
         t.allow_simple_key <- false;

     

       1431
       1570
        
         t.document_has_content <- true;

     

       1432
       1571
        
         let start = Input.mark t.input in

     

       1433
       1433
       -
         ignore (Input.next t.input); (* consume * or & *)

     

       1572
       1572
       +
         ignore (Input.next t.input);

     

       1573
       1573
       +
         (* consume * or & *)

     

       1434
       1574
        
         let name, span = scan_anchor_alias t in

     

       1435
       1575
        
         let span = Span.make ~start ~stop:span.stop in

     

       1436
       1576
        
         let token = if is_alias then Token.Alias name else Token.Anchor name in

     
···

       1475
       1615
        
         match Input.peek_nth t.input 1 with

     

       1476
       1616
        
         | None -> false

     

       1477
       1617
        
         | Some c ->

     

       1478
       1478
       -
             not (Input.is_whitespace c) &&

     

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

     

       1480
       1620
        
       

     

       1481
       1621
        
       and can_start_plain_char c _t =

     

       1482
       1622
        
         (* Characters that can start a plain scalar *)

     
···

       1492
       1632
        
         (* If the plain scalar ended after crossing a line break (leading_blanks = true),

     

       1493
       1633
        
            allow simple keys. This is important because the scanner already consumed the

     

       1494
       1634
        
            line break and leading whitespace when checking for continuation. *)

     

       1495
       1495
       -
         if ended_with_linebreak then

     

       1496
       1496
       -
           t.allow_simple_key <- true;

     

       1635
       1635
       +
         if ended_with_linebreak then t.allow_simple_key <- true;

     

       1497
       1636
        
         emit t span (Token.Scalar { style = `Plain; value })

     

       1498
       1637
        
       

     

       1499
       1638
        
       (** Check if we need more tokens to resolve simple keys *)

     
···

       1502
       1641
        
         else if Queue.is_empty t.tokens then true

     

       1503
       1642
        
         else

     

       1504
       1643
        
           (* Check if any simple key could affect the first queued token *)

     

       1505
       1505
       -
           List.exists (function

     

       1506
       1506
       -
             | Some sk when sk.sk_possible ->

     

       1507
       1507
       -
                 sk.sk_token_number >= t.tokens_taken

     

       1508
       1508
       -
             | _ -> false

     

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

     

       1510
       1649
        
       

     

       1511
       1650
        
       (** Ensure we have enough tokens to return one safely *)

     

       1512
       1651
        
       let ensure_tokens t =

     
···

       1523
       1662
        
       (** Get next token *)

     

       1524
       1663
        
       let next t =

     

       1525
       1664
        
         ensure_tokens t;

     

       1526
       1526
       -
         if Queue.is_empty t.tokens then

     

       1527
       1527
       -
           None

     

       1665
       1665
       +
         if Queue.is_empty t.tokens then None

     

       1528
       1666
        
         else begin

     

       1529
       1667
        
           t.tokens_taken <- t.tokens_taken + 1;

     

       1530
       1668
        
           Some (Queue.pop t.tokens)

     
···

       1540
       1678
        
         let rec loop () =

     

       1541
       1679
        
           match next t with

     

       1542
       1680
        
           | None -> ()

     

       1543
       1543
       -
           | Some tok -> f tok; loop ()

     

       1681
       1681
       +
           | Some tok ->

     

       1682
       1682
       +
               f tok;

     

       1683
       1683
       +
               loop ()

     

       1544
       1684
        
         in

     

       1545
       1685
        
         loop ()

     

       1546
       1686
        
       

     

       1547
       1687
        
       (** Fold over all tokens *)

     

       1548
       1688
        
       let fold f init t =

     

       1549
       1689
        
         let rec loop acc =

     

       1550
       1550
       -
           match next t with

     

       1551
       1551
       -
           | None -> acc

     

       1552
       1552
       -
           | Some tok -> loop (f acc tok)

     

       1690
       1690
       +
           match next t with None -> acc | Some tok -> loop (f acc tok)

     

       1553
       1691
        
         in

     

       1554
       1692
        
         loop init

     

       1555
       1693
        
       

     

       1556
       1694
        
       (** Convert to list *)

     

       1557
       1557
       -
       let to_list t =

     

       1558
       1558
       -
         fold (fun acc tok -> tok :: acc) [] t |> List.rev

     

       1695
       1695
       +
       let to_list t = fold (fun acc tok -> tok :: acc) [] t |> List.rev

+20 -28

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 =

     
···

       51
       39
        
         Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;

     

       52
       40
        
         Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;

     

       53
       41
        
         Format.fprintf fmt "members=[@,%a@]@,)"

     

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

     

       55
       45
        
           t.members

     

       56
       46
        
       

     

       57
       47
        
       let equal eq a b =

     

       58
       58
       -
         Option.equal String.equal a.anchor b.anchor &&

     

       59
       59
       -
         Option.equal String.equal a.tag b.tag &&

     

       60
       60
       -
         a.implicit = b.implicit &&

     

       61
       61
       -
         Layout_style.equal a.style b.style &&

     

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

     

       63
       53
        
       

     

       64
       54
        
       let compare cmp a b =

     

       65
       55
        
         let c = Option.compare String.compare a.anchor b.anchor in

     

       66
       66
       -
         if c <> 0 then c else

     

       67
       67
       -
         let c = Option.compare String.compare a.tag b.tag in

     

       68
       68
       -
         if c <> 0 then c else

     

       69
       69
       -
         let c = Bool.compare a.implicit b.implicit in

     

       70
       70
       -
         if c <> 0 then c else

     

       71
       71
       -
         let c = Layout_style.compare a.style b.style in

     

       72
       72
       -
         if c <> 0 then c else

     

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

+166 -139

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
       31
        
             (* Force flow style for empty sequences *)

     

       33
       32
        
             let style = if members = [] then `Flow else Sequence.style seq in

     

       34
       34
       -
             emit (Event.Sequence_start {

     

       35
       35
       -
               anchor = Sequence.anchor seq;

     

       36
       36
       -
               tag = Sequence.tag seq;

     

       37
       37
       -
               implicit = Sequence.implicit seq;

     

       38
       38
       -
               style;

     

       39
       39
       -
             });

     

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

     

       40
       41
        
             List.iter (emit_yaml_node_impl ~emit) members;

     

       41
       42
        
             emit Event.Sequence_end

     

       42
       42
       -
       

     

       43
       43
        
         | `O map ->

     

       44
       44
        
             let members = Mapping.members map in

     

       45
       45
        
             (* Force flow style for empty mappings *)

     

       46
       46
        
             let style = if members = [] then `Flow else Mapping.style map in

     

       47
       47
       -
             emit (Event.Mapping_start {

     

       48
       48
       -
               anchor = Mapping.anchor map;

     

       49
       49
       -
               tag = Mapping.tag map;

     

       50
       50
       -
               implicit = Mapping.implicit map;

     

       51
       51
       -
               style;

     

       52
       52
       -
             });

     

       53
       53
       -
             List.iter (fun (k, v) ->

     

       54
       54
       -
               emit_yaml_node_impl ~emit k;

     

       55
       55
       -
               emit_yaml_node_impl ~emit v

     

       56
       56
       -
             ) members;

     

       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;

     

       57
       60
        
             emit Event.Mapping_end

     

       58
       61
        
       

     

       59
       59
       -
       (** Emit a Value node using an emit function.

     

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

     

       61
       64
        
       let rec emit_value_node_impl ~emit ~config (value : Value.t) =

     

       62
       65
        
         match value with

     

       63
       66
        
         | `Null ->

     

       64
       64
       -
             emit (Event.Scalar {

     

       65
       65
       -
               anchor = None; tag = None;

     

       66
       66
       -
               value = "null";

     

       67
       67
       -
               plain_implicit = true; quoted_implicit = false;

     

       68
       68
       -
               style = `Plain;

     

       69
       69
       -
             })

     

       70
       70
       -
       

     

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

     

       71
       77
        
         | `Bool b ->

     

       72
       72
       -
             emit (Event.Scalar {

     

       73
       73
       -
               anchor = None; tag = None;

     

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

     

       75
       75
       -
               plain_implicit = true; quoted_implicit = false;

     

       76
       76
       -
               style = `Plain;

     

       77
       77
       -
             })

     

       78
       78
       -
       

     

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

     

       79
       88
        
         | `Float f ->

     

       80
       89
        
             let value =

     

       81
       90
        
               match Float.classify_float f with

     
···

       84
       93
        
               | _ ->

     

       85
       94
        
                   if Float.is_integer f && Float.abs f < 1e15 then

     

       86
       95
        
                     Printf.sprintf "%.0f" f

     

       87
       87
       -
                   else

     

       88
       88
       -
                     Printf.sprintf "%g" f

     

       96
       96
       +
                   else Printf.sprintf "%g" f

     

       89
       97
        
             in

     

       90
       90
       -
             emit (Event.Scalar {

     

       91
       91
       -
               anchor = None; tag = None;

     

       92
       92
       -
               value;

     

       93
       93
       -
               plain_implicit = true; quoted_implicit = false;

     

       94
       94
       -
               style = `Plain;

     

       95
       95
       -
             })

     

       96
       96
       -
       

     

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

     

       97
       108
        
         | `String s ->

     

       98
       109
        
             let style = Quoting.choose_style s in

     

       99
       99
       -
             emit (Event.Scalar {

     

       100
       100
       -
               anchor = None; tag = None;

     

       101
       101
       -
               value = s;

     

       102
       102
       -
               plain_implicit = style = `Plain;

     

       103
       103
       -
               quoted_implicit = style <> `Plain;

     

       104
       104
       -
               style;

     

       105
       105
       -
             })

     

       106
       106
       -
       

     

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

     

       107
       120
        
         | `A items ->

     

       108
       121
        
             (* Force flow style for empty sequences, otherwise use config *)

     

       109
       122
        
             let style =

     

       110
       123
        
               if items = [] || config.Emitter.layout_style = `Flow then `Flow else `Block

     

       111
       124
        
             in

     

       112
       112
       -
             emit (Event.Sequence_start {

     

       113
       113
       -
               anchor = None; tag = None;

     

       114
       114
       -
               implicit = true;

     

       115
       115
       -
               style;

     

       116
       116
       -
             });

     

       125
       125
       +
             emit

     

       126
       126
       +
               (Event.Sequence_start

     

       127
       127
       +
                  { anchor = None; tag = None; implicit = true; style });

     

       117
       128
        
             List.iter (emit_value_node_impl ~emit ~config) items;

     

       118
       129
        
             emit Event.Sequence_end

     

       119
       119
       -
       

     

       120
       130
        
         | `O pairs ->

     

       121
       131
        
             (* Force flow style for empty mappings, otherwise use config *)

     

       122
       132
        
             let style =

     

       123
       133
        
               if pairs = [] || config.Emitter.layout_style = `Flow then `Flow else `Block

     

       124
       134
        
             in

     

       125
       125
       -
             emit (Event.Mapping_start {

     

       126
       126
       -
               anchor = None; tag = None;

     

       127
       127
       -
               implicit = true;

     

       128
       128
       -
               style;

     

       129
       129
       -
             });

     

       130
       130
       -
             List.iter (fun (k, v) ->

     

       131
       131
       -
               let style = Quoting.choose_style k in

     

       132
       132
       -
               emit (Event.Scalar {

     

       133
       133
       -
                 anchor = None; tag = None;

     

       134
       134
       -
                 value = k;

     

       135
       135
       -
                 plain_implicit = style = `Plain;

     

       136
       136
       -
                 quoted_implicit = style <> `Plain;

     

       137
       137
       -
                 style;

     

       138
       138
       -
               });

     

       139
       139
       -
               emit_value_node_impl ~emit ~config v

     

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

     

       141
       153
        
             emit Event.Mapping_end

     

       142
       154
        
       

     

       143
       155
        
       (** Strip anchors from a YAML tree (used when resolving aliases for output) *)

     
···

       146
       158
        
         | `Scalar s ->

     

       147
       159
        
             if Option.is_none (Scalar.anchor s) then yaml

     

       148
       160
        
             else

     

       149
       149
       -
               `Scalar (Scalar.make

     

       150
       150
       -
                 ?tag:(Scalar.tag s)

     

       151
       151
       -
                 ~plain_implicit:(Scalar.plain_implicit s)

     

       152
       152
       -
                 ~quoted_implicit:(Scalar.quoted_implicit s)

     

       153
       153
       -
                 ~style:(Scalar.style s)

     

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

     

       155
       166
        
         | `Alias _ -> yaml

     

       156
       167
        
         | `A seq ->

     

       157
       157
       -
             `A (Sequence.make

     

       158
       158
       -
               ?tag:(Sequence.tag seq)

     

       159
       159
       -
               ~implicit:(Sequence.implicit seq)

     

       160
       160
       -
               ~style:(Sequence.style seq)

     

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

     

       162
       172
        
         | `O map ->

     

       163
       163
       -
             `O (Mapping.make

     

       164
       164
       -
               ?tag:(Mapping.tag map)

     

       165
       165
       -
               ~implicit:(Mapping.implicit map)

     

       166
       166
       -
               ~style:(Mapping.style map)

     

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

     

       168
       179
        
       

     

       169
       180
        
       (** Emit a document using an emit function *)

     

       170
       181
        
       let emit_document_impl ?(resolve_aliases = true) ~emit doc =

     

       171
       171
       -
         emit (Event.Document_start {

     

       172
       172
       -
           version = Document.version doc;

     

       173
       173
       -
           implicit = Document.implicit_start doc;

     

       174
       174
       -
         });

     

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

     

       175
       188
        
         (match Document.root doc with

     

       176
       176
       -
          | Some yaml ->

     

       177
       177
       -
              let yaml = if resolve_aliases then

     

       178
       178
       -
                yaml |> Yaml.resolve_aliases |> strip_anchors

     

       179
       179
       -
              else yaml in

     

       180
       180
       -
              emit_yaml_node_impl ~emit yaml

     

       181
       181
       -
          | None ->

     

       182
       182
       -
              emit (Event.Scalar {

     

       183
       183
       -
                anchor = None; tag = None;

     

       184
       184
       -
                value = "";

     

       185
       185
       -
                plain_implicit = true; quoted_implicit = false;

     

       186
       186
       -
                style = `Plain;

     

       187
       187
       -
              }));

     

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

     

       188
       206
        
         emit (Event.Document_end { implicit = Document.implicit_end doc })

     

       189
       207
        
       

     

       190
       208
        
       (** {1 Emitter.t-based API} *)

     

       191
       209
        
       

     

       192
       210
        
       (** Emit a YAML node to an emitter *)

     

       193
       193
       -
       let emit_yaml_node t yaml =

     

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

     

       195
       212
        
       

     

       196
       213
        
       (** Emit a complete YAML document to an emitter *)

     

       197
       214
        
       let emit_yaml t yaml =

     
···

       249
       266
        
       (** Serialize documents to a buffer.

     

       250
       267
        
       

     

       251
       268
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

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

     

       253
       271
        
           @param buffer Optional buffer to append to; creates new one if not provided

     

       254
       272
        
           @return The buffer containing serialized YAML *)

     

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

     

       256
       275
        
         let buf = Option.value buffer ~default:(Buffer.create 1024) in

     

       257
       276
        
         let t = Emitter.create ~config () in

     

       258
       277
        
         Emitter.emit t (Event.Stream_start { encoding = config.encoding });

     
···

       278
       297
        
       (** Serialize documents to a string.

     

       279
       298
        
       

     

       280
       299
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       281
       281
       -
           @param resolve_aliases Whether to resolve aliases before emission (default: true) *)

     

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

     

       283
       304
        
         Buffer.contents (documents_to_buffer ~config ~resolve_aliases documents)

     

       284
       305
        
       

     

       285
       306
        
       (** {1 Writer-based API}

     

       286
       307
        
       

     

       287
       287
       -
           These functions write directly to a bytesrw [Bytes.Writer.t],

     

       288
       288
       -
           enabling true streaming output without intermediate string allocation.

     

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

     

       290
       311
        
       

     

       291
       312
        
       (** Serialize a Value directly to a Bytes.Writer.

     

       292
       313
        
       

     

       293
       314
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       294
       294
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

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

     

       296
       319
        
         let t = Emitter.of_writer ~config writer in

     

       297
       320
        
         emit_value t value;

     

       298
       321
        
         if eod then Emitter.flush t

     
···

       300
       323
        
       (** Serialize a Yaml.t directly to a Bytes.Writer.

     

       301
       324
        
       

     

       302
       325
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       303
       303
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

       304
       304
       -
       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
       +
           =

     

       305
       330
        
         let t = Emitter.of_writer ~config writer in

     

       306
       331
        
         emit_yaml t yaml;

     

       307
       332
        
         if eod then Emitter.flush t

     
···

       309
       334
        
       (** Serialize documents directly to a Bytes.Writer.

     

       310
       335
        
       

     

       311
       336
        
           @param config Emitter configuration (default: {!Emitter.default_config})

     

       312
       312
       -
           @param resolve_aliases Whether to resolve aliases before emission (default: true)

     

       313
       313
       -
           @param eod Whether to write end-of-data after serialization (default: true) *)

     

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

     

       315
       343
        
         let t = Emitter.of_writer ~config writer in

     

       316
       344
        
         Emitter.emit t (Event.Stream_start { encoding = config.encoding });

     

       317
       345
        
         List.iter (emit_document ~resolve_aliases t) documents;

     
···

       320
       348
        
       

     

       321
       349
        
       (** {1 Function-based API}

     

       322
       350
        
       

     

       323
       323
       -
           These functions accept an emit function [Event.t -> unit] instead of

     

       324
       324
       -
           an {!Emitter.t}, allowing them to work with any event sink

     

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

     

       326
       354
        
       

     

       327
       355
        
       (** Emit a YAML node using an emitter function *)

     

       328
       328
       -
       let emit_yaml_node_fn ~emitter yaml =

     

       329
       329
       -
         emit_yaml_node_impl ~emit:emitter yaml

     

       356
       356
       +
       let emit_yaml_node_fn ~emitter yaml = emit_yaml_node_impl ~emit:emitter yaml

     

       330
       357
        
       

     

       331
       358
        
       (** Emit a complete YAML stream using an emitter function *)

     

       332
       359
        
       let emit_yaml_fn ~emitter ~config yaml =

+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

+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

+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

+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

+115 -102

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

     
···

       112
       118
        
               (* Register anchor after we have the resolved node *)

     

       113
       119
        
               Option.iter (fun name -> register_anchor name v) (Scalar.anchor s);

     

       114
       120
        
               v

     

       115
       115
       -
           | `Alias name ->

     

       116
       116
       -
               expand_alias ~depth name

     

       121
       121
       +
           | `Alias name -> expand_alias ~depth name

     

       117
       122
        
           | `A seq ->

     

       118
       123
        
               (* First resolve all members in order *)

     

       119
       119
       -
               let resolved_members = List.map (resolve ~depth) (Sequence.members seq) in

     

       120
       120
       -
               let resolved = `A (Sequence.make

     

       121
       121
       -
                 ?anchor:(Sequence.anchor seq)

     

       122
       122
       -
                 ?tag:(Sequence.tag seq)

     

       123
       123
       -
                 ~implicit:(Sequence.implicit seq)

     

       124
       124
       -
                 ~style:(Sequence.style seq)

     

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

     

       126
       133
        
               (* Register anchor with resolved node *)

     

       127
       134
        
               Option.iter (fun name -> register_anchor name resolved) (Sequence.anchor seq);

     

       128
       135
        
               resolved

     

       129
       136
        
           | `O map ->

     

       130
       137
        
               (* Process key-value pairs in document order *)

     

       131
       131
       -
               let resolved_pairs = List.map (fun (k, v) ->

     

       132
       132
       -
                 let resolved_k = resolve ~depth k in

     

       133
       133
       -
                 let resolved_v = resolve ~depth v in

     

       134
       134
       -
                 (resolved_k, resolved_v)

     

       135
       135
       -
               ) (Mapping.members map) in

     

       136
       136
       -
               let resolved = `O (Mapping.make

     

       137
       137
       -
                 ?anchor:(Mapping.anchor map)

     

       138
       138
       -
                 ?tag:(Mapping.tag map)

     

       139
       139
       -
                 ~implicit:(Mapping.implicit map)

     

       140
       140
       -
                 ~style:(Mapping.style map)

     

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

     

       142
       152
        
               (* Register anchor with resolved node *)

     

       143
       153
        
               Option.iter (fun name -> register_anchor name resolved) (Mapping.anchor map);

     

       144
       154
        
               resolved

     
···

       153
       163
        
       

     

       154
       164
        
         (* If explicitly tagged, respect the tag *)

     

       155
       165
        
         match tag with

     

       156
       156
       -
         | Some "tag:yaml.org,2002:null" | Some "!!null" ->

     

       157
       157
       -
             `Null

     

       158
       158
       -
         | Some "tag:yaml.org,2002:bool" | Some "!!bool" ->

     

       159
       159
       -
             (match String.lowercase_ascii value with

     

       160
       160
       -
              | "true" | "yes" | "on" -> `Bool true

     

       161
       161
       -
              | "false" | "no" | "off" -> `Bool false

     

       162
       162
       -
              | _ -> Error.raise (Invalid_scalar_conversion (value, "bool")))

     

       163
       163
       -
         | Some "tag:yaml.org,2002:int" | Some "!!int" ->

     

       164
       164
       -
             (try `Float (Float.of_string value)

     

       165
       165
       -
              with _ -> Error.raise (Invalid_scalar_conversion (value, "int")))

     

       166
       166
       -
         | Some "tag:yaml.org,2002:float" | Some "!!float" ->

     

       167
       167
       -
             (try `Float (Float.of_string value)

     

       168
       168
       -
              with _ -> Error.raise (Invalid_scalar_conversion (value, "float")))

     

       169
       169
       -
         | Some "tag:yaml.org,2002:str" | Some "!!str" ->

     

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

     

       171
       179
        
         | Some _ ->

     

       172
       180
        
             (* Unknown tag - treat as string *)

     

       173
       181
        
             `String value

     

       174
       182
        
         | None ->

     

       175
       183
        
             (* Implicit type resolution for plain scalars *)

     

       176
       176
       -
             if style <> `Plain then

     

       177
       177
       -
               `String value

     

       178
       178
       -
             else

     

       179
       179
       -
               infer_scalar_type value

     

       184
       184
       +
             if style <> `Plain then `String value else infer_scalar_type value

     

       180
       185
        
       

     

       181
       186
        
       (** Infer type from plain scalar value *)

     

       182
       187
        
       and infer_scalar_type value =

     
···

       208
       213
        
             else if (first = '-' || first = '+') && len >= 2 then

     

       209
       214
        
               let second = value.[1] in

     

       210
       215
        
               (* After sign, must be digit or dot-digit (for +.5, -.5) *)

     

       211
       211
       -
               second >= '0' && second <= '9' ||

     

       212
       212
       -
               (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')

     

       213
       218
        
             else false

     

       214
       219
        
         in

     

       215
       220
        
         (* Try integer/float *)

     
···

       231
       236
        
                 | _ ->

     

       232
       237
        
                     (* Decimal with leading zero or octal in YAML 1.1 *)

     

       233
       238
        
                     Some (`Float (Float.of_string value))

     

       234
       234
       -
               else

     

       235
       235
       -
                 Some (`Float (Float.of_string value))

     

       239
       239
       +
               else Some (`Float (Float.of_string value))

     

       236
       240
        
             with _ -> None

     

       237
       241
        
           else None

     

       238
       242
        
         in

     
···

       244
       248
        
                OCaml accepts "nan", "inf", "infinity" which are NOT valid YAML floats.

     

       245
       249
        
                YAML requires the leading dot: .nan, .inf, -.inf

     

       246
       250
        
                See: https://github.com/avsm/ocaml-yaml/issues/82 *)

     

       247
       247
       -
             if String.length value >= 2 && value.[0] = '.' &&

     

       248
       248
       -
                value.[1] >= '0' && value.[1] <= '9' then

     

       249
       249
       -
               try `Float (Float.of_string value)

     

       250
       250
       -
               with _ -> `String value

     

       251
       251
       -
             else

     

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

     

       253
       258
        
       

     

       254
       259
        
       (** Convert to JSON-compatible Value.

     

       255
       260
        
       

     

       256
       256
       -
           Converts a full YAML representation to a simplified JSON-compatible value type.

     

       257
       257
       -
           This process implements the representation graph to serialization tree conversion

     

       258
       258
       -
           described in {{:https://yaml.org/spec/1.2.2/#32-processes}Section 3.2 (Processes)}

     

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

     

       260
       266
        
       

     

       261
       261
       -
           See also {{:https://yaml.org/spec/1.2.2/#10212-json-schema}Section 10.2.1.2

     

       262
       262
       -
           (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.

     

       263
       270
        
       

     

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

     

       265
       273
        
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       266
       274
        
           @param max_depth Maximum alias nesting depth (default 100)

     

       267
       267
       -
           @raise Error.Yamlrw_error with {!type:Error.kind} [Unresolved_alias] if resolve_aliases_first is false and an alias is encountered

     

       268
       268
       -
       *)

     

       269
       269
       -
       let to_value

     

       270
       270
       -
           ?(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)

     

       271
       279
        
           ?(max_nodes = default_max_alias_nodes)

     

       272
       272
       -
           ?(max_depth = default_max_alias_depth)

     

       273
       273
       -
           (v : t) : Value.t =

     

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

     

       275
       284
        
         let rec convert (v : t) : Value.t =

     

       276
       285
        
           match v with

     

       277
       286
        
           | `Scalar s -> scalar_to_value s

     

       278
       287
        
           | `Alias name -> Error.raise (Unresolved_alias name)

     

       279
       288
        
           | `A seq -> `A (List.map convert (Sequence.members seq))

     

       280
       289
        
           | `O map ->

     

       281
       281
       -
               `O (List.map (fun (k, v) ->

     

       282
       282
       -
                 let key = match k with

     

       283
       283
       -
                   | `Scalar s -> Scalar.value s

     

       284
       284
       -
                   | _ -> Error.raise (Type_mismatch ("string key", "complex key"))

     

       285
       285
       -
                 in

     

       286
       286
       -
                 (key, convert v)

     

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

     

       288
       301
        
         in

     

       289
       302
        
         convert v

     

       290
       303

+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

+17 -8

tests/dune

···

       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
       +
       

     

       15
       16
        
       (rule

     

       16
       17
        
        (alias yaml-test-suite)

     

       17
       17
       -
        (deps (source_tree yaml-test-suite))

     

       18
       18
       +
        (deps

     

       19
       19
       +
         (source_tree yaml-test-suite))

     

       18
       20
        
        (targets yaml-test-results.html)

     

       19
       21
        
        (action

     

       20
       20
       -
         (run %{exe:run_all_tests.exe}

     

       21
       21
       -
          --test-suite-path %{workspace_root}/tests/yaml-test-suite

     

       22
       22
       -
          --html yaml-test-results.html)))

     

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

     

       23
       28
        
       

     

       24
       29
        
       (rule

     

       25
       30
        
        (alias yaml-test-suite-eio)

     

       26
       26
       -
        (deps (source_tree yaml-test-suite))

     

       31
       31
       +
        (deps

     

       32
       32
       +
         (source_tree yaml-test-suite))

     

       27
       33
        
        (targets yaml-test-results-eio.html)

     

       28
       34
        
        (action

     

       29
       29
       -
         (run %{exe:run_all_tests_eio.exe}

     

       30
       30
       -
          --test-suite-path %{workspace_root}/tests/yaml-test-suite

     

       31
       31
       -
          --html yaml-test-results-eio.html)))

     

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

+209 -144

tests/run_all_tests.ml

···

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

     
···

       425
       462
        
         let html_output = ref None in

     

       426
       463
        
         let show_skipped = ref false in

     

       427
       464
        
         let test_suite_path_ref = ref test_suite_path in

     

       428
       428
       -
         let args = [

     

       429
       429
       -
           "--html", Arg.String (fun s -> html_output := Some s),

     

       430
       430
       -
           "<file> Generate HTML report to file";

     

       431
       431
       -
           "--show-skipped", Arg.Set show_skipped,

     

       432
       432
       -
           " Show details of skipped tests";

     

       433
       433
       -
           "--test-suite-path", Arg.Set_string test_suite_path_ref,

     

       434
       434
       -
           "<path> Path to yaml-test-suite directory";

     

       435
       435
       -
         ] in

     

       436
       436
       -
         Arg.parse args (fun _ -> ()) "Usage: run_all_tests [--html <file>] [--show-skipped] [--test-suite-path <path>]";

     

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

     

       437
       480
        
       

     

       438
       481
        
         let all_tests = TL.load_directory !test_suite_path_ref in

     

       439
       482
        
         Printf.printf "Total tests loaded: %d\n%!" (List.length all_tests);

     

       440
       483
        
       

     

       441
       484
        
         let results = List.map run_test all_tests in

     

       442
       485
        
       

     

       443
       443
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       444
       444
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

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

     

       446
       498
        
       

     

       447
       447
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       448
       448
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

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

     

       450
       511
        
       

     

       451
       451
       -
         Printf.printf "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!"

     

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

     

       453
       516
        
       

     

       454
       454
       -
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!"

     

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

     

       456
       519
        
       

     

       457
       520
        
         if fail_count > 0 then begin

     

       458
       521
        
           Printf.printf "\nFailing event tree tests:\n";

     

       459
       459
       -
           List.iter (fun r ->

     

       460
       460
       -
             match r.status with

     

       461
       461
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       462
       462
       -
             | _ -> ()

     

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

     

       464
       528
        
         end;

     

       465
       529
        
       

     

       466
       530
        
         if json_fail_count > 0 then begin

     

       467
       531
        
           Printf.printf "\nFailing JSON tests:\n";

     

       468
       468
       -
           List.iter (fun r ->

     

       469
       469
       -
             match r.json_status with

     

       470
       470
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       471
       471
       -
             | _ -> ()

     

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

     

       473
       538
        
         end;

     

       474
       539
        
       

     

       475
       540
        
         if !show_skipped && skip_count > 0 then begin

     

       476
       541
        
           Printf.printf "\nSkipped tests (no expected tree):\n";

     

       477
       477
       -
           List.iter (fun r ->

     

       478
       478
       -
             if r.status = `Skip then begin

     

       479
       479
       -
               Printf.printf "  %s: %s\n" r.id r.name;

     

       480
       480
       -
               Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       481
       481
       -
                 (if String.length r.yaml <= 60 then r.yaml

     

       482
       482
       -
                  else String.sub r.yaml 0 60 ^ "...")

     

       483
       483
       -
             end

     

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

     

       485
       551
        
         end;

     

       486
       552
        
       

     

       487
       553
        
         (match !html_output with

     
···

       491
       557
        
         | None -> ());

     

       492
       558
        
       

     

       493
       559
        
         (* Exit with non-zero code if any tests failed *)

     

       494
       494
       -
         if fail_count > 0 || json_fail_count > 0 then

     

       495
       495
       -
           exit 1

     

       560
       560
       +
         if fail_count > 0 || json_fail_count > 0 then exit 1

+224 -162

tests/run_all_tests_eio.ml

···

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

     
···

       438
       472
        
         let show_skipped = ref false in

     

       439
       473
        
         let sequential = ref false in

     

       440
       474
        
         let test_suite_path_ref = ref test_suite_path in

     

       441
       441
       -
         let args = [

     

       442
       442
       -
           "--html", Arg.String (fun s -> html_output := Some s),

     

       443
       443
       -
           "<file> Generate HTML report to file";

     

       444
       444
       -
           "--show-skipped", Arg.Set show_skipped,

     

       445
       445
       -
           " Show details of skipped tests";

     

       446
       446
       -
           "--sequential", Arg.Set sequential,

     

       447
       447
       -
           " Run tests sequentially instead of in parallel";

     

       448
       448
       -
           "--test-suite-path", Arg.Set_string test_suite_path_ref,

     

       449
       449
       -
           "<path> Path to yaml-test-suite directory";

     

       450
       450
       -
         ] in

     

       451
       451
       -
         Arg.parse args (fun _ -> ()) "Usage: run_all_tests_eio [--html <file>] [--show-skipped] [--sequential] [--test-suite-path <path>]";

     

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

     

       452
       493
        
       

     

       453
       494
        
         Eio_main.run @@ fun env ->

     

       454
       495
        
         (* Use fs (full filesystem) rather than cwd (sandboxed) to allow ".." navigation *)

     

       455
       496
        
         let fs = Eio.Stdenv.fs env in

     

       456
       497
        
         (* Get the absolute path to the test suite *)

     

       457
       457
       -
         let test_suite_abs = if Filename.is_relative !test_suite_path_ref then

     

       458
       458
       -
           Filename.concat (Sys.getcwd ()) !test_suite_path_ref

     

       459
       459
       -
         else

     

       460
       460
       -
           !test_suite_path_ref

     

       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

     

       461
       502
        
         in

     

       462
       503
        
       

     

       463
       504
        
         let start_time = Unix.gettimeofday () in

     

       464
       505
        
       

     

       465
       506
        
         (* Load tests using Eio (parallel by default) *)

     

       466
       466
       -
         let all_tests = if !sequential then

     

       467
       467
       -
           TL.load_directory ~fs test_suite_abs

     

       468
       468
       -
         else

     

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

     

       470
       510
        
         in

     

       471
       511
        
         let load_time = Unix.gettimeofday () in

     

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

     

       473
       514
        
       

     

       474
       515
        
         (* Run tests (parallel or sequential based on flag) *)

     

       475
       475
       -
         let results = if !sequential then

     

       476
       476
       -
           List.map run_test all_tests

     

       477
       477
       -
         else

     

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

     

       479
       519
        
         in

     

       480
       520
        
         let run_time = Unix.gettimeofday () in

     

       481
       521
        
         Printf.printf "Ran tests in %.3fs\n%!" (run_time -. load_time);

     

       482
       522
        
       

     

       483
       483
       -
         let pass_count = List.length (List.filter (fun r -> r.status = `Pass) results) in

     

       484
       484
       -
         let fail_count = List.length (List.filter (fun r -> match r.status with `Fail _ -> true | _ -> false) results) in

     

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

     

       486
       535
        
       

     

       487
       487
       -
         let json_pass_count = List.length (List.filter (fun r -> r.json_status = `Pass) results) in

     

       488
       488
       -
         let json_fail_count = List.length (List.filter (fun r -> match r.json_status with `Fail _ -> true | _ -> false) results) in

     

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

     

       490
       548
        
       

     

       491
       491
       -
         Printf.printf "\nEvent Tree Results: %d pass, %d fail, %d skip (total: %d)\n%!"

     

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

     

       493
       553
        
       

     

       494
       494
       -
         Printf.printf "JSON Results: %d pass, %d fail, %d skip\n%!"

     

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

     

       496
       556
        
       

     

       497
       557
        
         if fail_count > 0 then begin

     

       498
       558
        
           Printf.printf "\nFailing event tree tests:\n";

     

       499
       499
       -
           List.iter (fun r ->

     

       500
       500
       -
             match r.status with

     

       501
       501
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       502
       502
       -
             | _ -> ()

     

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

     

       504
       565
        
         end;

     

       505
       566
        
       

     

       506
       567
        
         if json_fail_count > 0 then begin

     

       507
       568
        
           Printf.printf "\nFailing JSON tests:\n";

     

       508
       508
       -
           List.iter (fun r ->

     

       509
       509
       -
             match r.json_status with

     

       510
       510
       -
             | `Fail msg -> Printf.printf "  %s: %s - %s\n" r.id r.name msg

     

       511
       511
       -
             | _ -> ()

     

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

     

       513
       575
        
         end;

     

       514
       576
        
       

     

       515
       577
        
         if !show_skipped && skip_count > 0 then begin

     

       516
       578
        
           Printf.printf "\nSkipped tests (no expected tree):\n";

     

       517
       517
       -
           List.iter (fun r ->

     

       518
       518
       -
             if r.status = `Skip then begin

     

       519
       519
       -
               Printf.printf "  %s: %s\n" r.id r.name;

     

       520
       520
       -
               Printf.printf "    YAML (%d chars): %S\n" (String.length r.yaml)

     

       521
       521
       -
                 (if String.length r.yaml <= 60 then r.yaml

     

       522
       522
       -
                  else String.sub r.yaml 0 60 ^ "...")

     

       523
       523
       -
             end

     

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

     

       525
       588
        
         end;

     

       526
       589
        
       

     

       527
       590
        
         let total_time = Unix.gettimeofday () in

     
···

       534
       597
        
         | None -> ());

     

       535
       598
        
       

     

       536
       599
        
         (* Exit with non-zero code if any tests failed *)

     

       537
       537
       -
         if fail_count > 0 || json_fail_count > 0 then

     

       538
       538
       -
           exit 1

     

       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

+15 -15

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

     

       64
       64
       +
           Eio.Fiber.List.map

     

       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

+147 -112

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;

     

       344
       344
       -
       ]

     

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

     

       345
       379
        
       

     

       346
       380
        
       (** Bug fix regression tests

     

       347
       381
        
           These tests verify that issues fixed in ocaml-yaml don't occur in ocaml-yamlrw *)

     
···

       411
       445
        
       let test_parse_special_floats () =

     

       412
       446
        
         let inf_result = of_string ".inf" in

     

       413
       447
        
         (match inf_result with

     

       414
       414
       -
          | `Float f when Float.is_inf f && f > 0.0 -> ()

     

       448
       448
       +
          | `Float f when Float.is_infinite f && f > 0.0 -> ()

     

       415
       449
        
          | _ -> Alcotest.fail "expected positive infinity");

     

       416
       450
        
         let neg_inf_result = of_string "-.inf" in

     

       417
       451
        
         (match neg_inf_result with

     

       418
       418
       -
          | `Float f when Float.is_inf f && f < 0.0 -> ()

     

       452
       452
       +
          | `Float f when Float.is_infinite f && f < 0.0 -> ()

     

       419
       453
        
          | _ -> Alcotest.fail "expected negative infinity");

     

       420
       454
        
         let nan_result = of_string ".nan" in

     

       421
       455
        
         (match nan_result with

     
···

       485
       519
        
       (** Run all tests *)

     

       486
       520
        
       

     

       487
       521
        
       let () =

     

       488
       488
       -
         Alcotest.run "yamlrw" [

     

       489
       489
       -
           "scanner", scanner_tests;

     

       490
       490
       -
           "parser", parser_tests;

     

       491
       491
       -
           "value", value_tests;

     

       492
       492
       -
           "emitter", emitter_tests;

     

       493
       493
       -
           "yaml", yaml_tests;

     

       494
       494
       -
           "multiline", multiline_tests;

     

       495
       495
       -
           "errors", error_tests;

     

       496
       496
       -
           "alias_limits", alias_limit_tests;

     

       497
       497
       -
           "bugfix_regression", bugfix_regression_tests;

     

       498
       498
       -
         ]

     

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