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