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(** 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 Internal Helpers} *)
12
13(** Emit a YAML node using an emit function.
14 This is the core implementation used by both Emitter.t and function-based APIs. *)
15let rec emit_yaml_node_impl ~emit (yaml : Yaml.t) =
16 match yaml with
17 | `Scalar s ->
18 emit (Event.Scalar {
19 anchor = Scalar.anchor s;
20 tag = Scalar.tag s;
21 value = Scalar.value s;
22 plain_implicit = Scalar.plain_implicit s;
23 quoted_implicit = Scalar.quoted_implicit s;
24 style = Scalar.style s;
25 })
26
27 | `Alias name ->
28 emit (Event.Alias { anchor = name })
29
30 | `A seq ->
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
37 emit (Event.Sequence_start {
38 anchor = Sequence.anchor seq;
39 tag = Sequence.tag seq;
40 implicit = Sequence.implicit seq;
41 style;
42 });
43 List.iter (emit_yaml_node_impl ~emit) members;
44 emit Event.Sequence_end
45
46 | `O map ->
47 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
53 emit (Event.Mapping_start {
54 anchor = Mapping.anchor map;
55 tag = Mapping.tag map;
56 implicit = Mapping.implicit map;
57 style;
58 });
59 List.iter (fun (k, v) ->
60 emit_yaml_node_impl ~emit k;
61 emit_yaml_node_impl ~emit v
62 ) members;
63 emit Event.Mapping_end
64
65(** Emit a Value node using an emit function.
66 This is the core implementation used by both Emitter.t and function-based APIs. *)
67let rec emit_value_node_impl ~emit ~config (value : Value.t) =
68 match value with
69 | `Null ->
70 emit (Event.Scalar {
71 anchor = None; tag = None;
72 value = "null";
73 plain_implicit = true; quoted_implicit = false;
74 style = `Plain;
75 })
76
77 | `Bool b ->
78 emit (Event.Scalar {
79 anchor = None; tag = None;
80 value = if b then "true" else "false";
81 plain_implicit = true; quoted_implicit = false;
82 style = `Plain;
83 })
84
85 | `Float f ->
86 let value =
87 match Float.classify_float f with
88 | FP_nan -> ".nan"
89 | FP_infinite -> if f > 0.0 then ".inf" else "-.inf"
90 | _ ->
91 if Float.is_integer f && Float.abs f < 1e15 then
92 Printf.sprintf "%.0f" f
93 else
94 Printf.sprintf "%g" f
95 in
96 emit (Event.Scalar {
97 anchor = None; tag = None;
98 value;
99 plain_implicit = true; quoted_implicit = false;
100 style = `Plain;
101 })
102
103 | `String s ->
104 let style = Quoting.choose_style s in
105 emit (Event.Scalar {
106 anchor = None; tag = None;
107 value = s;
108 plain_implicit = style = `Plain;
109 quoted_implicit = style <> `Plain;
110 style;
111 })
112
113 | `A items ->
114 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
119 in
120 emit (Event.Sequence_start {
121 anchor = None; tag = None;
122 implicit = true;
123 style;
124 });
125 List.iter (emit_value_node_impl ~emit ~config) items;
126 emit Event.Sequence_end
127
128 | `O pairs ->
129 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
134 in
135 emit (Event.Mapping_start {
136 anchor = None; tag = None;
137 implicit = true;
138 style;
139 });
140 List.iter (fun (k, v) ->
141 let style = Quoting.choose_style k in
142 emit (Event.Scalar {
143 anchor = None; tag = None;
144 value = k;
145 plain_implicit = style = `Plain;
146 quoted_implicit = style <> `Plain;
147 style;
148 });
149 emit_value_node_impl ~emit ~config v
150 ) pairs;
151 emit Event.Mapping_end
152
153(** Strip anchors from a YAML tree (used when resolving aliases for output) *)
154let rec strip_anchors (yaml : Yaml.t) : Yaml.t =
155 match yaml with
156 | `Scalar s ->
157 if Option.is_none (Scalar.anchor s) then yaml
158 else
159 `Scalar (Scalar.make
160 ?tag:(Scalar.tag s)
161 ~plain_implicit:(Scalar.plain_implicit s)
162 ~quoted_implicit:(Scalar.quoted_implicit s)
163 ~style:(Scalar.style s)
164 (Scalar.value s))
165 | `Alias _ -> yaml
166 | `A seq ->
167 `A (Sequence.make
168 ?tag:(Sequence.tag seq)
169 ~implicit:(Sequence.implicit seq)
170 ~style:(Sequence.style seq)
171 (List.map strip_anchors (Sequence.members seq)))
172 | `O map ->
173 `O (Mapping.make
174 ?tag:(Mapping.tag map)
175 ~implicit:(Mapping.implicit map)
176 ~style:(Mapping.style map)
177 (List.map (fun (k, v) -> (strip_anchors k, strip_anchors v)) (Mapping.members map)))
178
179(** Emit a document using an emit function *)
180let emit_document_impl ?(resolve_aliases = true) ~emit doc =
181 emit (Event.Document_start {
182 version = Document.version doc;
183 implicit = Document.implicit_start doc;
184 });
185 (match Document.root doc with
186 | Some yaml ->
187 let yaml = if resolve_aliases then
188 yaml |> Yaml.resolve_aliases |> strip_anchors
189 else yaml in
190 emit_yaml_node_impl ~emit yaml
191 | None ->
192 emit (Event.Scalar {
193 anchor = None; tag = None;
194 value = "";
195 plain_implicit = true; quoted_implicit = false;
196 style = `Plain;
197 }));
198 emit (Event.Document_end { implicit = Document.implicit_end doc })
199
200(** {1 Emitter.t-based API} *)
201
202(** Emit a YAML node to an emitter *)
203let emit_yaml_node t yaml =
204 emit_yaml_node_impl ~emit:(Emitter.emit t) yaml
205
206(** Emit a complete YAML document to an emitter *)
207let emit_yaml t yaml =
208 let config = Emitter.config t in
209 Emitter.emit t (Event.Stream_start { encoding = config.encoding });
210 Emitter.emit t (Event.Document_start { version = None; implicit = true });
211 emit_yaml_node t yaml;
212 Emitter.emit t (Event.Document_end { implicit = true });
213 Emitter.emit t Event.Stream_end
214
215(** Emit a Value node to an emitter *)
216let emit_value_node t value =
217 let config = Emitter.config t in
218 emit_value_node_impl ~emit:(Emitter.emit t) ~config value
219
220(** Emit a complete Value document to an emitter *)
221let emit_value t value =
222 let config = Emitter.config t in
223 Emitter.emit t (Event.Stream_start { encoding = config.encoding });
224 Emitter.emit t (Event.Document_start { version = None; implicit = true });
225 emit_value_node t value;
226 Emitter.emit t (Event.Document_end { implicit = true });
227 Emitter.emit t Event.Stream_end
228
229(** Emit a document to an emitter *)
230let emit_document ?resolve_aliases t doc =
231 emit_document_impl ?resolve_aliases ~emit:(Emitter.emit t) doc
232
233(** {1 Buffer-based API} *)
234
235(** Serialize a Value to a buffer.
236
237 @param config Emitter configuration (default: {!Emitter.default_config})
238 @param buffer Optional buffer to append to; creates new one if not provided
239 @return The buffer containing serialized YAML *)
240let value_to_buffer ?(config = Emitter.default_config) ?buffer value =
241 let buf = Option.value buffer ~default:(Buffer.create 1024) in
242 let t = Emitter.create ~config () in
243 emit_value t value;
244 Buffer.add_string buf (Emitter.contents t);
245 buf
246
247(** Serialize a Yaml.t to a buffer.
248
249 @param config Emitter configuration (default: {!Emitter.default_config})
250 @param buffer Optional buffer to append to; creates new one if not provided
251 @return The buffer containing serialized YAML *)
252let yaml_to_buffer ?(config = Emitter.default_config) ?buffer yaml =
253 let buf = Option.value buffer ~default:(Buffer.create 1024) in
254 let t = Emitter.create ~config () in
255 emit_yaml t yaml;
256 Buffer.add_string buf (Emitter.contents t);
257 buf
258
259(** Serialize documents to a buffer.
260
261 @param config Emitter configuration (default: {!Emitter.default_config})
262 @param resolve_aliases Whether to resolve aliases before emission (default: true)
263 @param buffer Optional buffer to append to; creates new one if not provided
264 @return The buffer containing serialized YAML *)
265let documents_to_buffer ?(config = Emitter.default_config) ?(resolve_aliases = true) ?buffer documents =
266 let buf = Option.value buffer ~default:(Buffer.create 1024) in
267 let t = Emitter.create ~config () in
268 Emitter.emit t (Event.Stream_start { encoding = config.encoding });
269 List.iter (emit_document ~resolve_aliases t) documents;
270 Emitter.emit t Event.Stream_end;
271 Buffer.add_string buf (Emitter.contents t);
272 buf
273
274(** {1 String-based API} *)
275
276(** Serialize a Value to a string.
277
278 @param config Emitter configuration (default: {!Emitter.default_config}) *)
279let value_to_string ?(config = Emitter.default_config) value =
280 Buffer.contents (value_to_buffer ~config value)
281
282(** Serialize a Yaml.t to a string.
283
284 @param config Emitter configuration (default: {!Emitter.default_config}) *)
285let yaml_to_string ?(config = Emitter.default_config) yaml =
286 Buffer.contents (yaml_to_buffer ~config yaml)
287
288(** Serialize documents to a string.
289
290 @param config Emitter configuration (default: {!Emitter.default_config})
291 @param resolve_aliases Whether to resolve aliases before emission (default: true) *)
292let documents_to_string ?(config = Emitter.default_config) ?(resolve_aliases = true) documents =
293 Buffer.contents (documents_to_buffer ~config ~resolve_aliases documents)
294
295(** {1 Writer-based API}
296
297 These functions write directly to a bytesrw [Bytes.Writer.t],
298 enabling true streaming output without intermediate string allocation.
299 Uses the emitter's native Writer support for efficiency. *)
300
301(** Serialize a Value directly to a Bytes.Writer.
302
303 @param config Emitter configuration (default: {!Emitter.default_config})
304 @param eod Whether to write end-of-data after serialization (default: true) *)
305let value_to_writer ?(config = Emitter.default_config) ?(eod = true) writer value =
306 let t = Emitter.of_writer ~config writer in
307 emit_value t value;
308 if eod then Emitter.flush t
309
310(** Serialize a Yaml.t directly to a Bytes.Writer.
311
312 @param config Emitter configuration (default: {!Emitter.default_config})
313 @param eod Whether to write end-of-data after serialization (default: true) *)
314let yaml_to_writer ?(config = Emitter.default_config) ?(eod = true) writer yaml =
315 let t = Emitter.of_writer ~config writer in
316 emit_yaml t yaml;
317 if eod then Emitter.flush t
318
319(** Serialize documents directly to a Bytes.Writer.
320
321 @param config Emitter configuration (default: {!Emitter.default_config})
322 @param resolve_aliases Whether to resolve aliases before emission (default: true)
323 @param eod Whether to write end-of-data after serialization (default: true) *)
324let documents_to_writer ?(config = Emitter.default_config) ?(resolve_aliases = true) ?(eod = true) writer documents =
325 let t = Emitter.of_writer ~config writer in
326 Emitter.emit t (Event.Stream_start { encoding = config.encoding });
327 List.iter (emit_document ~resolve_aliases t) documents;
328 Emitter.emit t Event.Stream_end;
329 if eod then Emitter.flush t
330
331(** {1 Function-based API}
332
333 These functions accept an emit function [Event.t -> unit] instead of
334 an {!Emitter.t}, allowing them to work with any event sink
335 (e.g., streaming writers, custom processors). *)
336
337(** Emit a YAML node using an emitter function *)
338let emit_yaml_node_fn ~emitter yaml =
339 emit_yaml_node_impl ~emit:emitter yaml
340
341(** Emit a complete YAML stream using an emitter function *)
342let emit_yaml ~emitter ~config yaml =
343 emitter (Event.Stream_start { encoding = config.Emitter.encoding });
344 emitter (Event.Document_start { version = None; implicit = true });
345 emit_yaml_node_fn ~emitter yaml;
346 emitter (Event.Document_end { implicit = true });
347 emitter Event.Stream_end
348
349(** Emit a Value node using an emitter function *)
350let emit_value_node_fn ~emitter ~config value =
351 emit_value_node_impl ~emit:emitter ~config value
352
353(** Emit a complete Value stream using an emitter function *)
354let emit_value ~emitter ~config value =
355 emitter (Event.Stream_start { encoding = config.Emitter.encoding });
356 emitter (Event.Document_start { version = None; implicit = true });
357 emit_value_node_fn ~emitter ~config value;
358 emitter (Event.Document_end { implicit = true });
359 emitter Event.Stream_end
360
361(** Emit a document using an emitter function *)
362let emit_document_fn ?resolve_aliases ~emitter doc =
363 emit_document_impl ?resolve_aliases ~emit:emitter doc
364
365(** Emit multiple documents using an emitter function *)
366let emit_documents ~emitter ~config ?(resolve_aliases = true) documents =
367 emitter (Event.Stream_start { encoding = config.Emitter.encoding });
368 List.iter (emit_document_fn ~resolve_aliases ~emitter) documents;
369 emitter Event.Stream_end