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(** YAML mapping (object) values with metadata *)
7
8type ('k, 'v) t = {
9 anchor : string option;
10 tag : string option;
11 implicit : bool;
12 style : Layout_style.t;
13 members : ('k * 'v) list;
14}
15
16let make
17 ?(anchor : string option)
18 ?(tag : string option)
19 ?(implicit = true)
20 ?(style = `Any)
21 members =
22 { anchor; tag; implicit; style; members }
23
24let members t = t.members
25let anchor t = t.anchor
26let tag t = t.tag
27let implicit t = t.implicit
28let style t = t.style
29
30let with_anchor anchor t = { t with anchor = Some anchor }
31let with_tag tag t = { t with tag = Some tag }
32let with_style style t = { t with style }
33
34let map_keys f t = { t with members = List.map (fun (k, v) -> (f k, v)) t.members }
35let map_values f t = { t with members = List.map (fun (k, v) -> (k, f v)) t.members }
36let map f t = { t with members = List.map (fun (k, v) -> f k v) t.members }
37
38let length t = List.length t.members
39
40let is_empty t = t.members = []
41
42let find pred t =
43 List.find_opt (fun (k, _) -> pred k) t.members |> Option.map snd
44
45let find_key pred t =
46 List.find_opt (fun (k, _) -> pred k) t.members
47
48let mem pred t =
49 List.exists (fun (k, _) -> pred k) t.members
50
51let keys t = List.map fst t.members
52
53let values t = List.map snd t.members
54
55let iter f t = List.iter (fun (k, v) -> f k v) t.members
56
57let fold f init t = List.fold_left (fun acc (k, v) -> f acc k v) init t.members
58
59let pp pp_key pp_val fmt t =
60 Format.fprintf fmt "@[<hv 2>mapping(@,";
61 (match t.anchor with
62 | Some a -> Format.fprintf fmt "anchor=%s,@ " a
63 | None -> ());
64 (match t.tag with
65 | Some tag -> Format.fprintf fmt "tag=%s,@ " tag
66 | None -> ());
67 Format.fprintf fmt "style=%a,@ " Layout_style.pp t.style;
68 Format.fprintf fmt "members={@,";
69 List.iteri (fun i (k, v) ->
70 if i > 0 then Format.fprintf fmt ",@ ";
71 Format.fprintf fmt "@[<hv 2>%a:@ %a@]" pp_key k pp_val v
72 ) t.members;
73 Format.fprintf fmt "@]@,})"
74
75let equal eq_k eq_v a b =
76 Option.equal String.equal a.anchor b.anchor &&
77 Option.equal String.equal a.tag b.tag &&
78 a.implicit = b.implicit &&
79 Layout_style.equal a.style b.style &&
80 List.equal (fun (k1, v1) (k2, v2) -> eq_k k1 k2 && eq_v v1 v2) a.members b.members
81
82let compare cmp_k cmp_v a b =
83 let c = Option.compare String.compare a.anchor b.anchor in
84 if c <> 0 then c else
85 let c = Option.compare String.compare a.tag b.tag in
86 if c <> 0 then c else
87 let c = Bool.compare a.implicit b.implicit in
88 if c <> 0 then c else
89 let c = Layout_style.compare a.style b.style in
90 if c <> 0 then c else
91 let cmp_pair (k1, v1) (k2, v2) =
92 let c = cmp_k k1 k2 in
93 if c <> 0 then c else cmp_v v1 v2
94 in
95 List.compare cmp_pair a.members b.members