diff options
Diffstat (limited to 'src/client')
| -rw-r--r-- | src/client/parenscript.lisp | 50 |
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) |