diff options
| -rw-r--r-- | src/client/dexador/generate.lisp | 63 | ||||
| -rw-r--r-- | src/client/ps/generate.lisp | 7 | ||||
| -rw-r--r-- | weekend.asd | 10 |
3 files changed, 77 insertions, 3 deletions
diff --git a/src/client/dexador/generate.lisp b/src/client/dexador/generate.lisp new file mode 100644 index 0000000..dd4652c --- /dev/null +++ b/src/client/dexador/generate.lisp @@ -0,0 +1,63 @@ +(defpackage #:weekend.client.dexador + (:use #:cl) + (:import-from #:flatbind #:do>) + (:local-nicknames + (#:wknd #:weekend) + (#:a #:alexandria-2)) + (:export #:generate)) + +(in-package #:weekend.client.dexador) + +(defun generate-client-for (class) + (when (symbolp class) (setf class (find-class class))) + + (let* + ((args + (mapcar (a:compose #'intern #'string) + (wknd:class-initargs class))) + + (parts + (loop + :for part :in (wknd:route-builder-parts class) + :when (or (stringp part) (characterp part)) + :collect part + :else + :collect (intern (string part)))) + (method + (wknd:request-method class)) + + (dexador-fn + (ecase method + (:get 'dexador:get) + (:post 'dexador:post) + (:put 'dexador:put) + (:delete 'dexador:delete) + (:patch 'dexador:patch) + (:head 'dexador:head))) + + (reqbody + (when (wknd:body-expected-p method) + `(mapcar #'cons + ',(mapcar #'string (wknd:class-initargs class)) + (list ,@args)))) + + (host + (loop :with var := "HOST" + :while (find var args :test #'string-equal) + :do (setf var (concatenate 'string var "%")) + :finally (return (intern var)))) + (dexador-kwargs + (loop :with var := "DEXADOR-KWARGS" + :while (find var args :test #'string-equal) + :do (setf var (concatenate 'string var "%")) + :finally (return (intern var))))) + + `(defun ,(class-name class) (,host ,@args &rest ,dexador-kwargs) + (apply #',dexador-fn + (concatenate 'string ,host ,@parts) + ,@(when reqbody + (list :content reqbody)) + ,dexador-kwargs)))) + +(defun generate (class) + (eval (generate-client-for class))) diff --git a/src/client/ps/generate.lisp b/src/client/ps/generate.lisp index 11b0c53..f6f317b 100644 --- a/src/client/ps/generate.lisp +++ b/src/client/ps/generate.lisp @@ -4,13 +4,13 @@ (:local-nicknames (#:wknd #:weekend) (#:a #:alexandria-2)) - (:export #:parenscript)) + (:export #:generate)) (in-package #:weekend.client.ps) ;; this function largely mirrors the implementation of construct-route-builder -(defun generate-endpoint-client (class) +(defun generate (class) (when (symbolp class) (setf class (find-class class))) (let* @@ -26,6 +26,7 @@ :collect (intern (string part)))) (method (wknd:request-method class)) + (body (when (wknd:body-expected-p method) `(ps:chain -J-S-O-N @@ -51,6 +52,6 @@ method ,(string method) cache "no-cache" headers (ps:create "Content-Type" "application/json") - redirect follow + redirect "follow" ,@(when body (list 'body body))))))) diff --git a/weekend.asd b/weekend.asd index 9fa9120..5c204ab 100644 --- a/weekend.asd +++ b/weekend.asd @@ -21,3 +21,13 @@ :depends-on (#:weekend #:parenscript) :pathname "src/client/ps/" :components ((:file "generate"))) + +(asdf:defsystem #:weekend/dexador + :description "Generate lisp functions making requests to weekend endpoint classes." + :author "colin <colin@cicadas.surf>" + :license "AGPLv3.0" + :version "0.0.1" + :depends-on (#:weekend #:dexador) + :pathname "src/client/dexador/" + :components ((:file "generate"))) + |