updated parenscript client gen; added body variables to endpoints

6 files changed, 76 insertions, 21 deletions

diff --git a/README.org b/README.org
index ebab6d8..28f5282 100644
--- a/README.org
+++ b/README.org
@@ -7,11 +7,13 @@ Features include:
 - Different server backends. (At the moment only Hunchentoot is supported)
 - Modular and "installable" applications.
 - Handy macros for provisioning apps and defining endpoints.
-- In particular, endpoint routes may contain variables and include
-  parsers for variables and for query parameters
-- customizable errors.
+- In particular, strings representing endpoint paths may contain
+  variables and include parsers and validators for variables
+- Query parameters may also be parsed and validated with a simple syntax
+- Customizable errors.
 - Livecoding supported for your endpoint handlers and application configurations.
 - Automatic documentation generation for ~lazybones:app~ instances.
+- Automatic generation of API client code for Lisp and Javascript
 
 Although lazybones can be used to develop and serve page-oriented web
 sites, it has been written to help me develop "self documenting" HTTP
diff --git a/lazybones.asd b/lazybones.asd
index cb74b04..a4283ee 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -12,7 +12,9 @@
                #:trivial-documentation
                #:str
                #:cl-ppcre
+               #:parenscript
                #:jonathan
+               #:derrida
                #:lisp-namespace)
   :components ((:file "package")
                (:file "macros")
diff --git a/src/client/parenscript.lisp b/src/client/parenscript.lisp
index bb9cc3a..2b393bc 100644
--- a/src/client/parenscript.lisp
+++ b/src/client/parenscript.lisp
@@ -40,19 +40,23 @@ is the value of the endpoint's DISPATCH-PATTERN slot."
              (remove-if-not (a:conjoin #'stringp (complement #'a:emptyp))
                             pattern))))))
 
