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