81 lines
2.5 KiB
OCaml
81 lines
2.5 KiB
OCaml
open Faraday
|
|
|
|
type json =
|
|
[ `Null
|
|
| `False
|
|
| `True
|
|
| `String of string
|
|
| `Number of float
|
|
| `Object of (string * json) list
|
|
| `Array of json list ]
|
|
|
|
let to_hex_digit i =
|
|
Char.unsafe_chr (if i < 10 then i + 48 else i + 87)
|
|
|
|
let serialize_string t s =
|
|
(* TODO: Implement proper unicode verification. *)
|
|
let flush ~off ~len =
|
|
if len <> 0 then write_string t ~off ~len s in
|
|
let rec go ~off ~len =
|
|
if String.length s = off + len
|
|
then flush ~off ~len
|
|
else
|
|
let i = off + len in
|
|
match String.get s i with
|
|
| c when c <= '\031' -> (* non-visible characters have to be escaped *)
|
|
let i = Char.code c in
|
|
flush ~off ~len;
|
|
write_string t "\\u00";
|
|
write_char t (to_hex_digit (i lsr 4));
|
|
write_char t (to_hex_digit (i land 0xf));
|
|
go ~off:(i+1) ~len:0
|
|
| '"' -> flush ~off ~len; write_string t "\\" ; go ~off:(i+1) ~len:0
|
|
| '/' -> flush ~off ~len; write_string t "\\/" ; go ~off:(i+1) ~len:0
|
|
| '\b' -> flush ~off ~len; write_string t "\\b" ; go ~off:(i+1) ~len:0
|
|
| '\012' -> flush ~off ~len; write_string t "\\f" ; go ~off:(i+1) ~len:0
|
|
| '\n' -> flush ~off ~len; write_string t "\\n" ; go ~off:(i+1) ~len:0
|
|
| '\r' -> flush ~off ~len; write_string t "\\r" ; go ~off:(i+1) ~len:0
|
|
| '\t' -> flush ~off ~len; write_string t "\\t" ; go ~off:(i+1) ~len:0
|
|
| '\\' -> flush ~off ~len; write_string t "\\\\"; go ~off:(i+1) ~len:0
|
|
| _ -> go ~off ~len:(len + 1)
|
|
in
|
|
write_char t '"';
|
|
go ~off:0 ~len:0;
|
|
write_char t '"'
|
|
|
|
let serialize_number t f =
|
|
let f = string_of_float f in
|
|
let len = String.length f in
|
|
let len = if String.get f (len - 1) = '.' then len - 1 else len in
|
|
write_string t ~len f
|
|
|
|
let rec serialize_json t json =
|
|
match json with
|
|
| `Null -> write_string t "null"
|
|
| `True -> write_string t "true"
|
|
| `False -> write_string t "false"
|
|
| `Number n -> serialize_number t n
|
|
| `String s -> serialize_string t s
|
|
| `Object [] -> write_string t "{}"
|
|
| `Object ((k, v)::kvs) ->
|
|
write_char t '{';
|
|
serialize_kv t k v;
|
|
List.iter (fun (k, v) ->
|
|
write_char t ',';
|
|
serialize_kv t k v)
|
|
kvs;
|
|
write_char t '}';
|
|
| `Array [] -> write_string t "[]"
|
|
| `Array (v::vs) ->
|
|
write_char t '[';
|
|
serialize_json t v;
|
|
List.iter (fun v ->
|
|
write_char t ',';
|
|
serialize_json t v)
|
|
vs;
|
|
write_char t ']'
|
|
|
|
and serialize_kv t k v =
|
|
serialize_string t k;
|
|
write_char t ':';
|
|
serialize_json t v
|