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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
type t =
[ `Null | `Bool of bool | `Float of float| `String of string
| `A of t list | `O of (string * t) list ]
type 'a encoder = 'a -> t
type 'a decoder = t -> 'a option
let of_string ?encoding str =
let dec d = match Jsonm.decode d with
| `Lexeme l -> l
| `Error _ -> raise Exit
| `End | `Await -> assert false
in
let rec value v k d = match v with
| `Os -> obj [] k d | `As -> arr [] k d
| `Null | `Bool _ | `String _ | `Float _ as v -> k v d
| _ -> assert false
and arr vs k d = match dec d with
| `Ae -> k (`A (List.rev vs)) d
| v -> value v (fun v -> arr (v :: vs) k) d
and obj ms k d = match dec d with
| `Oe -> k (`O (List.rev ms)) d
| `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d
| _ -> assert false
in
let d = Jsonm.decoder ?encoding (`String str) in
try Some (value (dec d) (fun v _ -> v) d)
with Exit -> None
let to_buffer ~minify buff json =
let enc e l = ignore (Jsonm.encode e (`Lexeme l)) in
let rec value v k e = match v with
| `A vs -> arr vs k e
| `O ms -> obj ms k e
| `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e
and arr vs k e = enc e `As; arr_vs vs k e
and arr_vs vs k e = match vs with
| v :: vs' -> value v (arr_vs vs' k) e
| [] -> enc e `Ae; k e
and obj ms k e = enc e `Os; obj_ms ms k e
and obj_ms ms k e = match ms with
| (n, v) :: ms -> enc e (`Name n); value v (obj_ms ms k) e
| [] -> enc e `Oe; k e
in
let e = Jsonm.encoder ~minify (`Buffer buff) in
let finish e = ignore (Jsonm.encode e `End) in
value json finish e
let to_string ?(minify=false) j =
let b = Buffer.create 1024 in
to_buffer ~minify b j;
Buffer.contents b
let json_buffer =
ref []
let append key json =
json_buffer := (key,json) :: !json_buffer
let flush oc =
let b = Buffer.create 1024 in
let json = (`O (List.rev !json_buffer)) in
let json = to_buffer ~minify:true b json; Buffer.contents b in
output_string oc json; flush oc