-(defun client-function-lambda-list (variables body?)
+(defun client-function-lambda-list (variables &optional body-vars)
   #+testiere
   (:tests
    (equalp
-    (client-function-lambda-list '("*SESSION*") nil)
+    (client-function-lambda-list '("*SESSION*"))
     '(*session*))
 
    (equalp
-    (butlast (client-function-lambda-list '("a.x" "b/y" "c") t))
-    '(a-x b-y c &optional)))
+    (client-function-lambda-list '("a.x" "b/y" "c") '(q r))
+    '(a-x b-y c &key q r))
+
+   (equalp
+    (client-function-lambda-list '("pl" "foo") '(title url))
+    '(pl foo &key title url)))
 
   (nconc (mapcar (a:compose #'intern #'string-upcase #'lispify) variables)
-         (when body? (list '&optional (gensym "BODY")))))
+         (when body-vars (cons '&key body-vars))))
 
 (defun client-function-endpoint-path (prefix pattern)
   #+testiere
@@ -92,27 +96,45 @@ is the value of the endpoint's DISPATCH-PATTERN slot."
          (function-name
            (client-function-name method pattern))
 
-         (body?
-            (method-accepts-body? method))
+         (body-vars
+           (lzb:endpoint-body-variables ep))
 
          (lambda-list
-           (client-function-lambda-list variables body?))
+           (client-function-lambda-list variables body-vars))
+
+         (body-serializtion-code
+           (when body-vars
+             (cond ((equal "application/json" content-type)
+                    `(ps:chain
+                      -j-s-o-n
+                      (stringify (ps:create
+                                  ,@(loop :for var :in body-vars
+                                          :collect var
+                                          :collect var)))))
+
+                   ((equal "multipart/form-data" content-type)
+                    (let ((fd (gensym "FORMDATA")))
+                      `((lambda ()
+                          (let ((,fd (new -form-data)))
+                            ,@(loop :for v :in body-vars
+                                    :for s := (string-downcase (symbol-name v))
+                                    :collect `(ps:chain ,fd (append ,s ,v)))
+                            ,fd)))))
+
+                   (t (error "Cannot automatically encode bodies for ~s"
+                             content-type)))))
 
-         (body
-           (when body?
-             (first (last lambda-list))))
-         
          (fetch-path
            (client-function-endpoint-path (lzb::app-prefix app) pattern)))
     
     `(defun ,function-name ,lambda-list
-       ,(if body
+       ,(if body-vars
             `(fetch ,fetch-path
                     (ps:create
                      method ,method-name
                      headers  (ps:create "Content-Type" ,content-type)
                      redirect "follow"
-                     body ,body))
+                     body ,body-serializtion-code))
             `(fetch ,fetch-path)))))
 
 (defun generate (app)
diff --git a/src/lazybones.lisp b/src/lazybones.lisp
index ca168a5..d993f1d 100644
--- a/src/lazybones.lisp
+++ b/src/lazybones.lisp
@@ -191,6 +191,15 @@ app, named with the package name.  If no app can be found, return NIL"
    (dispatch-pattern
     :reader endpoint-dispatch-pattern
     :initarg :pattern)
+
+   (body-variables
+    :reader endpoint-body-variables
+    :initarg :body-variables
+    :initform nil
+    :documentation "A list of fields that should appear in the body of a
+     request that has a body. Completely optional, but used to build 
+     client functions.")
+
    (handler-function
     :reader endpoint-request-handler
     :initarg :function)
@@ -390,6 +399,7 @@ any way to do it, hence NIL is returned."
      query-params
      (&key
         (auth nil)
+        (body-vars nil)
         content-type)
      &body body)
   "Defines and installs an ENDPOINT instance to the APP instance
@@ -410,13 +420,19 @@ making a new one if not."
            (body-without-docstring
              (if (stringp (first body)) (rest body) body))
            (real-body
-             (if query-params
-                 `((lazybones:map-parameters ,query-params ,@body-without-docstring))
+             (if body-vars
+                 `((let-body ,body-vars ,@body-without-docstring))
                  body-without-docstring)))
+
+      (when query-params
+        (setf real-body
+              `((map-parameters ,query-params ,@real-body))))
+
       `(let* ((,the-app
                 (or (app ',appname) (make-instance 'lazybones:app :name ',appname)))
               (,auth-method
                 ,auth))
+
          (defun ,endpoint-name ,lambda-list
            (declare (ignorable ,@lambda-list))
            (setf (lazybones:response-header :content-type)
@@ -425,8 +441,7 @@ making a new one if not."
 
          (register-endpoint
           ,the-app
-          (make-instance
-           'lazybones:endpoint
+          (make-instance 'lazybones:endpoint
            :method ,method 
            :route ,route
            :params ',query-params
@@ -434,6 +449,7 @@ making a new one if not."
            :pattern ',dispatch-pattern
            :doc ,documentation
            :auth ,auth-method
+           :body-variables ',body-vars
            :function ',endpoint-name))))))
 
 (defmacro defendpoint* (method route params options &rest body)
diff --git a/src/macros.lisp b/src/macros.lisp
index 0d941b6..fe2c6cc 100644
--- a/src/macros.lisp
+++ b/src/macros.lisp
@@ -47,3 +47,15 @@ first mapped with the PARSER function."
                    collect `(,name (when ,name (funcall ',(second (assoc name params)) ,name))))
          ,@body))))
 
+(defmacro let-body ((&rest var-names) &body body)
+  (let ((key (gensym "key"))
+        (val (gensym "val"))
+        (var (gensym "var")))
+   `(derrida:with-plist
+        ,var-names 
+        (loop :for (,key ,val) :on (request-body) :by #'cddr
+              :for ,var := (find ,key ',var-names :test #'string-equal)
+              :when ,var :collect ,var :and :collect ,val)
+      ,@body)))
+
+
diff --git a/src/package.lisp b/src/package.lisp
index 984288a..3ef4dcc 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -63,6 +63,7 @@
    #:endpoint-content-type
    #:endpoint-dispatch-pattern
    #:endpoint-route-variables
+   #:endpoint-body-variables
    #:app-endpoints
    #:let-parameters
    #:map-parameters