anil.recoil.org
Pure OCaml Yaml 1.2 reader and writer using Bytesrw
mli files and cleanups
+1539
-181
+33
lib/char_class.mli
+33
lib/char_class.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Character classification for YAML parsing *)
7
+
8
+
val is_break : char -> bool
9
+
(** Line break characters (\n or \r) *)
10
+
11
+
val is_blank : char -> bool
12
+
(** Blank (space or tab) *)
13
+
14
+
val is_whitespace : char -> bool
15
+
(** Whitespace (break or blank) *)
16
+
17
+
val is_digit : char -> bool
18
+
(** Decimal digit *)
19
+
20
+
val is_hex : char -> bool
21
+
(** Hexadecimal digit *)
22
+
23
+
val is_alpha : char -> bool
24
+
(** Alphabetic character *)
25
+
26
+
val is_alnum : char -> bool
27
+
(** Alphanumeric character *)
28
+
29
+
val is_indicator : char -> bool
30
+
(** YAML indicator characters *)
31
+
32
+
val is_flow_indicator : char -> bool
33
+
(** Flow context indicator characters (comma and brackets) *)
+26
lib/chomping.mli
+26
lib/chomping.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Block scalar chomping indicators *)
7
+
8
+
type t =
9
+
| Strip (** Remove final line break and trailing empty lines *)
10
+
| Clip (** Keep final line break, remove trailing empty lines (default) *)
11
+
| Keep (** Keep final line break and trailing empty lines *)
12
+
13
+
val to_string : t -> string
14
+
(** Convert chomping mode to string *)
15
+
16
+
val pp : Format.formatter -> t -> unit
17
+
(** Pretty-print a chomping mode *)
18
+
19
+
val of_char : char -> t option
20
+
(** Parse chomping indicator from character *)
21
+
22
+
val to_char : t -> char option
23
+
(** Convert chomping mode to indicator character (None for Clip) *)
24
+
25
+
val equal : t -> t -> bool
26
+
(** Test equality of two chomping modes *)
+2
-2
lib/document.ml
+2
-2
lib/document.ml
···
52
52
Format.fprintf fmt "@]@,)"
53
53
54
54
let equal a b =
55
-
Option.equal (fun (a1, a2) (b1, b2) -> a1 = b1 && a2 = b2) a.version b.version &&
56
-
List.equal (fun (h1, p1) (h2, p2) -> h1 = h2 && p1 = p2) a.tags b.tags &&
55
+
Option.equal ( = ) a.version b.version &&
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
+41
lib/document.mli
+41
lib/document.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML document with directives and content *)
7
+
8
+
type t = {
9
+
version : (int * int) option;
10
+
tags : (string * string) list;
11
+
root : Yaml.t option;
12
+
implicit_start : bool;
13
+
implicit_end : bool;
14
+
}
15
+
16
+
val make :
17
+
?version:(int * int) ->
18
+
?tags:(string * string) list ->
19
+
?implicit_start:bool ->
20
+
?implicit_end:bool ->
21
+
Yaml.t option -> t
22
+
(** Create a document *)
23
+
24
+
(** {2 Accessors} *)
25
+
26
+
val version : t -> (int * int) option
27
+
val tags : t -> (string * string) list
28
+
val root : t -> Yaml.t option
29
+
val implicit_start : t -> bool
30
+
val implicit_end : t -> bool
31
+
32
+
(** {2 Modifiers} *)
33
+
34
+
val with_version : int * int -> t -> t
35
+
val with_tags : (string * string) list -> t -> t
36
+
val with_root : Yaml.t -> t -> t
37
+
38
+
(** {2 Comparison} *)
39
+
40
+
val pp : Format.formatter -> t -> unit
41
+
val equal : t -> t -> bool
+1
lib/dune
+1
lib/dune
+62
lib/emitter.mli
+62
lib/emitter.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Emitter - converts YAML data structures to string output
7
+
8
+
The emitter can write to either a Buffer (default) or directly to a
9
+
bytesrw Bytes.Writer for streaming output. *)
10
+
11
+
(** {1 Configuration} *)
12
+
13
+
type config = {
14
+
encoding : Encoding.t;
15
+
scalar_style : Scalar_style.t;
16
+
layout_style : Layout_style.t;
17
+
indent : int;
18
+
width : int;
19
+
canonical : bool;
20
+
}
21
+
22
+
val default_config : config
23
+
(** Default emitter configuration *)
24
+
25
+
(** {1 Emitter Type} *)
26
+
27
+
type t
28
+
29
+
(** {1 Constructors} *)
30
+
31
+
val create : ?config:config -> unit -> t
32
+
(** Create an emitter that writes to an internal buffer *)
33
+
34
+
val of_writer : ?config:config -> Bytesrw.Bytes.Writer.t -> t
35
+
(** Create an emitter that writes directly to a Bytes.Writer *)
36
+
37
+
(** {1 Output} *)
38
+
39
+
val contents : t -> string
40
+
(** Get accumulated output. Returns empty string for writer-based emitters. *)
41
+
42
+
val reset : t -> unit
43
+
(** Reset emitter state and clear buffer *)
44
+
45
+
val buffer : t -> Buffer.t option
46
+
(** Access underlying buffer (None for writer-based emitters) *)
47
+
48
+
val flush : t -> unit
49
+
(** Flush writer sink (no-op for buffer-based emitters) *)
50
+
51
+
(** {1 Event Emission} *)
52
+
53
+
val emit : t -> Event.t -> unit
54
+
(** Emit a single event *)
55
+
56
+
(** {1 Accessors} *)
57
+
58
+
val config : t -> config
59
+
(** Get emitter configuration *)
60
+
61
+
val is_streaming : t -> bool
62
+
(** Check if emitter is writing to a Writer (vs buffer) *)
+27
lib/encoding.mli
+27
lib/encoding.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Character encoding detection and handling *)
7
+
8
+
type t = [
9
+
| `Utf8
10
+
| `Utf16be
11
+
| `Utf16le
12
+
| `Utf32be
13
+
| `Utf32le
14
+
]
15
+
16
+
val to_string : t -> string
17
+
(** Convert encoding to string representation *)
18
+
19
+
val pp : Format.formatter -> t -> unit
20
+
(** Pretty-print an encoding *)
21
+
22
+
val detect : string -> t * int
23
+
(** Detect encoding from BOM or first bytes.
24
+
Returns (encoding, bom_length) *)
25
+
26
+
val equal : t -> t -> bool
27
+
(** Test equality of two encodings *)
+120
lib/error.mli
+120
lib/error.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** {1 Error Handling}
7
+
8
+
Comprehensive error reporting for YAML parsing and emission.
9
+
10
+
This module provides detailed error types that correspond to various
11
+
failure modes in YAML processing, as specified in the
12
+
{{:https://yaml.org/spec/1.2.2/}YAML 1.2.2 specification}. *)
13
+
14
+
(** {2 Error Classification} *)
15
+
16
+
type kind =
17
+
(* Scanner errors *)
18
+
| Unexpected_character of char
19
+
| Unexpected_eof
20
+
| Invalid_escape_sequence of string
21
+
| Invalid_unicode_escape of string
22
+
| Invalid_hex_escape of string
23
+
| Invalid_tag of string
24
+
| Invalid_anchor of string
25
+
| Invalid_alias of string
26
+
| Invalid_comment
27
+
| Unclosed_single_quote
28
+
| Unclosed_double_quote
29
+
| Unclosed_flow_sequence
30
+
| Unclosed_flow_mapping
31
+
| Invalid_indentation of int * int
32
+
| Invalid_flow_indentation
33
+
| Tab_in_indentation
34
+
| Invalid_block_scalar_header of string
35
+
| Invalid_quoted_scalar_indentation of string
36
+
| Invalid_directive of string
37
+
| Invalid_yaml_version of string
38
+
| Invalid_tag_directive of string
39
+
| Reserved_directive of string
40
+
| Illegal_flow_key_line
41
+
| Block_sequence_disallowed
42
+
43
+
(* Parser errors *)
44
+
| Unexpected_token of string
45
+
| Expected_document_start
46
+
| Expected_document_end
47
+
| Expected_block_entry
48
+
| Expected_key
49
+
| Expected_value
50
+
| Expected_node
51
+
| Expected_scalar
52
+
| Expected_sequence_end
53
+
| Expected_mapping_end
54
+
| Duplicate_anchor of string
55
+
| Undefined_alias of string
56
+
| Alias_cycle of string
57
+
| Multiple_documents
58
+
| Mapping_key_too_long
59
+
60
+
(* Loader errors *)
61
+
| Invalid_scalar_conversion of string * string
62
+
| Type_mismatch of string * string
63
+
| Unresolved_alias of string
64
+
| Key_not_found of string
65
+
| Alias_expansion_node_limit of int
66
+
| Alias_expansion_depth_limit of int
67
+
68
+
(* Emitter errors *)
69
+
| Invalid_encoding of string
70
+
| Scalar_contains_invalid_chars of string
71
+
| Anchor_not_set
72
+
| Invalid_state of string
73
+
74
+
(* Generic *)
75
+
| Custom of string
76
+
77
+
(** {2 Error Value} *)
78
+
79
+
type t = {
80
+
kind : kind;
81
+
span : Span.t option;
82
+
context : string list;
83
+
source : string option;
84
+
}
85
+
86
+
(** {2 Exception} *)
87
+
88
+
exception Yamlrw_error of t
89
+
(** The main exception type raised by all yamlrw operations. *)
90
+
91
+
(** {2 Error Construction} *)
92
+
93
+
val make : ?span:Span.t -> ?context:string list -> ?source:string -> kind -> t
94
+
(** Construct an error value. *)
95
+
96
+
val raise : ?span:Span.t -> ?context:string list -> ?source:string -> kind -> 'a
97
+
(** Construct and raise an error. *)
98
+
99
+
val raise_at : Position.t -> kind -> 'a
100
+
(** Raise an error at a specific position. *)
101
+
102
+
val raise_span : Span.t -> kind -> 'a
103
+
(** Raise an error at a specific span. *)
104
+
105
+
val with_context : string -> (unit -> 'a) -> 'a
106
+
(** Execute a function and add context to any raised error. *)
107
+
108
+
(** {2 Error Formatting} *)
109
+
110
+
val kind_to_string : kind -> string
111
+
(** Convert an error kind to a human-readable string. *)
112
+
113
+
val to_string : t -> string
114
+
(** Convert an error to a human-readable string. *)
115
+
116
+
val pp : Format.formatter -> t -> unit
117
+
(** Pretty-print an error. *)
118
+
119
+
val pp_with_source : source:string -> Format.formatter -> t -> unit
120
+
(** Pretty-print an error with source context. *)
+10
-15
lib/event.ml
+10
-15
lib/event.ml
···
42
42
span : Span.t;
43
43
}
44
44
45
+
let pp_opt_str = Option.value ~default:"none"
46
+
45
47
let pp fmt = function
46
48
| Stream_start { encoding } ->
47
49
Format.fprintf fmt "stream-start(%a)" Encoding.pp encoding
48
50
| Stream_end ->
49
51
Format.fprintf fmt "stream-end"
50
52
| Document_start { version; implicit } ->
51
-
Format.fprintf fmt "document-start(version=%s, implicit=%b)"
52
-
(match version with None -> "none" | Some (maj, min) -> Printf.sprintf "%d.%d" maj min)
53
-
implicit
53
+
let version_str = match version with
54
+
| None -> "none"
55
+
| Some (maj, min) -> Printf.sprintf "%d.%d" maj min
56
+
in
57
+
Format.fprintf fmt "document-start(version=%s, implicit=%b)" version_str implicit
54
58
| Document_end { implicit } ->
55
59
Format.fprintf fmt "document-end(implicit=%b)" implicit
56
60
| Alias { anchor } ->
57
61
Format.fprintf fmt "alias(%s)" anchor
58
62
| Scalar { anchor; tag; value; style; _ } ->
59
63
Format.fprintf fmt "scalar(anchor=%s, tag=%s, style=%a, value=%S)"
60
-
(Option.value anchor ~default:"none")
61
-
(Option.value tag ~default:"none")
62
-
Scalar_style.pp style
63
-
value
64
+
(pp_opt_str anchor) (pp_opt_str tag) Scalar_style.pp style value
64
65
| Sequence_start { anchor; tag; implicit; style } ->
65
66
Format.fprintf fmt "sequence-start(anchor=%s, tag=%s, implicit=%b, style=%a)"
66
-
(Option.value anchor ~default:"none")
67
-
(Option.value tag ~default:"none")
68
-
implicit
69
-
Layout_style.pp style
67
+
(pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style
70
68
| Sequence_end ->
71
69
Format.fprintf fmt "sequence-end"
72
70
| Mapping_start { anchor; tag; implicit; style } ->
73
71
Format.fprintf fmt "mapping-start(anchor=%s, tag=%s, implicit=%b, style=%a)"
74
-
(Option.value anchor ~default:"none")
75
-
(Option.value tag ~default:"none")
76
-
implicit
77
-
Layout_style.pp style
72
+
(pp_opt_str anchor) (pp_opt_str tag) implicit Layout_style.pp style
78
73
| Mapping_end ->
79
74
Format.fprintf fmt "mapping-end"
80
75
+49
lib/event.mli
+49
lib/event.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML parser events *)
7
+
8
+
type t =
9
+
| Stream_start of { encoding : Encoding.t }
10
+
| Stream_end
11
+
| Document_start of {
12
+
version : (int * int) option;
13
+
implicit : bool;
14
+
}
15
+
| Document_end of { implicit : bool }
16
+
| Alias of { anchor : string }
17
+
| Scalar of {
18
+
anchor : string option;
19
+
tag : string option;
20
+
value : string;
21
+
plain_implicit : bool;
22
+
quoted_implicit : bool;
23
+
style : Scalar_style.t;
24
+
}
25
+
| Sequence_start of {
26
+
anchor : string option;
27
+
tag : string option;
28
+
implicit : bool;
29
+
style : Layout_style.t;
30
+
}
31
+
| Sequence_end
32
+
| Mapping_start of {
33
+
anchor : string option;
34
+
tag : string option;
35
+
implicit : bool;
36
+
style : Layout_style.t;
37
+
}
38
+
| Mapping_end
39
+
40
+
type spanned = {
41
+
event : t;
42
+
span : Span.t;
43
+
}
44
+
45
+
val pp : Format.formatter -> t -> unit
46
+
(** Pretty-print an event *)
47
+
48
+
val pp_spanned : Format.formatter -> spanned -> unit
49
+
(** Pretty-print a spanned event *)
+97
lib/input.mli
+97
lib/input.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Character input source with lookahead, based on Bytes.Reader.t
7
+
8
+
This module wraps a bytesrw [Bytes.Reader.t] to provide character-by-character
9
+
access with lookahead for the YAML scanner. *)
10
+
11
+
(** {2 Re-exported Character Classification} *)
12
+
13
+
include module type of Char_class
14
+
15
+
(** {2 Input Type} *)
16
+
17
+
type t
18
+
19
+
(** {2 Constructors} *)
20
+
21
+
val of_reader : ?initial_position:Position.t -> Bytesrw.Bytes.Reader.t -> t
22
+
(** Create input from a Bytes.Reader.t *)
23
+
24
+
val of_string : string -> t
25
+
(** Create input from a string *)
26
+
27
+
(** {2 Position and State} *)
28
+
29
+
val position : t -> Position.t
30
+
(** Get current position *)
31
+
32
+
val is_eof : t -> bool
33
+
(** Check if at end of input *)
34
+
35
+
val mark : t -> Position.t
36
+
(** Mark current position for span creation *)
37
+
38
+
(** {2 Lookahead} *)
39
+
40
+
val peek : t -> char option
41
+
(** Peek at current character without advancing *)
42
+
43
+
val peek_exn : t -> char
44
+
(** Peek at current character, raising on EOF *)
45
+
46
+
val peek_nth : t -> int -> char option
47
+
(** Peek at nth character (0-indexed from current position) *)
48
+
49
+
val peek_string : t -> int -> string
50
+
(** Peek at up to n characters as a string *)
51
+
52
+
val peek_back : t -> char option
53
+
(** Get the character before the current position *)
54
+
55
+
(** {2 Consumption} *)
56
+
57
+
val next : t -> char option
58
+
(** Consume and return next character *)
59
+
60
+
val next_exn : t -> char
61
+
(** Consume and return next character, raising on EOF *)
62
+
63
+
val skip : t -> int -> unit
64
+
(** Skip n characters *)
65
+
66
+
val skip_while : t -> (char -> bool) -> unit
67
+
(** Skip characters while predicate holds *)
68
+
69
+
val consume_break : t -> unit
70
+
(** Consume line break, handling \r\n as single break *)
71
+
72
+
(** {2 Predicates} *)
73
+
74
+
val next_is : (char -> bool) -> t -> bool
75
+
(** Check if next char satisfies predicate *)
76
+
77
+
val next_is_break : t -> bool
78
+
val next_is_blank : t -> bool
79
+
val next_is_whitespace : t -> bool
80
+
val next_is_digit : t -> bool
81
+
val next_is_hex : t -> bool
82
+
val next_is_alpha : t -> bool
83
+
val next_is_indicator : t -> bool
84
+
85
+
val at_document_boundary : t -> bool
86
+
(** Check if at document boundary (--- or ...) *)
87
+
88
+
(** {2 Utilities} *)
89
+
90
+
val remaining : t -> string
91
+
(** Get remaining content from current position *)
92
+
93
+
val source : t -> string
94
+
(** Get a sample of the source for encoding detection *)
95
+
96
+
val byte_pos : t -> int
97
+
(** Get the byte position in the underlying stream *)
+24
lib/layout_style.mli
+24
lib/layout_style.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Collection layout styles *)
7
+
8
+
type t = [
9
+
| `Any (** Let emitter choose *)
10
+
| `Block (** Indentation-based *)
11
+
| `Flow (** Inline with brackets *)
12
+
]
13
+
14
+
val to_string : t -> string
15
+
(** Convert style to string representation *)
16
+
17
+
val pp : Format.formatter -> t -> unit
18
+
(** Pretty-print a style *)
19
+
20
+
val equal : t -> t -> bool
21
+
(** Test equality of two styles *)
22
+
23
+
val compare : t -> t -> int
24
+
(** Compare two styles *)
+58
-87
lib/loader.ml
+58
-87
lib/loader.ml
···
132
132
pending_key = None;
133
133
} :: rest)
134
134
135
+
(** Internal: parse all documents from a parser *)
136
+
let parse_all_documents parser =
137
+
let state = create_state () in
138
+
Parser.iter (process_event state) parser;
139
+
List.rev state.documents
140
+
141
+
(** Internal: extract single document or raise *)
142
+
let single_document_or_error docs ~empty =
143
+
match docs with
144
+
| [] -> empty
145
+
| [doc] -> doc
146
+
| _ -> Error.raise Multiple_documents
147
+
135
148
(** Load single document as Value.
136
149
137
150
@param resolve_aliases Whether to resolve aliases (default true)
···
143
156
?(max_nodes = Yaml.default_max_alias_nodes)
144
157
?(max_depth = Yaml.default_max_alias_depth)
145
158
s =
146
-
let parser = Parser.of_string s in
147
-
let state = create_state () in
148
-
Parser.iter (process_event state) parser;
149
-
match state.documents with
150
-
| [] -> `Null
151
-
| [doc] ->
152
-
(match Document.root doc with
153
-
| None -> `Null
154
-
| Some yaml ->
155
-
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)
156
-
| _ -> Error.raise Multiple_documents
159
+
let docs = parse_all_documents (Parser.of_string s) in
160
+
let doc = single_document_or_error docs ~empty:(Document.make None) in
161
+
match Document.root doc with
162
+
| None -> `Null
163
+
| Some yaml ->
164
+
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml
157
165
158
166
(** Load single document as Yaml.
159
167
···
166
174
?(max_nodes = Yaml.default_max_alias_nodes)
167
175
?(max_depth = Yaml.default_max_alias_depth)
168
176
s =
169
-
let parser = Parser.of_string s in
170
-
let state = create_state () in
171
-
Parser.iter (process_event state) parser;
172
-
match state.documents with
173
-
| [] -> `Scalar (Scalar.make "")
174
-
| [doc] ->
175
-
(match Document.root doc with
176
-
| None -> `Scalar (Scalar.make "")
177
-
| Some yaml ->
178
-
if resolve_aliases then
179
-
Yaml.resolve_aliases ~max_nodes ~max_depth yaml
180
-
else
181
-
yaml)
182
-
| _ -> Error.raise Multiple_documents
177
+
let docs = parse_all_documents (Parser.of_string s) in
178
+
let doc = single_document_or_error docs ~empty:(Document.make None) in
179
+
match Document.root doc with
180
+
| None -> `Scalar (Scalar.make "")
181
+
| Some yaml ->
182
+
if resolve_aliases then
183
+
Yaml.resolve_aliases ~max_nodes ~max_depth yaml
184
+
else
185
+
yaml
183
186
184
187
(** Load all documents *)
185
188
let documents_of_string s =
186
-
let parser = Parser.of_string s in
187
-
let state = create_state () in
188
-
Parser.iter (process_event state) parser;
189
-
List.rev state.documents
189
+
parse_all_documents (Parser.of_string s)
190
190
191
191
(** {2 Reader-based loading} *)
192
192
···
201
201
?(max_nodes = Yaml.default_max_alias_nodes)
202
202
?(max_depth = Yaml.default_max_alias_depth)
203
203
reader =
204
-
let parser = Parser.of_reader reader in
205
-
let state = create_state () in
206
-
Parser.iter (process_event state) parser;
207
-
match state.documents with
208
-
| [] -> `Null
209
-
| [doc] ->
210
-
(match Document.root doc with
211
-
| None -> `Null
212
-
| Some yaml ->
213
-
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)
214
-
| _ -> Error.raise Multiple_documents
204
+
let docs = parse_all_documents (Parser.of_reader reader) in
205
+
let doc = single_document_or_error docs ~empty:(Document.make None) in
206
+
match Document.root doc with
207
+
| None -> `Null
208
+
| Some yaml ->
209
+
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml
215
210
216
211
(** Load single document as Yaml from a Bytes.Reader.
217
212
···
224
219
?(max_nodes = Yaml.default_max_alias_nodes)
225
220
?(max_depth = Yaml.default_max_alias_depth)
226
221
reader =
227
-
let parser = Parser.of_reader reader in
228
-
let state = create_state () in
229
-
Parser.iter (process_event state) parser;
230
-
match state.documents with
231
-
| [] -> `Scalar (Scalar.make "")
232
-
| [doc] ->
233
-
(match Document.root doc with
234
-
| None -> `Scalar (Scalar.make "")
235
-
| Some yaml ->
236
-
if resolve_aliases then
237
-
Yaml.resolve_aliases ~max_nodes ~max_depth yaml
238
-
else
239
-
yaml)
240
-
| _ -> Error.raise Multiple_documents
222
+
let docs = parse_all_documents (Parser.of_reader reader) in
223
+
let doc = single_document_or_error docs ~empty:(Document.make None) in
224
+
match Document.root doc with
225
+
| None -> `Scalar (Scalar.make "")
226
+
| Some yaml ->
227
+
if resolve_aliases then
228
+
Yaml.resolve_aliases ~max_nodes ~max_depth yaml
229
+
else
230
+
yaml
241
231
242
232
(** Load all documents from a Bytes.Reader *)
243
233
let documents_of_reader reader =
244
-
let parser = Parser.of_reader reader in
245
-
let state = create_state () in
246
-
Parser.iter (process_event state) parser;
247
-
List.rev state.documents
234
+
parse_all_documents (Parser.of_reader reader)
235
+
236
+
(** {2 Parser-function based loading}
248
237
249
-
(** Generic document loader - extracts common pattern from load_* functions *)
250
-
let load_generic extract parser =
238
+
These functions accept a [unit -> Event.spanned option] function
239
+
instead of a [Parser.t], allowing them to work with any event source
240
+
(e.g., streaming parsers). *)
241
+
242
+
(** Generic document loader using event source function *)
243
+
let load_generic_fn extract next_event =
251
244
let state = create_state () in
252
245
let rec loop () =
253
-
match Parser.next parser with
246
+
match next_event () with
254
247
| None -> None
255
248
| Some ev ->
256
249
process_event state ev;
···
265
258
| _ -> loop ()
266
259
in
267
260
loop ()
261
+
262
+
(** Generic document loader - extracts common pattern from load_* functions *)
263
+
let load_generic extract parser =
264
+
load_generic_fn extract (fun () -> Parser.next parser)
268
265
269
266
(** Load single Value from parser.
270
267
···
311
308
| Some doc -> loop (f acc doc)
312
309
in
313
310
loop init
314
-
315
-
(** {2 Parser-function based loading}
316
-
317
-
These functions accept a [unit -> Event.spanned option] function
318
-
instead of a [Parser.t], allowing them to work with any event source
319
-
(e.g., streaming parsers). *)
320
-
321
-
(** Generic document loader using event source function *)
322
-
let load_generic_fn extract next_event =
323
-
let state = create_state () in
324
-
let rec loop () =
325
-
match next_event () with
326
-
| None -> None
327
-
| Some ev ->
328
-
process_event state ev;
329
-
match ev.event with
330
-
| Event.Document_end _ ->
331
-
(match state.documents with
332
-
| doc :: _ ->
333
-
state.documents <- [];
334
-
Some (extract doc)
335
-
| [] -> None)
336
-
| Event.Stream_end -> None
337
-
| _ -> loop ()
338
-
in
339
-
loop ()
340
311
341
312
(** Load single Value from event source.
342
313
+104
lib/loader.mli
+104
lib/loader.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Loader - converts parser events to YAML data structures *)
7
+
8
+
(** {1 String-based loading} *)
9
+
10
+
val value_of_string :
11
+
?resolve_aliases:bool ->
12
+
?max_nodes:int ->
13
+
?max_depth:int ->
14
+
string -> Value.t
15
+
(** Load single document as Value.
16
+
17
+
@param resolve_aliases Whether to resolve aliases (default true)
18
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
19
+
@param max_depth Maximum alias nesting depth (default 100) *)
20
+
21
+
val yaml_of_string :
22
+
?resolve_aliases:bool ->
23
+
?max_nodes:int ->
24
+
?max_depth:int ->
25
+
string -> Yaml.t
26
+
(** Load single document as Yaml.
27
+
28
+
@param resolve_aliases Whether to resolve aliases (default false)
29
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
30
+
@param max_depth Maximum alias nesting depth (default 100) *)
31
+
32
+
val documents_of_string : string -> Document.t list
33
+
(** Load all documents from a string *)
34
+
35
+
(** {1 Reader-based loading} *)
36
+
37
+
val value_of_reader :
38
+
?resolve_aliases:bool ->
39
+
?max_nodes:int ->
40
+
?max_depth:int ->
41
+
Bytesrw.Bytes.Reader.t -> Value.t
42
+
(** Load single document as Value from a Bytes.Reader *)
43
+
44
+
val yaml_of_reader :
45
+
?resolve_aliases:bool ->
46
+
?max_nodes:int ->
47
+
?max_depth:int ->
48
+
Bytesrw.Bytes.Reader.t -> Yaml.t
49
+
(** Load single document as Yaml from a Bytes.Reader *)
50
+
51
+
val documents_of_reader : Bytesrw.Bytes.Reader.t -> Document.t list
52
+
(** Load all documents from a Bytes.Reader *)
53
+
54
+
(** {1 Parser-based loading} *)
55
+
56
+
val load_value :
57
+
?resolve_aliases:bool ->
58
+
?max_nodes:int ->
59
+
?max_depth:int ->
60
+
Parser.t -> Value.t option
61
+
(** Load single Value from parser *)
62
+
63
+
val load_yaml : Parser.t -> Yaml.t option
64
+
(** Load single Yaml from parser *)
65
+
66
+
val load_document : Parser.t -> Document.t option
67
+
(** Load single Document from parser *)
68
+
69
+
val iter_documents : (Document.t -> unit) -> Parser.t -> unit
70
+
(** Iterate over documents from parser *)
71
+
72
+
val fold_documents : ('a -> Document.t -> 'a) -> 'a -> Parser.t -> 'a
73
+
(** Fold over documents from parser *)
74
+
75
+
(** {1 Event function-based loading}
76
+
77
+
These functions accept a [unit -> Event.spanned option] function
78
+
instead of a [Parser.t], allowing them to work with any event source. *)
79
+
80
+
val value_of_parser :
81
+
?resolve_aliases:bool ->
82
+
?max_nodes:int ->
83
+
?max_depth:int ->
84
+
(unit -> Event.spanned option) -> Value.t
85
+
(** Load single Value from event source function *)
86
+
87
+
val yaml_of_parser :
88
+
?resolve_aliases:bool ->
89
+
?max_nodes:int ->
90
+
?max_depth:int ->
91
+
(unit -> Event.spanned option) -> Yaml.t
92
+
(** Load single Yaml from event source function *)
93
+
94
+
val document_of_parser : (unit -> Event.spanned option) -> Document.t option
95
+
(** Load single Document from event source function *)
96
+
97
+
val documents_of_parser : (unit -> Event.spanned option) -> Document.t list
98
+
(** Load all documents from event source function *)
99
+
100
+
val iter_documents_parser : (Document.t -> unit) -> (unit -> Event.spanned option) -> unit
101
+
(** Iterate over documents from event source function *)
102
+
103
+
val fold_documents_parser : ('a -> Document.t -> 'a) -> 'a -> (unit -> Event.spanned option) -> 'a
104
+
(** Fold over documents from event source function *)
+2
-6
lib/mapping.ml
+2
-6
lib/mapping.ml
···
58
58
59
59
let pp pp_key pp_val fmt t =
60
60
Format.fprintf fmt "@[<hv 2>mapping(@,";
61
-
(match t.anchor with
62
-
| Some a -> Format.fprintf fmt "anchor=%s,@ " a
63
-
| None -> ());
64
-
(match t.tag with
65
-
| Some tag -> Format.fprintf fmt "tag=%s,@ " tag
66
-
| None -> ());
61
+
Option.iter (Format.fprintf fmt "anchor=%s,@ ") t.anchor;
62
+
Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;
67
63
Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;
68
64
Format.fprintf fmt "members={@,";
69
65
List.iteri (fun i (k, v) ->
+54
lib/mapping.mli
+54
lib/mapping.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML mapping (object) values with metadata *)
7
+
8
+
type ('k, 'v) t
9
+
10
+
val make :
11
+
?anchor:string ->
12
+
?tag:string ->
13
+
?implicit:bool ->
14
+
?style:Layout_style.t ->
15
+
('k * 'v) list -> ('k, 'v) t
16
+
(** Create a mapping *)
17
+
18
+
(** {2 Accessors} *)
19
+
20
+
val members : ('k, 'v) t -> ('k * 'v) list
21
+
val anchor : ('k, 'v) t -> string option
22
+
val tag : ('k, 'v) t -> string option
23
+
val implicit : ('k, 'v) t -> bool
24
+
val style : ('k, 'v) t -> Layout_style.t
25
+
26
+
(** {2 Modifiers} *)
27
+
28
+
val with_anchor : string -> ('k, 'v) t -> ('k, 'v) t
29
+
val with_tag : string -> ('k, 'v) t -> ('k, 'v) t
30
+
val with_style : Layout_style.t -> ('k, 'v) t -> ('k, 'v) t
31
+
32
+
(** {2 Operations} *)
33
+
34
+
val map_keys : ('k -> 'k2) -> ('k, 'v) t -> ('k2, 'v) t
35
+
val map_values : ('v -> 'v2) -> ('k, 'v) t -> ('k, 'v2) t
36
+
val map : ('k -> 'v -> 'k2 * 'v2) -> ('k, 'v) t -> ('k2, 'v2) t
37
+
val length : ('k, 'v) t -> int
38
+
val is_empty : ('k, 'v) t -> bool
39
+
val find : ('k -> bool) -> ('k, 'v) t -> 'v option
40
+
val find_key : ('k -> bool) -> ('k, 'v) t -> ('k * 'v) option
41
+
val mem : ('k -> bool) -> ('k, 'v) t -> bool
42
+
val keys : ('k, 'v) t -> 'k list
43
+
val values : ('k, 'v) t -> 'v list
44
+
val iter : ('k -> 'v -> unit) -> ('k, 'v) t -> unit
45
+
val fold : ('a -> 'k -> 'v -> 'a) -> 'a -> ('k, 'v) t -> 'a
46
+
47
+
(** {2 Comparison} *)
48
+
49
+
val pp :
50
+
(Format.formatter -> 'k -> unit) ->
51
+
(Format.formatter -> 'v -> unit) ->
52
+
Format.formatter -> ('k, 'v) t -> unit
53
+
val equal : ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> ('k, 'v) t -> ('k, 'v) t -> bool
54
+
val compare : ('k -> 'k -> int) -> ('v -> 'v -> int) -> ('k, 'v) t -> ('k, 'v) t -> int
+1
-5
lib/parser.ml
+1
-5
lib/parser.ml
···
90
90
let skip_token t =
91
91
t.current_token <- None
92
92
93
-
(** Check if current token matches *)
93
+
(** Check if current token matches predicate *)
94
94
let check t pred =
95
95
match peek_token t with
96
96
| Some tok -> pred tok.token
97
97
| None -> false
98
-
99
-
(** Check for specific token *)
100
-
let check_token t token_match =
101
-
check t token_match
102
98
103
99
(** Push state onto stack *)
104
100
let push_state t s =
+41
lib/parser.mli
+41
lib/parser.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML parser - converts tokens to semantic events via state machine *)
7
+
8
+
type t
9
+
10
+
(** {2 Constructors} *)
11
+
12
+
val of_string : string -> t
13
+
(** Create parser from a string *)
14
+
15
+
val of_scanner : Scanner.t -> t
16
+
(** Create parser from a scanner *)
17
+
18
+
val of_input : Input.t -> t
19
+
(** Create parser from an input source *)
20
+
21
+
val of_reader : Bytesrw.Bytes.Reader.t -> t
22
+
(** Create parser from a Bytes.Reader *)
23
+
24
+
(** {2 Event Access} *)
25
+
26
+
val next : t -> Event.spanned option
27
+
(** Get next event *)
28
+
29
+
val peek : t -> Event.spanned option
30
+
(** Peek at next event without consuming *)
31
+
32
+
(** {2 Iteration} *)
33
+
34
+
val iter : (Event.spanned -> unit) -> t -> unit
35
+
(** Iterate over all events *)
36
+
37
+
val fold : ('a -> Event.spanned -> 'a) -> 'a -> t -> 'a
38
+
(** Fold over all events *)
39
+
40
+
val to_list : t -> Event.spanned list
41
+
(** Convert to list of events *)
+42
lib/position.mli
+42
lib/position.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Position tracking for source locations *)
7
+
8
+
type t = {
9
+
index : int; (** Byte offset from start *)
10
+
line : int; (** 1-indexed line number *)
11
+
column : int; (** 1-indexed column number *)
12
+
}
13
+
14
+
val initial : t
15
+
(** Initial position (index=0, line=1, column=1) *)
16
+
17
+
val advance_byte : t -> t
18
+
(** Advance by one byte (increments index and column) *)
19
+
20
+
val advance_line : t -> t
21
+
(** Advance to next line (increments index and line, resets column to 1) *)
22
+
23
+
val advance_char : char -> t -> t
24
+
(** Advance by one character, handling newlines appropriately *)
25
+
26
+
val advance_utf8 : Uchar.t -> t -> t
27
+
(** Advance by one Unicode character, handling newlines and multi-byte characters *)
28
+
29
+
val advance_bytes : int -> t -> t
30
+
(** Advance by n bytes *)
31
+
32
+
val pp : Format.formatter -> t -> unit
33
+
(** Pretty-print a position *)
34
+
35
+
val to_string : t -> string
36
+
(** Convert position to string *)
37
+
38
+
val compare : t -> t -> int
39
+
(** Compare two positions by index *)
40
+
41
+
val equal : t -> t -> bool
42
+
(** Test equality of two positions *)
+22
lib/quoting.mli
+22
lib/quoting.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML scalar quoting detection *)
7
+
8
+
val needs_quoting : string -> bool
9
+
(** Check if a string value needs quoting in YAML output.
10
+
Returns true if the string:
11
+
- Is empty
12
+
- Starts with an indicator character
13
+
- Is a reserved word (null, true, false, yes, no, etc.)
14
+
- Contains characters that would be ambiguous
15
+
- Looks like a number *)
16
+
17
+
val needs_double_quotes : string -> bool
18
+
(** Check if a string requires double quotes (vs single quotes).
19
+
Returns true if the string contains characters that need escape sequences. *)
20
+
21
+
val choose_style : string -> [> `Plain | `Single_quoted | `Double_quoted ]
22
+
(** Choose the appropriate quoting style for a string value *)
+2
-6
lib/scalar.ml
+2
-6
lib/scalar.ml
···
36
36
37
37
let pp fmt t =
38
38
Format.fprintf fmt "scalar(%S" t.value;
39
-
(match t.anchor with
40
-
| Some a -> Format.fprintf fmt ", anchor=%s" a
41
-
| None -> ());
42
-
(match t.tag with
43
-
| Some tag -> Format.fprintf fmt ", tag=%s" tag
44
-
| None -> ());
39
+
Option.iter (Format.fprintf fmt ", anchor=%s") t.anchor;
40
+
Option.iter (Format.fprintf fmt ", tag=%s") t.tag;
45
41
Format.fprintf fmt ", style=%a)" Scalar_style.pp t.style
46
42
47
43
let equal a b =
+38
lib/scalar.mli
+38
lib/scalar.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML scalar values with metadata *)
7
+
8
+
type t
9
+
10
+
val make :
11
+
?anchor:string ->
12
+
?tag:string ->
13
+
?plain_implicit:bool ->
14
+
?quoted_implicit:bool ->
15
+
?style:Scalar_style.t ->
16
+
string -> t
17
+
(** Create a scalar value *)
18
+
19
+
(** {2 Accessors} *)
20
+
21
+
val value : t -> string
22
+
val anchor : t -> string option
23
+
val tag : t -> string option
24
+
val style : t -> Scalar_style.t
25
+
val plain_implicit : t -> bool
26
+
val quoted_implicit : t -> bool
27
+
28
+
(** {2 Modifiers} *)
29
+
30
+
val with_anchor : string -> t -> t
31
+
val with_tag : string -> t -> t
32
+
val with_style : Scalar_style.t -> t -> t
33
+
34
+
(** {2 Comparison} *)
35
+
36
+
val pp : Format.formatter -> t -> unit
37
+
val equal : t -> t -> bool
38
+
val compare : t -> t -> int
+27
lib/scalar_style.mli
+27
lib/scalar_style.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Scalar formatting styles *)
7
+
8
+
type t = [
9
+
| `Any (** Let emitter choose *)
10
+
| `Plain (** Unquoted: foo *)
11
+
| `Single_quoted (** 'foo' *)
12
+
| `Double_quoted (** "foo" *)
13
+
| `Literal (** | block *)
14
+
| `Folded (** > block *)
15
+
]
16
+
17
+
val to_string : t -> string
18
+
(** Convert style to string representation *)
19
+
20
+
val pp : Format.formatter -> t -> unit
21
+
(** Pretty-print a style *)
22
+
23
+
val equal : t -> t -> bool
24
+
(** Test equality of two styles *)
25
+
26
+
val compare : t -> t -> int
27
+
(** Compare two styles *)
+14
-25
lib/scanner.ml
+14
-25
lib/scanner.ml
···
1431
1431
emit t span Token.Value;
1432
1432
t.pending_value <- false (* We've emitted a VALUE, no longer pending *)
1433
1433
1434
-
and fetch_alias t =
1434
+
and fetch_anchor_or_alias t ~is_alias =
1435
1435
save_simple_key t;
1436
1436
t.allow_simple_key <- false;
1437
1437
t.document_has_content <- true;
1438
1438
let start = Input.mark t.input in
1439
-
ignore (Input.next t.input); (* consume * *)
1439
+
ignore (Input.next t.input); (* consume * or & *)
1440
1440
let name, span = scan_anchor_alias t in
1441
1441
let span = Span.make ~start ~stop:span.stop in
1442
-
emit t span (Token.Alias name)
1442
+
let token = if is_alias then Token.Alias name else Token.Anchor name in
1443
+
emit t span token
1443
1444
1444
-
and fetch_anchor t =
1445
-
save_simple_key t;
1446
-
t.allow_simple_key <- false;
1447
-
t.document_has_content <- true;
1448
-
let start = Input.mark t.input in
1449
-
ignore (Input.next t.input); (* consume & *)
1450
-
let name, span = scan_anchor_alias t in
1451
-
let span = Span.make ~start ~stop:span.stop in
1452
-
emit t span (Token.Anchor name)
1445
+
and fetch_alias t = fetch_anchor_or_alias t ~is_alias:true
1446
+
and fetch_anchor t = fetch_anchor_or_alias t ~is_alias:false
1453
1447
1454
1448
and fetch_tag t =
1455
1449
save_simple_key t;
···
1465
1459
let value, style, span = scan_block_scalar t literal in
1466
1460
emit t span (Token.Scalar { style; value })
1467
1461
1468
-
and fetch_single_quoted t =
1462
+
and fetch_quoted t ~double =
1469
1463
save_simple_key t;
1470
1464
t.allow_simple_key <- false;
1471
1465
t.document_has_content <- true;
1472
-
let value, span = scan_single_quoted t in
1466
+
let value, span =
1467
+
if double then scan_double_quoted t else scan_single_quoted t
1468
+
in
1473
1469
(* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)
1474
1470
skip_to_next_token t;
1475
1471
if t.flow_level > 0 then
1476
1472
t.adjacent_value_allowed_at <- Some (Input.position t.input);
1477
-
emit t span (Token.Scalar { style = `Single_quoted; value })
1473
+
let style = if double then `Double_quoted else `Single_quoted in
1474
+
emit t span (Token.Scalar { style; value })
1478
1475
1479
-
and fetch_double_quoted t =
1480
-
save_simple_key t;
1481
-
t.allow_simple_key <- false;
1482
-
t.document_has_content <- true;
1483
-
let value, span = scan_double_quoted t in
1484
-
(* Allow adjacent values after quoted scalars in flow context (for JSON compatibility) *)
1485
-
skip_to_next_token t;
1486
-
if t.flow_level > 0 then
1487
-
t.adjacent_value_allowed_at <- Some (Input.position t.input);
1488
-
emit t span (Token.Scalar { style = `Double_quoted; value })
1476
+
and fetch_single_quoted t = fetch_quoted t ~double:false
1477
+
and fetch_double_quoted t = fetch_quoted t ~double:true
1489
1478
1490
1479
and can_start_plain t =
1491
1480
(* Check if - ? : can start a plain scalar *)
+43
lib/scanner.mli
+43
lib/scanner.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML tokenizer/scanner with lookahead for ambiguity resolution *)
7
+
8
+
type t
9
+
10
+
(** {2 Constructors} *)
11
+
12
+
val of_string : string -> t
13
+
(** Create scanner from a string *)
14
+
15
+
val of_input : Input.t -> t
16
+
(** Create scanner from an input source *)
17
+
18
+
val of_reader : Bytesrw.Bytes.Reader.t -> t
19
+
(** Create scanner from a Bytes.Reader *)
20
+
21
+
(** {2 Position} *)
22
+
23
+
val position : t -> Position.t
24
+
(** Get current position in input *)
25
+
26
+
(** {2 Token Access} *)
27
+
28
+
val next : t -> Token.spanned option
29
+
(** Get next token *)
30
+
31
+
val peek : t -> Token.spanned option
32
+
(** Peek at next token without consuming *)
33
+
34
+
(** {2 Iteration} *)
35
+
36
+
val iter : (Token.spanned -> unit) -> t -> unit
37
+
(** Iterate over all tokens *)
38
+
39
+
val fold : ('a -> Token.spanned -> 'a) -> 'a -> t -> 'a
40
+
(** Fold over all tokens *)
41
+
42
+
val to_list : t -> Token.spanned list
43
+
(** Convert to list of tokens *)
+2
-6
lib/sequence.ml
+2
-6
lib/sequence.ml
···
47
47
48
48
let pp pp_elem fmt t =
49
49
Format.fprintf fmt "@[<hv 2>sequence(@,";
50
-
(match t.anchor with
51
-
| Some a -> Format.fprintf fmt "anchor=%s,@ " a
52
-
| None -> ());
53
-
(match t.tag with
54
-
| Some tag -> Format.fprintf fmt "tag=%s,@ " tag
55
-
| None -> ());
50
+
Option.iter (Format.fprintf fmt "anchor=%s,@ ") t.anchor;
51
+
Option.iter (Format.fprintf fmt "tag=%s,@ ") t.tag;
56
52
Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;
57
53
Format.fprintf fmt "members=[@,%a@]@,)"
58
54
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") pp_elem)
+46
lib/sequence.mli
+46
lib/sequence.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML sequence (array) values with metadata *)
7
+
8
+
type 'a t
9
+
10
+
val make :
11
+
?anchor:string ->
12
+
?tag:string ->
13
+
?implicit:bool ->
14
+
?style:Layout_style.t ->
15
+
'a list -> 'a t
16
+
(** Create a sequence *)
17
+
18
+
(** {2 Accessors} *)
19
+
20
+
val members : 'a t -> 'a list
21
+
val anchor : 'a t -> string option
22
+
val tag : 'a t -> string option
23
+
val implicit : 'a t -> bool
24
+
val style : 'a t -> Layout_style.t
25
+
26
+
(** {2 Modifiers} *)
27
+
28
+
val with_anchor : string -> 'a t -> 'a t
29
+
val with_tag : string -> 'a t -> 'a t
30
+
val with_style : Layout_style.t -> 'a t -> 'a t
31
+
32
+
(** {2 Operations} *)
33
+
34
+
val map : ('a -> 'b) -> 'a t -> 'b t
35
+
val length : 'a t -> int
36
+
val is_empty : 'a t -> bool
37
+
val nth : 'a t -> int -> 'a
38
+
val nth_opt : 'a t -> int -> 'a option
39
+
val iter : ('a -> unit) -> 'a t -> unit
40
+
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
41
+
42
+
(** {2 Comparison} *)
43
+
44
+
val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
45
+
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
46
+
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+10
-20
lib/serialize.ml
+10
-20
lib/serialize.ml
···
29
29
30
30
| `A seq ->
31
31
let members = Sequence.members seq in
32
-
let style =
33
-
(* Force flow style for empty sequences *)
34
-
if members = [] then `Flow
35
-
else Sequence.style seq
36
-
in
32
+
(* Force flow style for empty sequences *)
33
+
let style = if members = [] then `Flow else Sequence.style seq in
37
34
emit (Event.Sequence_start {
38
35
anchor = Sequence.anchor seq;
39
36
tag = Sequence.tag seq;
···
45
42
46
43
| `O map ->
47
44
let members = Mapping.members map in
48
-
let style =
49
-
(* Force flow style for empty mappings *)
50
-
if members = [] then `Flow
51
-
else Mapping.style map
52
-
in
45
+
(* Force flow style for empty mappings *)
46
+
let style = if members = [] then `Flow else Mapping.style map in
53
47
emit (Event.Mapping_start {
54
48
anchor = Mapping.anchor map;
55
49
tag = Mapping.tag map;
···
111
105
})
112
106
113
107
| `A items ->
108
+
(* Force flow style for empty sequences, otherwise use config *)
114
109
let style =
115
-
(* Force flow style for empty sequences *)
116
-
if items = [] then `Flow
117
-
else if config.Emitter.layout_style = `Flow then `Flow
118
-
else `Block
110
+
if items = [] || config.Emitter.layout_style = `Flow then `Flow else `Block
119
111
in
120
112
emit (Event.Sequence_start {
121
113
anchor = None; tag = None;
···
126
118
emit Event.Sequence_end
127
119
128
120
| `O pairs ->
121
+
(* Force flow style for empty mappings, otherwise use config *)
129
122
let style =
130
-
(* Force flow style for empty mappings *)
131
-
if pairs = [] then `Flow
132
-
else if config.Emitter.layout_style = `Flow then `Flow
133
-
else `Block
123
+
if pairs = [] || config.Emitter.layout_style = `Flow then `Flow else `Block
134
124
in
135
125
emit (Event.Mapping_start {
136
126
anchor = None; tag = None;
···
339
329
emit_yaml_node_impl ~emit:emitter yaml
340
330
341
331
(** Emit a complete YAML stream using an emitter function *)
342
-
let emit_yaml ~emitter ~config yaml =
332
+
let emit_yaml_fn ~emitter ~config yaml =
343
333
emitter (Event.Stream_start { encoding = config.Emitter.encoding });
344
334
emitter (Event.Document_start { version = None; implicit = true });
345
335
emit_yaml_node_fn ~emitter yaml;
···
351
341
emit_value_node_impl ~emit:emitter ~config value
352
342
353
343
(** Emit a complete Value stream using an emitter function *)
354
-
let emit_value ~emitter ~config value =
344
+
let emit_value_fn ~emitter ~config value =
355
345
emitter (Event.Stream_start { encoding = config.Emitter.encoding });
356
346
emitter (Event.Document_start { version = None; implicit = true });
357
347
emit_value_node_fn ~emitter ~config value;
+133
lib/serialize.mli
+133
lib/serialize.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Serialize - high-level serialization to buffers and event streams
7
+
8
+
This module provides functions to convert YAML values to events and strings.
9
+
Both {!Emitter.t}-based and function-based emission APIs are provided. *)
10
+
11
+
(** {1 Emitter.t-based API} *)
12
+
13
+
val emit_yaml_node : Emitter.t -> Yaml.t -> unit
14
+
(** Emit a YAML node to an emitter *)
15
+
16
+
val emit_yaml : Emitter.t -> Yaml.t -> unit
17
+
(** Emit a complete YAML document to an emitter (includes stream/document markers) *)
18
+
19
+
val emit_value_node : Emitter.t -> Value.t -> unit
20
+
(** Emit a Value node to an emitter *)
21
+
22
+
val emit_value : Emitter.t -> Value.t -> unit
23
+
(** Emit a complete Value document to an emitter (includes stream/document markers) *)
24
+
25
+
val emit_document : ?resolve_aliases:bool -> Emitter.t -> Document.t -> unit
26
+
(** Emit a document to an emitter
27
+
28
+
@param resolve_aliases Whether to resolve aliases before emission (default true) *)
29
+
30
+
(** {1 Buffer-based API} *)
31
+
32
+
val value_to_buffer :
33
+
?config:Emitter.config ->
34
+
?buffer:Buffer.t ->
35
+
Value.t -> Buffer.t
36
+
(** Serialize a Value to a buffer
37
+
38
+
@param config Emitter configuration (default: {!Emitter.default_config})
39
+
@param buffer Optional buffer to append to; creates new one if not provided *)
40
+
41
+
val yaml_to_buffer :
42
+
?config:Emitter.config ->
43
+
?buffer:Buffer.t ->
44
+
Yaml.t -> Buffer.t
45
+
(** Serialize a Yaml.t to a buffer *)
46
+
47
+
val documents_to_buffer :
48
+
?config:Emitter.config ->
49
+
?resolve_aliases:bool ->
50
+
?buffer:Buffer.t ->
51
+
Document.t list -> Buffer.t
52
+
(** Serialize documents to a buffer
53
+
54
+
@param resolve_aliases Whether to resolve aliases before emission (default true) *)
55
+
56
+
(** {1 String-based API} *)
57
+
58
+
val value_to_string : ?config:Emitter.config -> Value.t -> string
59
+
(** Serialize a Value to a string *)
60
+
61
+
val yaml_to_string : ?config:Emitter.config -> Yaml.t -> string
62
+
(** Serialize a Yaml.t to a string *)
63
+
64
+
val documents_to_string :
65
+
?config:Emitter.config ->
66
+
?resolve_aliases:bool ->
67
+
Document.t list -> string
68
+
(** Serialize documents to a string *)
69
+
70
+
(** {1 Writer-based API}
71
+
72
+
These functions write directly to a bytesrw [Bytes.Writer.t],
73
+
enabling true streaming output without intermediate string allocation. *)
74
+
75
+
val value_to_writer :
76
+
?config:Emitter.config ->
77
+
?eod:bool ->
78
+
Bytesrw.Bytes.Writer.t -> Value.t -> unit
79
+
(** Serialize a Value directly to a Bytes.Writer
80
+
81
+
@param eod Whether to write end-of-data after serialization (default true) *)
82
+
83
+
val yaml_to_writer :
84
+
?config:Emitter.config ->
85
+
?eod:bool ->
86
+
Bytesrw.Bytes.Writer.t -> Yaml.t -> unit
87
+
(** Serialize a Yaml.t directly to a Bytes.Writer *)
88
+
89
+
val documents_to_writer :
90
+
?config:Emitter.config ->
91
+
?resolve_aliases:bool ->
92
+
?eod:bool ->
93
+
Bytesrw.Bytes.Writer.t -> Document.t list -> unit
94
+
(** Serialize documents directly to a Bytes.Writer *)
95
+
96
+
(** {1 Function-based API}
97
+
98
+
These functions accept an emit function [Event.t -> unit] instead of
99
+
an {!Emitter.t}, allowing them to work with any event sink. *)
100
+
101
+
val emit_yaml_node_fn : emitter:(Event.t -> unit) -> Yaml.t -> unit
102
+
(** Emit a YAML node using an emitter function *)
103
+
104
+
val emit_yaml_fn :
105
+
emitter:(Event.t -> unit) ->
106
+
config:Emitter.config ->
107
+
Yaml.t -> unit
108
+
(** Emit a complete YAML stream using an emitter function *)
109
+
110
+
val emit_value_node_fn :
111
+
emitter:(Event.t -> unit) ->
112
+
config:Emitter.config ->
113
+
Value.t -> unit
114
+
(** Emit a Value node using an emitter function *)
115
+
116
+
val emit_value_fn :
117
+
emitter:(Event.t -> unit) ->
118
+
config:Emitter.config ->
119
+
Value.t -> unit
120
+
(** Emit a complete Value stream using an emitter function *)
121
+
122
+
val emit_document_fn :
123
+
?resolve_aliases:bool ->
124
+
emitter:(Event.t -> unit) ->
125
+
Document.t -> unit
126
+
(** Emit a document using an emitter function *)
127
+
128
+
val emit_documents :
129
+
emitter:(Event.t -> unit) ->
130
+
config:Emitter.config ->
131
+
?resolve_aliases:bool ->
132
+
Document.t list -> unit
133
+
(** Emit multiple documents using an emitter function *)
+35
lib/span.mli
+35
lib/span.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Source spans representing ranges in input *)
7
+
8
+
type t = {
9
+
start : Position.t;
10
+
stop : Position.t;
11
+
}
12
+
13
+
val make : start:Position.t -> stop:Position.t -> t
14
+
(** Create a span from start and stop positions *)
15
+
16
+
val point : Position.t -> t
17
+
(** Create a zero-width span at a single position *)
18
+
19
+
val merge : t -> t -> t
20
+
(** Merge two spans into one covering both *)
21
+
22
+
val extend : t -> Position.t -> t
23
+
(** Extend a span to a new stop position *)
24
+
25
+
val pp : Format.formatter -> t -> unit
26
+
(** Pretty-print a span *)
27
+
28
+
val to_string : t -> string
29
+
(** Convert span to string *)
30
+
31
+
val compare : t -> t -> int
32
+
(** Compare two spans *)
33
+
34
+
val equal : t -> t -> bool
35
+
(** Test equality of two spans *)
+54
lib/tag.mli
+54
lib/tag.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML tags for type information *)
7
+
8
+
type t = {
9
+
handle : string; (** e.g., "!" or "!!" or "!foo!" *)
10
+
suffix : string; (** e.g., "str", "int", "custom/type" *)
11
+
}
12
+
13
+
val make : handle:string -> suffix:string -> t
14
+
(** Create a tag from handle and suffix *)
15
+
16
+
val of_string : string -> t option
17
+
(** Parse a tag string *)
18
+
19
+
val to_string : t -> string
20
+
(** Convert tag to string representation *)
21
+
22
+
val to_uri : t -> string
23
+
(** Convert tag to full URI representation *)
24
+
25
+
val pp : Format.formatter -> t -> unit
26
+
(** Pretty-print a tag *)
27
+
28
+
val equal : t -> t -> bool
29
+
(** Test equality of two tags *)
30
+
31
+
val compare : t -> t -> int
32
+
(** Compare two tags *)
33
+
34
+
(** {2 Standard Tags} *)
35
+
36
+
val null : t
37
+
val bool : t
38
+
val int : t
39
+
val float : t
40
+
val str : t
41
+
val seq : t
42
+
val map : t
43
+
val binary : t
44
+
val timestamp : t
45
+
46
+
(** {2 Tag Predicates} *)
47
+
48
+
val is_null : t -> bool
49
+
val is_bool : t -> bool
50
+
val is_int : t -> bool
51
+
val is_float : t -> bool
52
+
val is_str : t -> bool
53
+
val is_seq : t -> bool
54
+
val is_map : t -> bool
+43
lib/token.mli
+43
lib/token.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** YAML token types produced by the scanner *)
7
+
8
+
type t =
9
+
| Stream_start of Encoding.t
10
+
| Stream_end
11
+
| Version_directive of { major : int; minor : int }
12
+
| Tag_directive of { handle : string; prefix : string }
13
+
| Document_start (** --- *)
14
+
| Document_end (** ... *)
15
+
| Block_sequence_start
16
+
| Block_mapping_start
17
+
| Block_entry (** - *)
18
+
| Block_end (** implicit, from dedent *)
19
+
| Flow_sequence_start (** \[ *)
20
+
| Flow_sequence_end (** \] *)
21
+
| Flow_mapping_start (** \{ *)
22
+
| Flow_mapping_end (** \} *)
23
+
| Flow_entry (** , *)
24
+
| Key (** ? or implicit key *)
25
+
| Value (** : *)
26
+
| Anchor of string (** &name *)
27
+
| Alias of string (** *name *)
28
+
| Tag of { handle : string; suffix : string }
29
+
| Scalar of { style : Scalar_style.t; value : string }
30
+
31
+
type spanned = {
32
+
token : t;
33
+
span : Span.t;
34
+
}
35
+
36
+
val pp_token : Format.formatter -> t -> unit
37
+
(** Pretty-print a token *)
38
+
39
+
val pp : Format.formatter -> t -> unit
40
+
(** Pretty-print a token (alias for pp_token) *)
41
+
42
+
val pp_spanned : Format.formatter -> spanned -> unit
43
+
(** Pretty-print a spanned token *)
+70
lib/value.mli
+70
lib/value.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JSON-compatible YAML value representation *)
7
+
8
+
type t = [
9
+
| `Null
10
+
| `Bool of bool
11
+
| `Float of float
12
+
| `String of string
13
+
| `A of t list
14
+
| `O of (string * t) list
15
+
]
16
+
17
+
(** {2 Constructors} *)
18
+
19
+
val null : t
20
+
val bool : bool -> t
21
+
val int : int -> t
22
+
val float : float -> t
23
+
val string : string -> t
24
+
val list : ('a -> t) -> 'a list -> t
25
+
val obj : (string * t) list -> t
26
+
27
+
(** {2 Type Name} *)
28
+
29
+
val type_name : t -> string
30
+
(** Get the type name for error messages *)
31
+
32
+
(** {2 Safe Accessors} *)
33
+
34
+
val as_null : t -> unit option
35
+
val as_bool : t -> bool option
36
+
val as_float : t -> float option
37
+
val as_string : t -> string option
38
+
val as_list : t -> t list option
39
+
val as_assoc : t -> (string * t) list option
40
+
val as_int : t -> int option
41
+
42
+
(** {2 Unsafe Accessors} *)
43
+
44
+
val to_null : t -> unit
45
+
val to_bool : t -> bool
46
+
val to_float : t -> float
47
+
val to_string : t -> string
48
+
val to_list : t -> t list
49
+
val to_assoc : t -> (string * t) list
50
+
val to_int : t -> int
51
+
52
+
(** {2 Object Access} *)
53
+
54
+
val mem : string -> t -> bool
55
+
val find : string -> t -> t option
56
+
val get : string -> t -> t
57
+
val keys : t -> string list
58
+
val values : t -> t list
59
+
60
+
(** {2 Combinators} *)
61
+
62
+
val combine : t -> t -> t
63
+
val map : (t -> t) -> t -> t
64
+
val filter : (t -> bool) -> t -> t
65
+
66
+
(** {2 Comparison} *)
67
+
68
+
val pp : Format.formatter -> t -> unit
69
+
val equal : t -> t -> bool
70
+
val compare : t -> t -> int
+3
-9
lib/yaml.ml
+3
-9
lib/yaml.ml
···
110
110
match v with
111
111
| `Scalar s ->
112
112
(* Register anchor after we have the resolved node *)
113
-
(match Scalar.anchor s with
114
-
| Some name -> register_anchor name v
115
-
| None -> ());
113
+
Option.iter (fun name -> register_anchor name v) (Scalar.anchor s);
116
114
v
117
115
| `Alias name ->
118
116
expand_alias ~depth name
···
126
124
~style:(Sequence.style seq)
127
125
resolved_members) in
128
126
(* Register anchor with resolved node *)
129
-
(match Sequence.anchor seq with
130
-
| Some name -> register_anchor name resolved
131
-
| None -> ());
127
+
Option.iter (fun name -> register_anchor name resolved) (Sequence.anchor seq);
132
128
resolved
133
129
| `O map ->
134
130
(* Process key-value pairs in document order *)
···
144
140
~style:(Mapping.style map)
145
141
resolved_pairs) in
146
142
(* Register anchor with resolved node *)
147
-
(match Mapping.anchor map with
148
-
| Some name -> register_anchor name resolved
149
-
| None -> ());
143
+
Option.iter (fun name -> register_anchor name resolved) (Mapping.anchor map);
150
144
resolved
151
145
in
152
146
resolve ~depth:0 root
+63
lib/yaml.mli
+63
lib/yaml.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Full YAML representation with anchors, tags, and aliases *)
7
+
8
+
type t = [
9
+
| `Scalar of Scalar.t
10
+
| `Alias of string
11
+
| `A of t Sequence.t
12
+
| `O of (t, t) Mapping.t
13
+
]
14
+
15
+
(** {2 Pretty Printing} *)
16
+
17
+
val pp : Format.formatter -> t -> unit
18
+
19
+
(** {2 Equality} *)
20
+
21
+
val equal : t -> t -> bool
22
+
23
+
(** {2 Conversion from Value} *)
24
+
25
+
val of_value : Value.t -> t
26
+
(** Construct from JSON-compatible Value *)
27
+
28
+
(** {2 Alias Resolution} *)
29
+
30
+
val default_max_alias_nodes : int
31
+
(** Default maximum nodes during alias expansion (10 million) *)
32
+
33
+
val default_max_alias_depth : int
34
+
(** Default maximum alias nesting depth (100) *)
35
+
36
+
val resolve_aliases : ?max_nodes:int -> ?max_depth:int -> t -> t
37
+
(** Resolve aliases by replacing them with referenced nodes.
38
+
39
+
@param max_nodes Maximum number of nodes to create during expansion
40
+
@param max_depth Maximum depth of alias-within-alias resolution
41
+
@raise Error.Yamlrw_error if limits exceeded or undefined alias found *)
42
+
43
+
(** {2 Conversion to Value} *)
44
+
45
+
val to_value :
46
+
?resolve_aliases_first:bool ->
47
+
?max_nodes:int ->
48
+
?max_depth:int ->
49
+
t -> Value.t
50
+
(** Convert to JSON-compatible Value.
51
+
52
+
@param resolve_aliases_first Whether to resolve aliases before conversion (default true)
53
+
@param max_nodes Maximum nodes during alias expansion
54
+
@param max_depth Maximum alias nesting depth
55
+
@raise Error.Yamlrw_error if unresolved aliases encountered *)
56
+
57
+
(** {2 Node Accessors} *)
58
+
59
+
val anchor : t -> string option
60
+
(** Get anchor from any node *)
61
+
62
+
val tag : t -> string option
63
+
(** Get tag from any node *)
+140
tests/test_yamlrw.ml
+140
tests/test_yamlrw.ml
···
343
343
"resolve_aliases false", `Quick, test_resolve_aliases_false;
344
344
]
345
345
346
+
(** Bug fix regression tests
347
+
These tests verify that issues fixed in ocaml-yaml don't occur in ocaml-yamlrw *)
348
+
349
+
(* Test for roundtrip of special string values (ocaml-yaml fix 225387d)
350
+
Strings like "true", "1.0", "null" etc. must be quoted on output so that
351
+
they round-trip correctly as strings, not as booleans/numbers/null *)
352
+
let test_roundtrip_string_true () =
353
+
let original = `String "true" in
354
+
let emitted = to_string original in
355
+
let parsed = of_string emitted in
356
+
check_value "String 'true' roundtrips" original parsed
357
+
358
+
let test_roundtrip_string_false () =
359
+
let original = `String "false" in
360
+
let emitted = to_string original in
361
+
let parsed = of_string emitted in
362
+
check_value "String 'false' roundtrips" original parsed
363
+
364
+
let test_roundtrip_string_null () =
365
+
let original = `String "null" in
366
+
let emitted = to_string original in
367
+
let parsed = of_string emitted in
368
+
check_value "String 'null' roundtrips" original parsed
369
+
370
+
let test_roundtrip_string_number () =
371
+
let original = `String "1.0" in
372
+
let emitted = to_string original in
373
+
let parsed = of_string emitted in
374
+
check_value "String '1.0' roundtrips" original parsed
375
+
376
+
let test_roundtrip_string_integer () =
377
+
let original = `String "42" in
378
+
let emitted = to_string original in
379
+
let parsed = of_string emitted in
380
+
check_value "String '42' roundtrips" original parsed
381
+
382
+
let test_roundtrip_string_yes () =
383
+
let original = `String "yes" in
384
+
let emitted = to_string original in
385
+
let parsed = of_string emitted in
386
+
check_value "String 'yes' roundtrips" original parsed
387
+
388
+
let test_roundtrip_string_no () =
389
+
let original = `String "no" in
390
+
let emitted = to_string original in
391
+
let parsed = of_string emitted in
392
+
check_value "String 'no' roundtrips" original parsed
393
+
394
+
(* Test for integer display without decimal point (ocaml-yaml fix 999b1aa)
395
+
Float values that are integers should be emitted as "42" not "42." or "42.0" *)
396
+
let test_emit_integer_float () =
397
+
let value = `Float 42.0 in
398
+
let result = to_string value in
399
+
(* Check the result doesn't contain "42." or "42.0" *)
400
+
Alcotest.(check bool) "no trailing dot"
401
+
true (not (String.length result >= 3 &&
402
+
result.[0] = '4' && result.[1] = '2' && result.[2] = '.'))
403
+
404
+
let test_emit_negative_integer_float () =
405
+
let value = `Float (-17.0) in
406
+
let result = to_string value in
407
+
let parsed = of_string result in
408
+
check_value "negative integer float roundtrips" value parsed
409
+
410
+
(* Test for special YAML floats: .nan, .inf, -.inf *)
411
+
let test_parse_special_floats () =
412
+
let inf_result = of_string ".inf" in
413
+
(match inf_result with
414
+
| `Float f when Float.is_inf f && f > 0.0 -> ()
415
+
| _ -> Alcotest.fail "expected positive infinity");
416
+
let neg_inf_result = of_string "-.inf" in
417
+
(match neg_inf_result with
418
+
| `Float f when Float.is_inf f && f < 0.0 -> ()
419
+
| _ -> Alcotest.fail "expected negative infinity");
420
+
let nan_result = of_string ".nan" in
421
+
(match nan_result with
422
+
| `Float f when Float.is_nan f -> ()
423
+
| _ -> Alcotest.fail "expected NaN")
424
+
425
+
(* Test that bare "inf", "nan", "infinity" are NOT parsed as floats
426
+
(ocaml-yaml issue - OCaml's Float.of_string accepts these but YAML doesn't) *)
427
+
let test_bare_inf_nan_are_strings () =
428
+
let inf_result = of_string "inf" in
429
+
(match inf_result with
430
+
| `String "inf" -> ()
431
+
| `Float _ -> Alcotest.fail "'inf' should be string, not float"
432
+
| _ -> Alcotest.fail "expected string 'inf'");
433
+
let nan_result = of_string "nan" in
434
+
(match nan_result with
435
+
| `String "nan" -> ()
436
+
| `Float _ -> Alcotest.fail "'nan' should be string, not float"
437
+
| _ -> Alcotest.fail "expected string 'nan'");
438
+
let infinity_result = of_string "infinity" in
439
+
(match infinity_result with
440
+
| `String "infinity" -> ()
441
+
| `Float _ -> Alcotest.fail "'infinity' should be string, not float"
442
+
| _ -> Alcotest.fail "expected string 'infinity'")
443
+
444
+
(* Test for quoted scalar preservation *)
445
+
let test_quoted_scalar_preserved () =
446
+
(* When a scalar is quoted, it should be preserved as a string even if
447
+
it looks like a number/boolean *)
448
+
check_value "double-quoted true is string"
449
+
(`String "true") (of_string {|"true"|});
450
+
check_value "single-quoted 42 is string"
451
+
(`String "42") (of_string "'42'");
452
+
check_value "double-quoted null is string"
453
+
(`String "null") (of_string {|"null"|})
454
+
455
+
(* Test complex roundtrip with mixed types *)
456
+
let test_complex_roundtrip () =
457
+
let original = `O [
458
+
("string_true", `String "true");
459
+
("bool_true", `Bool true);
460
+
("string_42", `String "42");
461
+
("int_42", `Float 42.0);
462
+
("string_null", `String "null");
463
+
("actual_null", `Null);
464
+
] in
465
+
let emitted = to_string original in
466
+
let parsed = of_string emitted in
467
+
check_value "complex roundtrip preserves types" original parsed
468
+
469
+
let bugfix_regression_tests = [
470
+
"roundtrip string 'true'", `Quick, test_roundtrip_string_true;
471
+
"roundtrip string 'false'", `Quick, test_roundtrip_string_false;
472
+
"roundtrip string 'null'", `Quick, test_roundtrip_string_null;
473
+
"roundtrip string '1.0'", `Quick, test_roundtrip_string_number;
474
+
"roundtrip string '42'", `Quick, test_roundtrip_string_integer;
475
+
"roundtrip string 'yes'", `Quick, test_roundtrip_string_yes;
476
+
"roundtrip string 'no'", `Quick, test_roundtrip_string_no;
477
+
"emit integer float without decimal", `Quick, test_emit_integer_float;
478
+
"emit negative integer float", `Quick, test_emit_negative_integer_float;
479
+
"parse special floats (.inf, -.inf, .nan)", `Quick, test_parse_special_floats;
480
+
"bare inf/nan/infinity are strings", `Quick, test_bare_inf_nan_are_strings;
481
+
"quoted scalars preserved as strings", `Quick, test_quoted_scalar_preserved;
482
+
"complex roundtrip preserves types", `Quick, test_complex_roundtrip;
483
+
]
484
+
346
485
(** Run all tests *)
347
486
348
487
let () =
···
355
494
"multiline", multiline_tests;
356
495
"errors", error_tests;
357
496
"alias_limits", alias_limit_tests;
497
+
"bugfix_regression", bugfix_regression_tests;
358
498
]