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