/src/core/design-document.lisp

  1(in-package :chillax.core)
  2
  3;;;
  4;;; Design Doc errors
  5;;;
  6(define-condition view-not-found (couchdb-error)
  7  ((view       :initarg :view :reader view-404-view)
  8   (design-doc :initarg :ddoc :reader view-404-design-document)
  9   (db         :initarg :db   :reader view-404-db))
 10  (:report (lambda (e s)
 11             (format s "No view \"_design/~A/_view/~A\" was found in ~A"
 12                     (view-404-design-document e)
 13                     (view-404-view e)
 14                     (view-404-db e)))))
 15
 16;;;
 17;;; Design Doc basics
 18;;;
 19(defun view-cleanup (db)
 20  "Invokes _view_cleanup on DB. Old view output will remain on disk until this is invoked."
 21  (handle-request (response db "_view_cleanup" :method :post)
 22    (:accepted response)))
 23
 24(defun compact-design-doc (db design-doc-name)
 25  "Compaction can really help when you have very large views, very little space, or both."
 26  (handle-request (response db (strcat "_compact/" design-doc-name) :method :post)
 27    (:accepted response)
 28    (:not-found (error 'document-not-found :db db :id (strcat "_design/" design-doc-name)))))
 29
 30(defun design-doc-info (db design-doc-name)
 31  "Returns an object with various bits of status information. Refer to CouchDB documentation for
 32specifics on each value."
 33  (let ((ddoc (strcat "_design/" design-doc-name)))
 34    (handle-request (response db (strcat ddoc "/_info"))
 35      (:ok response)
 36      (:not-found (error 'document-not-found :db db :id ddoc)))))
 37
 38(defun build-view-params (database &key
 39                          (key nil key-given)
 40                          (startkey nil startkey-given)
 41                          (endkey nil endkey-given)
 42                          startkey-docid endkey-docid limit skip
 43                          (descendingp nil descendingpp)
 44                          (groupp nil grouppp) group-level
 45                          (reducep t reducepp) stalep
 46                          (include-docs-p nil include-docs-p-p)
 47                          (inclusive-end-p t inclusive-end-p-p)
 48                          &allow-other-keys)
 49  (let ((params ()))
 50    (labels ((%param (key value)
 51               (push (cons key (princ-to-string value)) params))
 52             (maybe-param (test name value)
 53               (when test (%param name value)))
 54             (param (name value)
 55               (maybe-param value name value))
 56             (encode (value)
 57               (data->json (database-server database) value)))
 58      (maybe-param key-given "key" (encode key))
 59      (maybe-param startkey-given "startkey" (encode startkey))
 60      (maybe-param endkey-given "endkey" (encode endkey))
 61      (maybe-param inclusive-end-p-p "inclusive_end" (if inclusive-end-p "true" "false"))
 62      (param "startkey_docid" startkey-docid)
 63      (param "endkey_docid" endkey-docid)
 64      (param "limit" limit)
 65      (maybe-param stalep "stale" "ok")
 66      (maybe-param descendingpp "descending" (if descendingp "true" "false"))
 67      (param "skip" skip)
 68      (maybe-param grouppp "group" (if groupp "true" "false"))
 69      (param "group_level" group-level)
 70      (maybe-param reducepp "reduce" (if reducep "true" "false"))
 71      (maybe-param include-docs-p-p "include_docs" (if include-docs-p "true" "false")))
 72    params))
 73
 74(defun query-view (db design-doc-name view-name &rest all-keys
 75                   &key key startkey startkey-docid endkey
 76                   multi-keys endkey-docid limit skip
 77                   descendingp groupp group-level
 78                   reducep stalep include-docs-p
 79                   inclusive-end-p)
 80  "Queries view named by VIEW-NAME in DESIGN-DOC-NAME. Keyword arguments correspond to CouchDB view
 81query arguments.
 82
 83  * key - Single key to search for.
 84  * multi-keys - Multiple keys to search for.
 85  * startkey - When searching for a range of keys, the key to start from.
 86  * endkey - When searching for a range of keys, the key to end at. Whether this is inclusive or not
 87    depends on inclusive-end-p (default: true)
 88  * inclusive-end-p - If TRUE, endkey is included in the result. (default: true)
 89  * startkey-docid - Like startkey, but keyed on the result documents' doc-ids.
 90  * endkey-docid - Like endkey, but keyed on the result documents' doc-ids.
 91  * limit - Maximum number of results to return.
 92  * stalep - If TRUE, CouchDB will not refresh the view, even if it is stalled. (default: false)
 93  * descendingp - If TRUE, will return reversed results. (default: false)
 94  * skip - Number of documents to skip while querying.
 95  * groupp - Controls whether the reduce function reduces to a set of distinct keys, or to a single
 96    result row.
 97  * group-level - It's complicated. Google it!
 98  * reducep - If FALSE, return the view without applying its reduce function (if any). (default: true)
 99  * include-docs-p - If TRUE, includes the entire document with the result of the query. (default: false)"
100  (declare (ignore key startkey startkey-docid endkey endkey-docid limit skip descendingp
101                   groupp group-level reducep stalep include-docs-p inclusive-end-p))
102  (let ((params (apply #'build-view-params db all-keys))
103        (doc-name (strcat "_design/" design-doc-name "/_view/" view-name)))
104    (if multi-keys
105        (let* ((server (database-server db))
106               (content (with-output-to-string (s)
107                          (write-string "{\"keys\":[" s)
108                          (mapl (lambda (kl)
109                                  (write-string (data->json server (car kl)) s)
110                                  (unless (null (cdr kl))
111                                    (write-string "," s)))
112                                multi-keys)
113                          (write-string "]}" s))))
114          ;; If we receive the MULTI-KEYS argument, we have to do a POST instead.
115          (handle-request (response db doc-name :method :post
116                                    :parameters params
117                                    :content content
118                                    :convert-data-p nil)
119            (:ok response)
120            (:not-found (error 'view-not-found :db db :view view-name :ddoc design-doc-name))))
121        (handle-request (response db doc-name :parameters params)
122          (:ok response)
123          (:not-found (error 'view-not-found :db db :view view-name :ddoc design-doc-name))))))
124
125;;;
126;;; Views
127;;;
128(defun query-temporary-view (db &rest all-keys &key (language "javascript") reduce
129                             (map (error "Must provide a map function for temporary views."))
130                             key startkey startkey-docid endkey
131                             endkey-docid limit skip
132                             descendingp groupp group-level
133                             reducep stalep include-docs-p
134                             inclusive-end-p)
135  "Queries a temporary view. These views are meant to be for testing and development purposes, and
136should _not_ be used in actual code."
137  ;; I'm not sure CouchDB actually accepts all the view parameters for temporary views...
138  (declare (ignore key startkey startkey-docid endkey endkey-docid limit skip descendingp
139                   groupp group-level reducep stalep include-docs-p inclusive-end-p))
140  (let ((json (with-output-to-string (s)
141                (format s "{")
142                (format s "\"language\":~S" language)
143                (format s ",\"map\":~S" map)
144                (when reduce
145                  (format s ",\"reduce\":~S" reduce))
146                (format s "}")))
147        (params (apply #'build-view-params db all-keys)))
148    (handle-request (response db "_temp_view" :method :post
149                              :parameters params
150                              :content json
151                              :convert-data-p nil)
152      (:ok response))))