Less repetitive interface for HANDLE-REQUEST.

Author: Josh Marchán

src/db.lisp

@@ -177,23 +177,23 @@ with a particular CouchDB database.")
   (:reply ((db =database=) uri &rest all-keys)
     (apply #'couch-request (server db) (strcat (name db) "/" uri) all-keys)))
 
-(defmacro handle-request ((result-var request) &body expected-responses)
+(defmacro handle-request ((result-var db uri &rest db-request-keys) &body expected-responses)
   "Provides a nice interface to the relatively manual, low-level status-code checking that
 Chillax uses to understand CouchDB's responses. The format for EXPECTED-RESPONSES is the same as
 the CASE macro: The keys should be either keywords, or lists of keywords (not evaluated), which
 correspond to translated HTTP status code names. See *status-codes* for all the currently-recognized
 keywords."
   (let ((status-code (gensym "STATUS-CODE-")))
     `(multiple-value-bind (,result-var ,status-code)
-         ,request
+         (db-request ,db ,uri ,@db-request-keys)
        (case ,status-code
          ,@expected-responses
          (otherwise (error 'unexpected-response :status-code ,status-code :response ,result-var))))))
 
 (defmessage db-info (db)
   (:documentation "Fetches info about a given database from the CouchDB server.")
   (:reply ((db =database=))
-    (handle-request (response (db-request db ""))
+    (handle-request (response db "")
       (:ok response)
       (:internal-server-error (error "Illegal database name: ~A" (name db)))
       (:not-found (error 'db-not-found :uri (db-namestring db))))))
@@ -208,7 +208,7 @@ that can be used to perform operations on it."
 (defun create-db (name &key (prototype =database=) (server =json-server=))
   "Creates a new CouchDB database. Returns a database object that can be used to operate on it."
   (let ((db (create prototype 'server server 'name name)))
-    (handle-request (response (db-request db "" :method :put))
+    (handle-request (response db "" :method :put)
       (:created db)
       (:internal-server-error (error "Illegal database name: ~A" name))
       (:precondition-failed (error 'db-already-exists :uri (db-namestring db))))))
@@ -222,20 +222,20 @@ that can be used to perform operations on it."
 (defmessage delete-db (db &key)
   (:documentation "Deletes a CouchDB database.")
   (:reply ((db =database=) &key)
-    (handle-request (response (db-request db "" :method :delete))
+    (handle-request (response db "" :method :delete)
       (:ok response)
       (:not-found (error 'db-not-found :uri (db-namestring db))))))
 
 (defmessage compact-db (db)
   (:documentation "Triggers a database compaction.")
   (:reply ((db =database=))
-    (handle-request (response (db-request db "_compact" :method :post))
+    (handle-request (response db "_compact" :method :post)
       (:accepted response))))
 
 (defmessage changes (db)
   (:documentation "Returns the changes feed for DB")
   (:reply ((db =database=))
-    (handle-request (response (db-request db "_changes"))
+    (handle-request (response db "_changes")
       (:ok response))))
 
 ;;;
@@ -244,7 +244,7 @@ that can be used to perform operations on it."
 (defmessage get-document (db id)
   (:documentation "Returns an CouchDB document from DB as an alist.")
   (:reply ((db =database=) id)
-    (handle-request (response (db-request db id))
+    (handle-request (response db id)
       (:ok response)
       (:not-found (error 'document-not-found :db db :id id)))))
 
@@ -255,22 +255,22 @@ that can be used to perform operations on it."
     (when endkey (push `("endkey" . ,(prin1-to-string endkey)) params))
     (when limit (push `("limit" . ,(prin1-to-string limit)) params))
     (when include-docs (push `("include_docs" . "true") params))
-    (handle-request (response (db-request db "_all_docs" :parameters params))
+    (handle-request (response db "_all_docs" :parameters params)
       (:ok response))))
 
 (defmessage batch-get-documents (db &rest doc-ids)
   (:documentation "Uses _all_docs to quickly fetch the given DOC-IDs in a single request.")
   (:reply ((db =database=) &rest doc-ids)
-    (handle-request (response (db-request db "_all_docs" :method :post
-                                          :parameters '(("include_docs" . "true"))
-                                          :content (format nil "{\"foo\":[~{~S~^,~}]}" doc-ids)))
+    (handle-request (response db "_all_docs" :method :post
+                              :parameters '(("include_docs" . "true"))
+                              :content (format nil "{\"foo\":[~{~S~^,~}]}" doc-ids))
       (:ok response))))
 
 (defmessage put-document (db id doc &key)
   (:documentation "Puts a document into DB, using ID.")
   (:reply ((db =database=) id doc &key batch-ok-p)
-    (handle-request (response (db-request db id :method :put :content doc
-                                          :parameters (when batch-ok-p '(("batch" . "ok")))))
+    (handle-request (response db id :method :put :content doc
+                              :parameters (when batch-ok-p '(("batch" . "ok"))))
       ((:created :accepted) response)
       (:conflict (error 'document-conflict :id id :doc doc)))))
 
@@ -280,20 +280,20 @@ document does not already exist. Note that using this function is discouraged in
 documentation, since it may result in duplicate documents because of proxies and other network
 intermediaries.")
   (:reply ((db =database=) doc)
-    (handle-request (response (db-request db "" :method :post :content doc))
+    (handle-request (response db "" :method :post :content doc)
       ((:created :accepted) response)
       (:conflict (error 'document-conflict :doc doc)))))
 
 (defmessage delete-document (db id revision)
   (:documentation "Deletes an existing document.")
   (:reply ((db =database=) id revision)
-    (handle-request (response (db-request db (format nil "~A?rev=~A" id revision) :method :delete))
+    (handle-request (response db (format nil "~A?rev=~A" id revision) :method :delete)
       (:ok response))))
 
 (defmessage copy-document (db from-id to-id &key)
   (:documentation "Copies a document's content in-database.")
   (:reply ((db =database=) from-id to-id &key revision)
-    (handle-request (response (db-request db from-id :method :copy
-                                          :additional-headers `(("Destination" . ,to-id))
-                                          :parameters `(,(when revision `("rev" . ,revision)))))
+    (handle-request (response db from-id :method :copy
+                              :additional-headers `(("Destination" . ,to-id))
+                              :parameters `(,(when revision `("rev" . ,revision))))
       (:created response))))