(* not safe, since Http module is not cooperative *)
open Json_io
open Json_type

open Common

module Http = Http.Monadic

open Lwt

let create_view = create_view

let version server =
  Http.get server >>= (fun ans ->
                         return (Parser.version ans))

let create server name =
  Http.put (server^"/"^name) "" >>= (fun ans ->
                                       return (Parser.ok ans))

let delete server name =
  Http.delete (server^"/"^name) >>= (fun ans ->
                                       return (Parser.ok ans))

let insert server db entry =
  let entry = string_of_json entry in
  let url = server ^ "/" ^ db ^ "/" in
    Http.post url entry >>= (fun ans ->
                               return (Parser.id_rev ans))

let get server db ~id =
  let url = server ^ "/" ^ db ^ "/" ^ id ^ "/"in
    Http.get url >>= (fun ans ->
                        return (json_of_string ans))

let design server db ?(language="javascript") ~name ~views =
  let url = server ^ "/" ^ db ^ "/_design/" ^ name in
  let design = json_of_design {language = language; views = views} in
  let design = string_of_json design in
    Http.put url design >>= (fun ans ->
                               return (Parser.id_rev ans))

let view server db ~design ~view =
  get server db ("/_design/" ^ design ^ "/_view/" ^ view) >>= (fun ans ->
                                                                 return (Parser.view ans))

let values val_of_json rows =
  Lwt_util.map (fun x -> return (Parser.value val_of_json x)) rows