[clouchdb-cvs] CVS clouchdb/src

peddy peddy at common-lisp.net
Sun Jun 15 20:34:57 UTC 2008


Update of /project/clouchdb/cvsroot/clouchdb/src
In directory clnet:/tmp/cvs-serv12271/src

Modified Files:
	clouchdb.lisp 
Log Message:
Add ps-view validation functions


--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2008/06/15 18:00:39	1.25
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2008/06/15 20:34:57	1.26
@@ -146,11 +146,12 @@
 		     (id condition))))
   (:documentation "Error raised when no document matching ID is found"))
 
-;; (define-condition ps-view-def-error (error)
-;;   ((ps-view-def :initarg :ps-view-def :reader ps-view-def))
-;;   (:report (lambda (condition stream)
-;;              (format stream "Invalid parenscript ps-view-def: \"~s\"" ps-view-def)))
-;;   (:documentation "Error raised for invalid ps-view definition"))
+(define-condition ps-view-def-error (error)
+  ((ps-view-def :initarg :ps-view-def :reader ps-view-def))
+  (:report (lambda (condition stream)
+             (format stream "Invalid ps-view definition: ~s"
+                     (ps-view-def condition))))
+  (:documentation "Error raised for invalid ps-view definition"))
 
 ;;
 ;; Unexported utility functions
@@ -737,7 +738,24 @@
   "Create one or more views in the specified view document ID."
   (create-view id (string-join view-defs)))
 
+(defun validate-ps-view (defun fn-name fn-param fn-body)
+  "Validation for ps-view definition"
+  (declare (ignore fn-body))
+  (cond ((not (eq 'defun defun))
+         (error 'ps-view-def-error :ps-view-def 
+                "View definition should take the form (defun <function> (params) (....)"))
+        ((not (or (eq fn-name 'map) (eq fn-name 'reduce)))
+         (error 'ps-view-def-error :ps-view-def
+                "Valid function names are 'map' or 'reduce'"))
+        ((and (eq fn-name 'map) (not (eq 1 (length fn-param))))
+         (error 'ps-view-def-error :ps-view-def
+                "map takes one parameter, e.g.: (defun map (doc) (... (emit ...))"))
+        ((and (eq fn-name 'reduce) (not (eq 2 (length fn-param))))
+         (error 'ps-view-def-error :ps-view-def
+                "reduce takes two parameters, e.g.: (defun reduce (keys values) (...))"))))
+
 (defmacro ps-view ((&optional view-name) &body body)
+  "Create a view using parenscript"
   `(with-output-to-string (out)
      (when ,view-name
        (write-string (cat "\"" ,view-name "\":") out))
@@ -747,7 +765,7 @@
        (list 
          ,@(mapcar #'(lambda (fn)
                        (destructuring-bind (defun fn-name fn-param fn-body) fn
-                         (declare (ignore defun))
+                         (validate-ps-view defun fn-name fn-param fn-body)
                          `(cat "\"" 
                                (string-downcase (symbol-name (quote ,fn-name)))
                                "\": \""




More information about the clouchdb-cvs mailing list