Pure OCaml Yaml 1.2 reader and writer using Bytesrw
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(* Format Value.t as JSON matching yaml-test-suite expected format *)
7
8open Yamlrw
9
10let escape_string s =
11 let buf = Buffer.create (String.length s * 2) in
12 Buffer.add_char buf '"';
13 String.iter
14 (fun c ->
15 match c with
16 | '"' -> Buffer.add_string buf "\\\""
17 | '\\' -> Buffer.add_string buf "\\\\"
18 | '\n' -> Buffer.add_string buf "\\n"
19 | '\r' -> Buffer.add_string buf "\\r"
20 | '\t' -> Buffer.add_string buf "\\t"
21 | '\x08' -> Buffer.add_string buf "\\b"
22 | '\x0c' -> Buffer.add_string buf "\\f"
23 | c when Char.code c < 32 ->
24 Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))
25 | c -> Buffer.add_char buf c)
26 s;
27 Buffer.add_char buf '"';
28 Buffer.contents buf
29
30let rec format_value ?(indent = 0) (v : Value.t) =
31 let spaces n = String.make n ' ' in
32 match v with
33 | `Null -> "null"
34 | `Bool true -> "true"
35 | `Bool false -> "false"
36 | `Float f ->
37 if Float.is_nan f then "null" (* JSON doesn't support NaN *)
38 else if f = Float.infinity || f = Float.neg_infinity then "null"
39 (* JSON doesn't support Inf *)
40 else if Float.is_integer f && Float.abs f < 1e15 then
41 Printf.sprintf "%.0f" f
42 else
43 (* Try to match yaml-test-suite's number formatting *)
44 let s = Printf.sprintf "%g" f in
45 (* Ensure we have a decimal point for floats *)
46 if
47 String.contains s '.' || String.contains s 'e'
48 || String.contains s 'E'
49 then s
50 else s ^ ".0"
51 | `String s -> escape_string s
52 | `A [] -> "[]"
53 | `A items ->
54 let inner_indent = indent + 2 in
55 let formatted_items =
56 List.map
57 (fun item ->
58 spaces inner_indent ^ format_value ~indent:inner_indent item)
59 items
60 in
61 "[\n" ^ String.concat ",\n" formatted_items ^ "\n" ^ spaces indent ^ "]"
62 | `O [] -> "{}"
63 | `O pairs ->
64 let inner_indent = indent + 2 in
65 let formatted_pairs =
66 List.map
67 (fun (k, v) ->
68 let key = escape_string k in
69 let value = format_value ~indent:inner_indent v in
70 spaces inner_indent ^ key ^ ": " ^ value)
71 pairs
72 in
73 "{\n" ^ String.concat ",\n" formatted_pairs ^ "\n" ^ spaces indent ^ "}"
74
75let to_json (v : Value.t) : string = format_value v
76
77(* Format multiple documents (for multi-doc YAML) *)
78let documents_to_json (docs : Value.t list) : string =
79 String.concat "\n" (List.map to_json docs)