hop-2012/server/sexpjson.ml

open Sexp

let rec sexp_of_json j =
  match j with
  | Json.Num f -> Hint {hint = "num"; body = 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 = "obj"; body = ""}) ::
			    (List.map (fun (k, v) -> Arr [Str k; sexp_of_json v]) kvs))
  | Json.Flg f -> Hint {hint = "bool"; body = string_of_bool f}
  | Json.Nil -> Hint {hint = "null"; body = ""}

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