hop-2012/server/sexpjson.ml

32 lines
1.5 KiB
OCaml

open Sexp
let rec sexp_of_json j =
match j with
| Json.Num f -> Hint {hint = Bytes.of_string "num"; body = Bytes.of_string (Json.to_string j)}
| Json.Str s -> str s
| Json.Arr js -> Arr (List.map sexp_of_json js)
| Json.Rec kvs -> Arr ((Hint {hint = Bytes.of_string "obj"; body = Bytes.empty}) ::
(List.map (fun (k, v) -> Arr [str k; sexp_of_json v]) kvs))
| Json.Flg f -> Hint {hint = (Bytes.of_string "bool"); body = (Bytes.of_string (string_of_bool f))}
| Json.Nil -> Hint {hint = (Bytes.of_string "null"); body = Bytes.empty}
let json_of_sexp x =
let rec walk x =
match x with
| Hint {hint = hint; body = n} when hint = Bytes.of_string "num" ->
Json.Num (float_of_string (Bytes.to_string n))
| Str s -> Json.Str (Bytes.to_string s)
| Arr ((Hint {hint = hint; body = bs}) :: kvs) when hint = Bytes.of_string "obj" && bs = Bytes.empty ->
Json.Rec (List.map
(fun kv ->
(match kv with
| Arr [Str k; v] -> (Bytes.to_string k, walk v)
| _ -> raise (Syntax_error "Bad JSON-SEXP key-value")))
kvs)
| Arr xs -> Json.Arr (List.map walk xs)
| Hint {hint = hint; body = bs} when hint = Bytes.of_string "bool" -> Json.Flg (bool_of_string (Bytes.to_string bs))
| Hint {hint = hint; body = bs} when hint = Bytes.of_string "null" && bs = Bytes.empty -> Json.Nil
| Hint {hint = h; body = b} -> Json.Rec ["_hint", Json.Str (Bytes.to_string h); "_body", Json.Str (Bytes.to_string b)]
in
Lwt.wrap1 walk x