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(* Parse JSON using jsonm and compare parsed structures *)
7
8type json =
9 | Null
10 | Bool of bool
11 | Float of float
12 | String of string
13 | Array of json list
14 | Object of (string * json) list
15
16let rec equal a b =
17 match (a, b) with
18 | Null, Null -> true
19 | Bool a, Bool b -> a = b
20 | Float a, Float b -> Float.equal a b
21 | String a, String b -> String.equal a b
22 | Array a, Array b -> List.equal equal a b
23 | Object a, Object b ->
24 (* Compare objects as sets of key-value pairs (order independent) *)
25 let sorted_a =
26 List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) a
27 in
28 let sorted_b =
29 List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) b
30 in
31 List.length sorted_a = List.length sorted_b
32 && List.for_all2
33 (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2)
34 sorted_a sorted_b
35 | _ -> false
36
37(* Parse JSON string using jsonm *)
38let parse_json s =
39 let decoder = Jsonm.decoder (`String s) in
40 let rec parse_value () =
41 match Jsonm.decode decoder with
42 | `Lexeme `Null -> Ok Null
43 | `Lexeme (`Bool b) -> Ok (Bool b)
44 | `Lexeme (`Float f) -> Ok (Float f)
45 | `Lexeme (`String s) -> Ok (String s)
46 | `Lexeme `As -> parse_array []
47 | `Lexeme `Os -> parse_object []
48 | `Lexeme _ -> Error "unexpected lexeme"
49 | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)
50 | `End -> Error "unexpected end"
51 | `Await -> Error "unexpected await"
52 and parse_array acc =
53 match Jsonm.decode decoder with
54 | `Lexeme `Ae -> Ok (Array (List.rev acc))
55 | `Lexeme _ as lex -> (
56 (* Push back and parse value *)
57 let result = parse_value_with_lex lex in
58 match result with Ok v -> parse_array (v :: acc) | Error _ as e -> e)
59 | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)
60 | `End -> Error "unexpected end in array"
61 | `Await -> Error "unexpected await"
62 and parse_object acc =
63 match Jsonm.decode decoder with
64 | `Lexeme `Oe -> Ok (Object (List.rev acc))
65 | `Lexeme (`Name key) -> (
66 match parse_value () with
67 | Ok v -> parse_object ((key, v) :: acc)
68 | Error _ as e -> e)
69 | `Lexeme _ -> Error "expected object key"
70 | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)
71 | `End -> Error "unexpected end in object"
72 | `Await -> Error "unexpected await"
73 and parse_value_with_lex lex =
74 match lex with
75 | `Lexeme `Null -> Ok Null
76 | `Lexeme (`Bool b) -> Ok (Bool b)
77 | `Lexeme (`Float f) -> Ok (Float f)
78 | `Lexeme (`String s) -> Ok (String s)
79 | `Lexeme `As -> parse_array []
80 | `Lexeme `Os -> parse_object []
81 | `Lexeme _ -> Error "unexpected lexeme"
82 | `Error e -> Error (Format.asprintf "%a" Jsonm.pp_error e)
83 | `End -> Error "unexpected end"
84 | `Await -> Error "unexpected await"
85 in
86 parse_value ()
87
88(* Parse multiple JSON values (for multi-document YAML) *)
89let parse_json_multi s =
90 let decoder = Jsonm.decoder (`String s) in
91 let rec parse_value () =
92 match Jsonm.decode decoder with
93 | `Lexeme `Null -> Some Null
94 | `Lexeme (`Bool b) -> Some (Bool b)
95 | `Lexeme (`Float f) -> Some (Float f)
96 | `Lexeme (`String s) -> Some (String s)
97 | `Lexeme `As -> parse_array []
98 | `Lexeme `Os -> parse_object []
99 | `Lexeme _ -> None
100 | `Error _ -> None
101 | `End -> None
102 | `Await -> None
103 and parse_array acc =
104 match Jsonm.decode decoder with
105 | `Lexeme `Ae -> Some (Array (List.rev acc))
106 | `Lexeme _ as lex -> (
107 match parse_value_with_lex lex with
108 | Some v -> parse_array (v :: acc)
109 | None -> None)
110 | _ -> None
111 and parse_object acc =
112 match Jsonm.decode decoder with
113 | `Lexeme `Oe -> Some (Object (List.rev acc))
114 | `Lexeme (`Name key) -> (
115 match parse_value () with
116 | Some v -> parse_object ((key, v) :: acc)
117 | None -> None)
118 | _ -> None
119 and parse_value_with_lex lex =
120 match lex with
121 | `Lexeme `Null -> Some Null
122 | `Lexeme (`Bool b) -> Some (Bool b)
123 | `Lexeme (`Float f) -> Some (Float f)
124 | `Lexeme (`String s) -> Some (String s)
125 | `Lexeme `As -> parse_array []
126 | `Lexeme `Os -> parse_object []
127 | _ -> None
128 in
129 let rec collect acc =
130 match parse_value () with
131 | Some v -> collect (v :: acc)
132 | None -> List.rev acc
133 in
134 collect []
135
136(* Compare two JSON strings *)
137let compare_json_strings expected actual =
138 (* Handle empty strings *)
139 let expected_trimmed = String.trim expected in
140 let actual_trimmed = String.trim actual in
141 if expected_trimmed = "" && actual_trimmed = "" then true
142 else if expected_trimmed = "" || actual_trimmed = "" then false
143 else
144 (* Parse as potentially multiple JSON values *)
145 let expected_values = parse_json_multi expected in
146 let actual_values = parse_json_multi actual in
147 List.length expected_values = List.length actual_values
148 && List.for_all2 equal expected_values actual_values