diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/client/parenscript.lisp | 50 | ||||
| -rw-r--r-- | src/lazybones.lisp | 24 | ||||
| -rw-r--r-- | src/macros.lisp | 12 | ||||
| -rw-r--r-- | src/package.lisp | 1 |
4 files changed, 69 insertions, 18 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) 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 |