1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
open Json
let rec pp ppf = function
| String value -> Format.fprintf ppf "\"%s\"" value
| Bool true -> Format.fprintf ppf "true"
| Bool false -> Format.fprintf ppf "false"
| Number value -> Format.fprintf ppf "%f" value
| Null -> Format.fprintf ppf "null"
| Array x -> Format.fprintf ppf "[@[<hov 1>%a@]]" ppa x
| Record x -> Format.fprintf ppf "{@[<hov 1>%a@]}" ppr x
and ppa ppf = function
| x :: (_ :: _ as xs) ->
let () = Format.fprintf ppf "%a,@ " pp x in
ppa ppf xs
| x :: xs ->
let () = Format.fprintf ppf "%a" pp x in
ppa ppf xs
| [] -> ()
and ppr ppf = function
| (key, x) :: (_ :: _ as xs) ->
let () = Format.fprintf ppf "\"%s\": %a,@ " key pp x in
ppr ppf xs
| (key, x) :: xs ->
let () = Format.fprintf ppf "\"%s\": %a" key pp x in
ppr ppf xs
| [] -> ()
let eq_list f a b =
let rec aux = function
| [], [] -> true
| x :: xs, y :: ys -> f x y && aux (xs, ys)
| _ -> false
in
aux (a, b)
let eq_record f a b =
let rec aux = function
| [], [] -> true
| (sx, x) :: xs, (sy, y) :: ys -> sx = sy && f x y && aux (xs, ys)
| _ -> false
in
aux (a, b)
let eq f a b =
let aux = function
| Null, Null -> true
| Bool b1, Bool b2 -> b1 = b2
| Number b1, Number b2 -> b1 = b2
| String b1, String b2 -> b1 = b2
| Array b1, Array b2 -> eq_list f b1 b2
| Record b1, Record b2 -> eq_record f b1 b2
| _ -> false
in
aux (a, b)
let to_string = Format.asprintf "%a" pp