jon.recoil.org
this repo has no description
1type json =
2 [ `Null
3 | `Bool of bool
4 | `Float of float
5 | `String of string
6 | `Array of json list
7 | `Object of (string * json) list ]
8
9let rec buffer_add_json b = function
10 | `Null -> Buffer.add_string b "null"
11 | `Bool bool -> Buffer.add_string b (if bool then "true" else "false")
12 | `Float f -> Buffer.add_string b (Printf.sprintf "%.16g" f)
13 | `String s -> buffer_add_json_string b s
14 | `Array els -> (
15 match els with
16 | [] -> Buffer.add_string b "[]"
17 | el :: els ->
18 let add_sep_el b e =
19 Buffer.add_char b ',';
20 buffer_add_json b e
21 in
22 Buffer.add_char b '[';
23 buffer_add_json b el;
24 List.iter (add_sep_el b) els;
25 Buffer.add_char b ']')
26 | `Object mems -> (
27 match mems with
28 | [] -> Buffer.add_string b "{}"
29 | mem :: mems ->
30 let add_mem b (k, v) =
31 buffer_add_json_string b k;
32 Buffer.add_char b ':';
33 buffer_add_json b v
34 in
35 let add_sep_mem b mem =
36 Buffer.add_char b ',';
37 add_mem b mem
38 in
39 Buffer.add_char b '{';
40 add_mem b mem;
41 List.iter (add_sep_mem b) mems;
42 Buffer.add_char b '}')
43
44and buffer_add_json_string b s =
45 let is_control = function '\x00' .. '\x1F' | '\x7F' -> true | _ -> false in
46 let len = String.length s in
47 let max_idx = len - 1 in
48 let flush b start i =
49 if start < len then Buffer.add_substring b s start (i - start)
50 in
51 let rec loop start i =
52 match i > max_idx with
53 | true -> flush b start i
54 | false -> (
55 let next = i + 1 in
56 match String.get s i with
57 | '"' ->
58 flush b start i;
59 Buffer.add_string b "\\\"";
60 loop next next
61 | '\\' ->
62 flush b start i;
63 Buffer.add_string b "\\\\";
64 loop next next
65 | c when is_control c ->
66 flush b start i;
67 Buffer.add_string b (Printf.sprintf "\\u%04X" (Char.code c));
68 loop next next
69 | _c -> loop start next)
70 in
71 Buffer.add_char b '"';
72 loop 0 0;
73 Buffer.add_char b '"'
74
75let to_string json =
76 let b = Buffer.create 1024 in
77 buffer_add_json b json;
78 Buffer.contents b