aboutsummaryrefslogtreecommitdiff
path: root/src/client/parenscript.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/parenscript.lisp')
-rw-r--r--src/client/parenscript.lisp50
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)