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(** JSON-compatible YAML value representation *)
7
8type t =
9 [ `Null
10 | `Bool of bool
11 | `Float of float
12 | `String of string
13 | `A of t list
14 | `O of (string * t) list ]
15
16(* Type equality is ensured by structural compatibility with Yamlrw.value *)
17
18(** Constructors *)
19
20let null : t = `Null
21let bool b : t = `Bool b
22let int n : t = `Float (Float.of_int n)
23let float f : t = `Float f
24let string s : t = `String s
25let list f xs : t = `A (List.map f xs)
26let obj pairs : t = `O pairs
27
28(** Type name for error messages *)
29let type_name : t -> string = function
30 | `Null -> "null"
31 | `Bool _ -> "bool"
32 | `Float _ -> "float"
33 | `String _ -> "string"
34 | `A _ -> "array"
35 | `O _ -> "object"
36
37(** Safe accessors (return option) *)
38
39let as_null = function `Null -> Some () | _ -> None
40let as_bool = function `Bool b -> Some b | _ -> None
41let as_float = function `Float f -> Some f | _ -> None
42let as_string = function `String s -> Some s | _ -> None
43let as_list = function `A l -> Some l | _ -> None
44let as_assoc = function `O o -> Some o | _ -> None
45
46let as_int = function
47 | `Float f ->
48 let i = Float.to_int f in
49 if Float.equal (Float.of_int i) f then Some i else None
50 | _ -> None
51
52(** Unsafe accessors (raise on type mismatch) *)
53
54let unwrap_or_type_error expected_type extractor v =
55 match extractor v with
56 | Some x -> x
57 | None -> Error.raise (Type_mismatch (expected_type, type_name v))
58
59let to_null v = unwrap_or_type_error "null" as_null v
60let to_bool v = unwrap_or_type_error "bool" as_bool v
61let to_float v = unwrap_or_type_error "float" as_float v
62let to_string v = unwrap_or_type_error "string" as_string v
63let to_list v = unwrap_or_type_error "array" as_list v
64let to_assoc v = unwrap_or_type_error "object" as_assoc v
65let to_int v = unwrap_or_type_error "int" as_int v
66
67(** Object access *)
68
69let mem key = function
70 | `O pairs -> List.exists (fun (k, _) -> k = key) pairs
71 | _ -> false
72
73let find key = function `O pairs -> List.assoc_opt key pairs | _ -> None
74
75let get key v =
76 match find key v with Some v -> v | None -> Error.raise (Key_not_found key)
77
78let keys = function
79 | `O pairs -> List.map fst pairs
80 | v -> Error.raise (Type_mismatch ("object", type_name v))
81
82let values = function
83 | `O pairs -> List.map snd pairs
84 | v -> Error.raise (Type_mismatch ("object", type_name v))
85
86(** Combinators *)
87
88let combine v1 v2 =
89 match (v1, v2) with
90 | `O o1, `O o2 -> `O (o1 @ o2)
91 | v1, _ -> Error.raise (Type_mismatch ("object", type_name v1))
92
93let map f = function
94 | `A l -> `A (List.map f l)
95 | v -> Error.raise (Type_mismatch ("array", type_name v))
96
97let filter pred = function
98 | `A l -> `A (List.filter pred l)
99 | v -> Error.raise (Type_mismatch ("array", type_name v))
100
101(** Pretty printing *)
102
103let rec pp fmt (v : t) =
104 match v with
105 | `Null -> Format.pp_print_string fmt "null"
106 | `Bool b -> Format.pp_print_bool fmt b
107 | `Float f ->
108 if Float.is_integer f && Float.abs f < 1e15 then
109 Format.fprintf fmt "%.0f" f
110 else Format.fprintf fmt "%g" f
111 | `String s -> Format.fprintf fmt "%S" s
112 | `A [] -> Format.pp_print_string fmt "[]"
113 | `A items ->
114 Format.fprintf fmt "@[<hv 2>[@,%a@]@,]"
115 (Format.pp_print_list
116 ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
117 pp)
118 items
119 | `O [] -> Format.pp_print_string fmt "{}"
120 | `O pairs ->
121 Format.fprintf fmt "@[<hv 2>{@,%a@]@,}"
122 (Format.pp_print_list
123 ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
124 (fun fmt (k, v) -> Format.fprintf fmt "@[<hv 2>%S:@ %a@]" k pp v))
125 pairs
126
127(** Equality and comparison *)
128
129let rec equal (a : t) (b : t) =
130 match (a, b) with
131 | `Null, `Null -> true
132 | `Bool a, `Bool b -> a = b
133 | `Float a, `Float b -> Float.equal a b
134 | `String a, `String b -> String.equal a b
135 | `A a, `A b -> List.equal equal a b
136 | `O a, `O b ->
137 List.length a = List.length b
138 && List.for_all2 (fun (k1, v1) (k2, v2) -> k1 = k2 && equal v1 v2) a b
139 | _ -> false
140
141let rec compare (a : t) (b : t) =
142 match (a, b) with
143 | `Null, `Null -> 0
144 | `Null, _ -> -1
145 | _, `Null -> 1
146 | `Bool a, `Bool b -> Bool.compare a b
147 | `Bool _, _ -> -1
148 | _, `Bool _ -> 1
149 | `Float a, `Float b -> Float.compare a b
150 | `Float _, _ -> -1
151 | _, `Float _ -> 1
152 | `String a, `String b -> String.compare a b
153 | `String _, _ -> -1
154 | _, `String _ -> 1
155 | `A a, `A b -> List.compare compare a b
156 | `A _, _ -> -1
157 | _, `A _ -> 1
158 | `O a, `O b ->
159 let cmp_pair (k1, v1) (k2, v2) =
160 let c = String.compare k1 k2 in
161 if c <> 0 then c else compare v1 v2
162 in
163 List.compare cmp_pair a b