Pure OCaml Yaml 1.2 reader and writer using Bytesrw
anil.recoil.org
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(** Stack frame for building nested structures *)
9type frame =
10 | Sequence_frame of {
11 anchor : string option;
12 tag : string option;
13 implicit : bool;
14 style : Layout_style.t;
15 items : Yaml.t list;
16 }
17 | Mapping_frame of {
18 anchor : string option;
19 tag : string option;
20 implicit : bool;
21 style : Layout_style.t;
22 pairs : (Yaml.t * Yaml.t) list;
23 pending_key : Yaml.t option;
24 }
25
26type state = {
27 mutable stack : frame list;
28 mutable current : Yaml.t option;
29 mutable documents : Document.t list;
30 mutable doc_version : (int * int) option;
31 mutable doc_implicit_start : bool;
32}
33
34let create_state () = {
35 stack = [];
36 current = None;
37 documents = [];
38 doc_version = None;
39 doc_implicit_start = true;
40}
41
42(** Process a single event *)
43let rec process_event state (ev : Event.spanned) =
44 match ev.event with
45 | Event.Stream_start _ -> ()
46
47 | Event.Stream_end -> ()
48
49 | Event.Document_start { version; implicit } ->
50 state.doc_version <- version;
51 state.doc_implicit_start <- implicit
52
53 | Event.Document_end { implicit } ->
54 let doc = Document.make
55 ?version:state.doc_version
56 ~implicit_start:state.doc_implicit_start
57 ~implicit_end:implicit
58 state.current
59 in
60 state.documents <- doc :: state.documents;
61 state.current <- None;
62 state.doc_version <- None;
63 state.doc_implicit_start <- true
64
65 | Event.Alias { anchor } ->
66 let node : Yaml.t = `Alias anchor in
67 add_node state node
68
69 | Event.Scalar { anchor; tag; value; plain_implicit; quoted_implicit; style } ->
70 let scalar = Scalar.make
71 ?anchor ?tag
72 ~plain_implicit ~quoted_implicit
73 ~style value
74 in
75 let node : Yaml.t = `Scalar scalar in
76 add_node state node
77
78 | Event.Sequence_start { anchor; tag; implicit; style } ->
79 let frame = Sequence_frame {
80 anchor; tag; implicit; style;
81 items = [];
82 } in
83 state.stack <- frame :: state.stack
84
85 | Event.Sequence_end ->
86 (match state.stack with
87 | Sequence_frame { anchor; tag; implicit; style; items } :: rest ->
88 let seq = Sequence.make ?anchor ?tag ~implicit ~style (List.rev items) in
89 let node : Yaml.t = `A seq in
90 state.stack <- rest;
91 add_node state node
92 | _ -> Error.raise (Invalid_state "unexpected sequence end"))
93
94 | Event.Mapping_start { anchor; tag; implicit; style } ->
95 let frame = Mapping_frame {
96 anchor; tag; implicit; style;
97 pairs = [];
98 pending_key = None;
99 } in
100 state.stack <- frame :: state.stack
101
102 | Event.Mapping_end ->
103 (match state.stack with
104 | Mapping_frame { anchor; tag; implicit; style; pairs; pending_key = None } :: rest ->
105 let map = Mapping.make ?anchor ?tag ~implicit ~style (List.rev pairs) in
106 let node : Yaml.t = `O map in
107 state.stack <- rest;
108 add_node state node
109 | Mapping_frame { pending_key = Some _; _ } :: _ ->
110 Error.raise (Invalid_state "mapping ended with pending key")
111 | _ -> Error.raise (Invalid_state "unexpected mapping end"))
112
113(** Add a node to current context *)
114and add_node state node =
115 match state.stack with
116 | [] ->
117 state.current <- Some node
118
119 | Sequence_frame f :: rest ->
120 state.stack <- Sequence_frame { f with items = node :: f.items } :: rest
121
122 | Mapping_frame f :: rest ->
123 (match f.pending_key with
124 | None ->
125 (* This is a key *)
126 state.stack <- Mapping_frame { f with pending_key = Some node } :: rest
127 | Some key ->
128 (* This is a value *)
129 state.stack <- Mapping_frame {
130 f with
131 pairs = (key, node) :: f.pairs;
132 pending_key = None;
133 } :: rest)
134
135(** Internal: parse all documents from a parser *)
136let 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 *)
142let single_document_or_error docs ~empty =
143 match docs with
144 | [] -> empty
145 | [doc] -> doc
146 | _ -> Error.raise Multiple_documents
147
148(** Load single document as Value.
149
150 @param resolve_aliases Whether to resolve aliases (default true)
151 @param max_nodes Maximum nodes during alias expansion (default 10M)
152 @param max_depth Maximum alias nesting depth (default 100)
153*)
154let value_of_string
155 ?(resolve_aliases = true)
156 ?(max_nodes = Yaml.default_max_alias_nodes)
157 ?(max_depth = Yaml.default_max_alias_depth)
158 s =
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
165
166(** Load single document as Yaml.
167
168 @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)
169 @param max_nodes Maximum nodes during alias expansion (default 10M)
170 @param max_depth Maximum alias nesting depth (default 100)
171*)
172let yaml_of_string
173 ?(resolve_aliases = false)
174 ?(max_nodes = Yaml.default_max_alias_nodes)
175 ?(max_depth = Yaml.default_max_alias_depth)
176 s =
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
186
187(** Load all documents *)
188let documents_of_string s =
189 parse_all_documents (Parser.of_string s)
190
191(** {2 Reader-based loading} *)
192
193(** Load single document as Value from a Bytes.Reader.
194
195 @param resolve_aliases Whether to resolve aliases (default true)
196 @param max_nodes Maximum nodes during alias expansion (default 10M)
197 @param max_depth Maximum alias nesting depth (default 100)
198*)
199let value_of_reader
200 ?(resolve_aliases = true)
201 ?(max_nodes = Yaml.default_max_alias_nodes)
202 ?(max_depth = Yaml.default_max_alias_depth)
203 reader =
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
210
211(** Load single document as Yaml from a Bytes.Reader.
212
213 @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)
214 @param max_nodes Maximum nodes during alias expansion (default 10M)
215 @param max_depth Maximum alias nesting depth (default 100)
216*)
217let yaml_of_reader
218 ?(resolve_aliases = false)
219 ?(max_nodes = Yaml.default_max_alias_nodes)
220 ?(max_depth = Yaml.default_max_alias_depth)
221 reader =
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
231
232(** Load all documents from a Bytes.Reader *)
233let documents_of_reader reader =
234 parse_all_documents (Parser.of_reader reader)
235
236(** {2 Parser-function based loading}
237
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 *)
243let load_generic_fn extract next_event =
244 let state = create_state () in
245 let rec loop () =
246 match next_event () with
247 | None -> None
248 | Some ev ->
249 process_event state ev;
250 match ev.event with
251 | Event.Document_end _ ->
252 (match state.documents with
253 | doc :: _ ->
254 state.documents <- [];
255 Some (extract doc)
256 | [] -> None)
257 | Event.Stream_end -> None
258 | _ -> loop ()
259 in
260 loop ()
261
262(** Generic document loader - extracts common pattern from load_* functions *)
263let load_generic extract parser =
264 load_generic_fn extract (fun () -> Parser.next parser)
265
266(** Load single Value from parser.
267
268 @param resolve_aliases Whether to resolve aliases (default true)
269 @param max_nodes Maximum nodes during alias expansion (default 10M)
270 @param max_depth Maximum alias nesting depth (default 100)
271*)
272let load_value
273 ?(resolve_aliases = true)
274 ?(max_nodes = Yaml.default_max_alias_nodes)
275 ?(max_depth = Yaml.default_max_alias_depth)
276 parser =
277 load_generic (fun doc ->
278 match Document.root doc with
279 | None -> `Null
280 | Some yaml ->
281 Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml
282 ) parser
283
284(** Load single Yaml from parser *)
285let load_yaml parser =
286 load_generic (fun doc ->
287 Document.root doc |> Option.value ~default:(`Scalar (Scalar.make ""))
288 ) parser
289
290(** Load single Document from parser *)
291let load_document parser =
292 load_generic Fun.id parser
293
294(** Iterate over documents *)
295let iter_documents f parser =
296 let rec loop () =
297 match load_document parser with
298 | None -> ()
299 | Some doc -> f doc; loop ()
300 in
301 loop ()
302
303(** Fold over documents *)
304let fold_documents f init parser =
305 let rec loop acc =
306 match load_document parser with
307 | None -> acc
308 | Some doc -> loop (f acc doc)
309 in
310 loop init
311
312(** Load single Value from event source.
313
314 @param resolve_aliases Whether to resolve aliases (default true)
315 @param max_nodes Maximum nodes during alias expansion (default 10M)
316 @param max_depth Maximum alias nesting depth (default 100)
317*)
318let value_of_parser
319 ?(resolve_aliases = true)
320 ?(max_nodes = Yaml.default_max_alias_nodes)
321 ?(max_depth = Yaml.default_max_alias_depth)
322 next_event =
323 match load_generic_fn (fun doc ->
324 match Document.root doc with
325 | None -> `Null
326 | Some yaml ->
327 Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml
328 ) next_event with
329 | Some v -> v
330 | None -> `Null
331
332(** Load single Yaml from event source.
333
334 @param resolve_aliases Whether to resolve aliases (default false)
335 @param max_nodes Maximum nodes during alias expansion (default 10M)
336 @param max_depth Maximum alias nesting depth (default 100)
337*)
338let yaml_of_parser
339 ?(resolve_aliases = false)
340 ?(max_nodes = Yaml.default_max_alias_nodes)
341 ?(max_depth = Yaml.default_max_alias_depth)
342 next_event =
343 match load_generic_fn (fun doc ->
344 match Document.root doc with
345 | None -> `Scalar (Scalar.make "")
346 | Some yaml ->
347 if resolve_aliases then
348 Yaml.resolve_aliases ~max_nodes ~max_depth yaml
349 else
350 yaml
351 ) next_event with
352 | Some v -> v
353 | None -> `Scalar (Scalar.make "")
354
355(** Load single Document from event source *)
356let document_of_parser next_event =
357 load_generic_fn Fun.id next_event
358
359(** Load all documents from event source *)
360let documents_of_parser next_event =
361 let state = create_state () in
362 let rec loop () =
363 match next_event () with
364 | None -> List.rev state.documents
365 | Some ev ->
366 process_event state ev;
367 loop ()
368 in
369 loop ()
370
371(** Iterate over documents from event source *)
372let iter_documents_parser f next_event =
373 let rec loop () =
374 match document_of_parser next_event with
375 | None -> ()
376 | Some doc -> f doc; loop ()
377 in
378 loop ()
379
380(** Fold over documents from event source *)
381let fold_documents_parser f init next_event =
382 let rec loop acc =
383 match document_of_parser next_event with
384 | None -> acc
385 | Some doc -> loop (f acc doc)
386 in
387 loop init