/src/couchdb/client.clj

(ns couchdb.client
  (:require [clojure.contrib [error-kit :as kit]])
  (:use [clojure.contrib.java-utils :only [as-str]]
        [clojure.contrib.json.read :only [read-json *json-keyword-keys*]]
        [clojure.contrib.json.write :only [json-str]]
        [clojure.http.client :only [request url-encode]]))

(def *server* "http://localhost:5984/")


(kit/deferror InvalidDatabaseName [] [database]
  {:msg (str "Invalid Database Name: " database)
   :unhandled (kit/throw-msg Exception)})

(kit/deferror DatabaseNotFound [] [e]
  {:msg (str "Database Not Found: " e)
   :unhandled (kit/throw-msg java.io.FileNotFoundException)})

(kit/deferror DocumentNotFound [] [e]
  {:msg (str "Document Not Found: " e)
   :unhandled (kit/throw-msg java.io.FileNotFoundException)})

(kit/deferror AttachmentNotFound [] [e]
  {:msg (str "Attachment Not Found: " e)
   :unhandled (kit/throw-msg java.io.FileNotFoundException)})

(kit/deferror ResourceConflict [] [e]
  "Raised when a 409 code is returned from the server."
  {:msg (str "Resource Conflict: " e)
   :unhandled (kit/throw-msg Exception)})

(kit/deferror PreconditionFailed [] [e]
  "Raised when a 412 code is returned from the server."
  {:msg (str "Precondition Failed: " e)
   :unhandled (kit/throw-msg Exception)})

(kit/deferror ServerError [] [e]
  "Raised when any unexpected code >= 400 is returned from the server."
  {:msg (str "Unhandled Server Error: " e)
   :unhandled (kit/throw-msg Exception)})


