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(* Format parser events as tree notation compatible with yaml-test-suite *)
7
8open Yamlrw
9
10let escape_string s =
11 let buf = Buffer.create (String.length s * 2) in
12 String.iter (fun c ->
13 match c with
14 | '\n' -> Buffer.add_string buf "\\n"
15 | '\t' -> Buffer.add_string buf "\\t"
16 | '\r' -> Buffer.add_string buf "\\r"
17 | '\\' -> Buffer.add_string buf "\\\\"
18 | '\x00' -> Buffer.add_string buf "\\0"
19 | '\x07' -> Buffer.add_string buf "\\a"
20 | '\x08' -> Buffer.add_string buf "\\b"
21 | '\x0b' -> Buffer.add_string buf "\\v"
22 | '\x0c' -> Buffer.add_string buf "\\f"
23 | '\x1b' -> Buffer.add_string buf "\\e"
24 | '\xa0' -> Buffer.add_string buf "\\_"
25 | c -> Buffer.add_char buf c
26 ) s;
27 Buffer.contents buf
28
29let style_char = function
30 | `Plain -> ':'
31 | `Single_quoted -> '\''
32 | `Double_quoted -> '"'
33 | `Literal -> '|'
34 | `Folded -> '>'
35 | `Any -> ':'
36
37let format_event { Event.event; span = _span } =
38 match event with
39 | Event.Stream_start _ -> "+STR"
40 | Event.Stream_end -> "-STR"
41 | Event.Document_start { implicit; _ } ->
42 if implicit then "+DOC"
43 else "+DOC ---"
44 | Event.Document_end { implicit } ->
45 if implicit then "-DOC"
46 else "-DOC ..."
47 | Event.Mapping_start { anchor; tag; style; _ } ->
48 let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
49 let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
50 let flow_str = match style with `Flow -> " {}" | _ -> "" in
51 Printf.sprintf "+MAP%s%s%s" flow_str anchor_str tag_str
52 | Event.Mapping_end -> "-MAP"
53 | Event.Sequence_start { anchor; tag; style; _ } ->
54 let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
55 let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
56 let flow_str = match style with `Flow -> " []" | _ -> "" in
57 Printf.sprintf "+SEQ%s%s%s" flow_str anchor_str tag_str
58 | Event.Sequence_end -> "-SEQ"
59 | Event.Scalar { anchor; tag; value; style; _ } ->
60 let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
61 let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
62 let style_c = style_char style in
63 Printf.sprintf "=VAL%s%s %c%s" anchor_str tag_str style_c (escape_string value)
64 | Event.Alias { anchor } ->
65 Printf.sprintf "=ALI *%s" anchor
66
67let of_spanned_events events =
68 let buf = Buffer.create 256 in
69 List.iter (fun (e : Event.spanned) ->
70 let line = format_event e in
71 Buffer.add_string buf line;
72 Buffer.add_char buf '\n'
73 ) events;
74 Buffer.contents buf