updated parenscript client gen; added body variables to endpoints

1 files changed, 36 insertions, 14 deletions

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)