crdt library in ocaml implementing json-joy
gdiazlo.tngl.sh
1(** Value types including JSON and CBOR extensions.
2
3 This module defines the internal value type supporting JSON values plus CBOR
4 extensions (bytes, undefined). *)
5
6(** The value type supporting JSON + CBOR extensions *)
7type t =
8 | Null
9 | Undefined (** CBOR extension - not in standard JSON *)
10 | Bool of bool
11 | Int of int (** 53-bit safe integer *)
12 | Float of float
13 | String of string
14 | Bytes of bytes (** CBOR extension - not in standard JSON *)
15 | Array of t list
16 | Object of (string * t) list
17 | Timestamp_ref of int * int (** Reference to another node as (sid, time) *)
18
19(** [equal a b] returns true if values are structurally equal *)
20let rec equal a b =
21 match (a, b) with
22 | Null, Null -> true
23 | Undefined, Undefined -> true
24 | Bool x, Bool y -> x = y
25 | Int x, Int y -> x = y
26 | Float x, Float y -> x = y
27 | String x, String y -> String.equal x y
28 | Bytes x, Bytes y -> Bytes.equal x y
29 | Array xs, Array ys ->
30 List.length xs = List.length ys && List.for_all2 equal xs ys
31 | Object xs, Object ys ->
32 (* Objects are equal if they have the same keys with equal values,
33 regardless of key ordering *)
34 List.length xs = List.length ys
35 && List.for_all
36 (fun (k1, v1) ->
37 match List.assoc_opt k1 ys with
38 | Some v2 -> equal v1 v2
39 | None -> false)
40 xs
41 | Timestamp_ref (s1, t1), Timestamp_ref (s2, t2) -> s1 = s2 && t1 = t2
42 | _ -> false
43
44(** [compare a b] provides total ordering for values *)
45let rec compare a b =
46 match (a, b) with
47 | Null, Null -> 0
48 | Null, _ -> -1
49 | _, Null -> 1
50 | Undefined, Undefined -> 0
51 | Undefined, _ -> -1
52 | _, Undefined -> 1
53 | Bool x, Bool y -> Bool.compare x y
54 | Bool _, _ -> -1
55 | _, Bool _ -> 1
56 | Int x, Int y -> Int.compare x y
57 | Int _, _ -> -1
58 | _, Int _ -> 1
59 | Float x, Float y -> Float.compare x y
60 | Float _, _ -> -1
61 | _, Float _ -> 1
62 | String x, String y -> String.compare x y
63 | String _, _ -> -1
64 | _, String _ -> 1
65 | Bytes x, Bytes y -> Bytes.compare x y
66 | Bytes _, _ -> -1
67 | _, Bytes _ -> 1
68 | Array xs, Array ys -> List.compare compare xs ys
69 | Array _, _ -> -1
70 | _, Array _ -> 1
71 | Object xs, Object ys ->
72 List.compare
73 (fun (k1, v1) (k2, v2) ->
74 let c = String.compare k1 k2 in
75 if c <> 0 then c else compare v1 v2)
76 xs ys
77 | Object _, _ -> -1
78 | _, Object _ -> 1
79 | Timestamp_ref (s1, t1), Timestamp_ref (s2, t2) ->
80 let c = Int.compare s1 s2 in
81 if c <> 0 then c else Int.compare t1 t2
82
83(** [null] is the JSON null value *)
84let null = Null
85
86(** [undefined] is the CBOR undefined value *)
87let undefined = Undefined
88
89(** [bool b] creates a boolean value *)
90let bool b = Bool b
91
92(** [int i] creates an integer value *)
93let int i = Int i
94
95(** [float f] creates a float value *)
96let float f = Float f
97
98(** [string s] creates a string value *)
99let string s = String s
100
101(** [bytes b] creates a bytes value (CBOR extension) *)
102let bytes b = Bytes b
103
104(** [array vs] creates an array value *)
105let array vs = Array vs
106
107(** [obj pairs] creates an object value *)
108let obj pairs = Object pairs
109
110(** [timestamp_ref sid time] creates a timestamp reference *)
111let timestamp_ref sid time = Timestamp_ref (sid, time)
112
113(** [is_null v] returns true if the value is null *)
114let is_null = function Null -> true | _ -> false
115
116(** [is_undefined v] returns true if the value is undefined *)
117let is_undefined = function Undefined -> true | _ -> false
118
119(** [is_bool v] returns true if the value is a boolean *)
120let is_bool = function Bool _ -> true | _ -> false
121
122(** [is_int v] returns true if the value is an integer *)
123let is_int = function Int _ -> true | _ -> false
124
125(** [is_float v] returns true if the value is a float *)
126let is_float = function Float _ -> true | _ -> false
127
128(** [is_string v] returns true if the value is a string *)
129let is_string = function String _ -> true | _ -> false
130
131(** [is_bytes v] returns true if the value is bytes *)
132let is_bytes = function Bytes _ -> true | _ -> false
133
134(** [is_array v] returns true if the value is an array *)
135let is_array = function Array _ -> true | _ -> false
136
137(** [is_object v] returns true if the value is an object *)
138let is_object = function Object _ -> true | _ -> false
139
140(** [is_timestamp_ref v] returns true if the value is a timestamp reference *)
141let is_timestamp_ref = function Timestamp_ref _ -> true | _ -> false
142
143(** [to_bool v] extracts a boolean, or None if not a boolean *)
144let to_bool = function Bool b -> Some b | _ -> None
145
146(** [to_int v] extracts an integer, or None if not an integer *)
147let to_int = function Int i -> Some i | _ -> None
148
149(** [to_float v] extracts a float, or None if not a float *)
150let to_float = function Float f -> Some f | _ -> None
151
152(** [to_string_opt v] extracts a string, or None if not a string *)
153let to_string_opt = function String s -> Some s | _ -> None
154
155(** [to_bytes v] extracts bytes, or None if not bytes *)
156let to_bytes = function Bytes b -> Some b | _ -> None
157
158(** [to_array v] extracts an array, or None if not an array *)
159let to_array = function Array a -> Some a | _ -> None
160
161(** [to_object v] extracts an object, or None if not an object *)
162let to_object = function Object o -> Some o | _ -> None
163
164(** [to_timestamp_ref v] extracts a timestamp reference, or None *)
165let to_timestamp_ref = function
166 | Timestamp_ref (sid, time) -> Some (sid, time)
167 | _ -> None
168
169(** [pp fmt v] pretty-prints a value *)
170let rec pp fmt v =
171 let open Format in
172 match v with
173 | Null -> pp_print_string fmt "null"
174 | Undefined -> pp_print_string fmt "undefined"
175 | Bool b -> pp_print_bool fmt b
176 | Int i -> pp_print_int fmt i
177 | Float f -> pp_print_float fmt f
178 | String s -> fprintf fmt "%S" s
179 | Bytes b -> fprintf fmt "<bytes:%d>" (Bytes.length b)
180 | Array vs ->
181 fprintf fmt "[@[<hv>";
182 List.iteri
183 (fun i v ->
184 if i > 0 then fprintf fmt ",@ ";
185 pp fmt v)
186 vs;
187 fprintf fmt "@]]"
188 | Object pairs ->
189 fprintf fmt "{@[<hv>";
190 List.iteri
191 (fun i (k, v) ->
192 if i > 0 then fprintf fmt ",@ ";
193 fprintf fmt "%S:@ %a" k pp v)
194 pairs;
195 fprintf fmt "@]}"
196 | Timestamp_ref (sid, time) -> fprintf fmt "@[<ts:%d,%d>@]" sid time
197
198(** [to_string v] converts a value to a string representation *)
199let to_string v = Format.asprintf "%a" pp v
200
201(** [type_name v] returns the type name of the value *)
202let type_name = function
203 | Null -> "null"
204 | Undefined -> "undefined"
205 | Bool _ -> "bool"
206 | Int _ -> "int"
207 | Float _ -> "float"
208 | String _ -> "string"
209 | Bytes _ -> "bytes"
210 | Array _ -> "array"
211 | Object _ -> "object"
212 | Timestamp_ref _ -> "timestamp_ref"