(defn couch-request
  [& args]
  (let [response (apply request args)
        result (try (assoc response :json (binding [*json-keyword-keys* true]
                                            (read-json (apply str
                                                              (:body-seq response)))))
                    (catch Exception e ;; if there's an error reading the JSON, just don't make a :json key
                      response))]
    (if (>= (:code result) 400)
      (kit/raise* ((condp = (:code result)
                     404 (condp = (:reason (:json result))
                           "Missing" DatabaseNotFound ;; as of svn rev 775577 this should be "no_db_file"
                           "Document is missing attachment" AttachmentNotFound
                           DocumentNotFound)
                     409 ResourceConflict
                     412 PreconditionFailed
                     ServerError)
                   {:e (:json result)}))
      result)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;         Utilities           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn valid-dbname?
  [database]
  (boolean (re-find #"^[a-z][a-z0-9_$()+-/]*$" database)))

(defn validate-dbname
  [database]
  (if (valid-dbname? database)
    (url-encode database)
    (kit/raise InvalidDatabaseName database)))

(defn stringify-top-level-keys
  [[k v]]
  (if (keyword? k)
    [(if-let [n (namespace k)]
       (str n (name k))
       (name k))
     v]
    [k v]))


(defn- vals-lift [f m]
  (reduce (fn [acc [k v]] (assoc acc k (f v))) {} (seq m)))

(def #^{:private true} vals2json (partial vals-lift json-str))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;          Databases          ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn database-list
  []
  (:json (couch-request (str *server* "_all_dbs"))))

(defn database-create
  [database]
  (when-let [database (validate-dbname database)]
    (couch-request (str *server* database) :put)
    database))

(defn database-delete
  [database]
  (when-let [database (validate-dbname database)]
    (couch-request (str *server* database) :delete)
    true))

(defn database-info
  [database]
  (when-let [database (validate-dbname database)]
    (:json (couch-request (str *server* database)))))

(defn database-compact
  [database]
  (when-let [database (validate-dbname database)]
    (couch-request (str *server* database "/_compact") :post)
    true))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;         Documents           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare document-get)

(defn- do-get-doc
  [database document]
  (if (map? document)
    (if-let [id (:_id document)]
      id
      (kit/raise ResourceConflict "missing :_id key"))
    document))

(defn- do-get-rev
  [database document]
  (if (map? document)
    (if-let [rev (:_rev document)]
      rev
      (kit/raise ResourceConflict "missing :_rev key"))
    (:_rev (document-get database document))))

(defn- do-document-touch
  [database payload id method]
  (when-let [database (validate-dbname database)]
    (let [response (:json (couch-request (str *server* database (when id
                                                                  (str "/" (url-encode (as-str id)))))
                                         method
                                         {"Content-Type" "application/json"}
                                         {}
                                         (json-str payload)))]
      (merge payload
             {:_id (:id response)
              :_rev (:rev response)}))))

(defn document-list
  ([database]
     (when-let [database (validate-dbname database)]
       (map :id (:rows (:json (couch-request (str *server* database "/_all_docs")))))))
  ([database options]
     (when-let [database (validate-dbname database)] 
       (map (if (:include_docs options) :doc :id)
            (:rows (:json (couch-request
                           (str *server* database "/_all_docs?"
                                (url-encode options)))))))))
       

(defn document-create
  ([database payload]
     (do-document-touch database payload nil :post))
  ([database id payload]
     (do-document-touch database payload id :put)))

(defn document-update
  [database id payload]
  ;(assert (:_rev payload)) ;; payload needs to have a revision or you'll get a PreconditionFailed error
  (let [id (do-get-doc database id)]
    (do-document-touch database payload id :put)))

(defn document-get
  ([database id]
     (when-let [database (validate-dbname database)]
       (let [id (do-get-doc database id)]
         (:json (couch-request (str *server* database "/" (url-encode (as-str id))))))))
  ([database id rev]
     (when-let [database (validate-dbname database)]
       (let [id (do-get-doc database id)]
         (:json (couch-request (str *server* database "/" (url-encode (as-str id)) "?rev=" rev)))))))

(defn document-delete
  [database id]
  (if-not (empty? id)
    (when-let [database (validate-dbname database)]
      (let [id (do-get-doc database id)
            rev (do-get-rev database id)]
        (couch-request (str *server* database "/" (url-encode (as-str id)) "?rev=" rev)
                       :delete)
        true))
    false))


(defn document-bulk-update
  "Does a bulk-update to couchdb, accoding to: http://wiki.apache.org/couchdb/HTTP_Bulk_Document_API"
  [database document-coll & [request-options]]
  (when-let [database (validate-dbname database)]
    (let [response (:json
                    (couch-request
                     (str *server* database "/_bulk_docs"
                          (url-encode (vals2json request-options)))
                     :post
                     {"Content-Type" "application/json"}
                     {}
                     (json-str {:docs document-coll})))]
      ;; I don't know if this is correct... I assume that the server sends the
      ;; ids and revs in the same order as ib my request back.
      (map (fn [respdoc, orgdoc]
             (merge orgdoc
                    {:_id (:id respdoc)
                     :_rev (:rev respdoc)}))
           response document-coll))))

(defn- revision-comparator
  [x y]
  (> (Integer/decode (apply str (take-while #(not= % \-) x)))
     (Integer/decode (apply str (take-while #(not= % \-) y)))))

(defn document-revisions
  [database id]
  (when-let [database (validate-dbname database)]
    (let [id (do-get-doc database id)]
      (apply merge (map (fn [m]
                          (sorted-map-by revision-comparator (:rev m) (:status m)))
                        (:_revs_info (:json (couch-request (str *server* database "/" (url-encode (as-str id)) "?revs_info=true")))))))))

;; Views

(defn view-get [db design-doc view-name & [view-options]]
  (:json (couch-request 
   (str *server* db "/_design/" design-doc "/_view/" view-name "?"
	(url-encode (vals2json view-options))))))

(defn view-temp-get [db view-map & [view-options]]
  (:json (couch-request 
          (str *server* db "/_temp_view?"
               (url-encode (vals2json view-options)))
          :post
          {"Content-Type" "application/json"}
          {}
          (json-str view-map))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;        Attachments          ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn attachment-list
  [database document]
  (let [document (do-get-doc database document)]
    (into {} (map stringify-top-level-keys
                  (:_attachments (document-get database document))))))


(defn attachment-create
  [database document id payload content-type]
  (when-let [database (validate-dbname database)]
    (let [document (do-get-doc database document)
          rev (do-get-rev database document)]
      (couch-request (str *server* database "/" (url-encode (as-str document)) "/" (url-encode (as-str id)) "?rev=" rev)
                     :put
                     {"Content-Type" content-type}
                     {}
                     payload))
    id))

(defn attachment-get
  [database document id]
  (when-let [database (validate-dbname database)]
    (let [document (do-get-doc database document)
          response (couch-request (str *server* database "/" (url-encode (as-str document)) "/" (url-encode (as-str id))))]
      {:body-seq (:body-seq response)
       :content-type ((:get-header response) "content-type")})))

(defn attachment-delete
  [database document id]
  (when-let [database (validate-dbname database)]
    (let [document (do-get-doc database document)
          rev (do-get-rev database document)]
      (couch-request (str *server* database "/" (url-encode (as-str document)) "/" (url-encode (as-str id)) "?rev=" rev)
                     :delete)
      true)))

;; Shows

(defn show-get
  "Returns the contents of a show as a list of strings according to http://wiki.apache.org/couchdb/Formatting_with_Show_and_List"
  [database design-doc show-name id & [show-options]]
  (:body-seq
   (couch-request 
    (str *server* database "/_design/" design-doc "/_show/" show-name "/" id
         "?" (url-encode (vals2json show-options))))))