diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/client/dexador.lisp | 2 | ||||
| -rw-r--r-- | src/client/parenscript.lisp | 138 | ||||
| -rw-r--r-- | src/lazybones.lisp | 3 | ||||
| -rw-r--r-- | src/package.lisp | 8 |
4 files changed, 148 insertions, 3 deletions
diff --git a/src/client/dexador.lisp b/src/client/dexador.lisp index 2503b5e..100d981 100644 --- a/src/client/dexador.lisp +++ b/src/client/dexador.lisp @@ -23,8 +23,6 @@ (in-package :lazybones/client.dexador) - - (defun endpoint-defun-name (ep) "Returns the string name of a defun for making requests to endpoint EP." diff --git a/src/client/parenscript.lisp b/src/client/parenscript.lisp index 75afbd7..bb9cc3a 100644 --- a/src/client/parenscript.lisp +++ b/src/client/parenscript.lisp @@ -1,3 +1,141 @@ (defpackage #:lazybones/client.parenscript (:use #:cl) + (:local-nicknames (#:lzb #:lazybones) + (#:a #:alexandria)) (:export #:generate)) + +(in-package :lazybones/client.parenscript) + +(defun lispify (str) + #+testiere + (:tests + (equalp (lispify "a.b") "a-b") + (equalp (lispify "a/b") "a-b")) + (with-output-to-string (out) + (loop :for c :across str :do + (write-char + (if (find c "./") #\- c) + out)))) + +(defun client-function-name (method pattern) + "Return a symbol; the name of the parenscript function that will make +an HTTP request of type METHOD at the path implied by PATTERN. PATTERN +is the value of the endpoint's DISPATCH-PATTERN slot." + #+testiere + (:tests + (string-equal + (client-function-name + :get '("" "session" ("doesn't" :matter) "notifications")) + 'get-session-notifications) + (string-equal + (client-function-name + :post '("" "foo.bar" "moo")) + 'post-foo-bar-moo)) + + (intern + (lispify + (string-upcase + (format nil "~a-~{~a~^-~}" + method + (remove-if-not (a:conjoin #'stringp (complement #'a:emptyp)) + pattern)))))) + +(defun client-function-lambda-list (variables body?) + #+testiere + (:tests + (equalp + (client-function-lambda-list '("*SESSION*") nil) + '(*session*)) + + (equalp + (butlast (client-function-lambda-list '("a.x" "b/y" "c") t)) + '(a-x b-y c &optional))) + + (nconc (mapcar (a:compose #'intern #'string-upcase #'lispify) variables) + (when body? (list '&optional (gensym "BODY"))))) + +(defun client-function-endpoint-path (prefix pattern) + #+testiere + (:tests + (equalp + (client-function-endpoint-path + "/api" '("" "session" ("id" :blahblah) "notifications")) + '(+ "/api" "/" "session" "/" id "/" "notifications"))) + (list* '+ prefix + (loop :for x :in pattern + :unless (zerop (length x)) + :collect "/" + :and :collect (if (consp x) + (intern (string-upcase (first x))) + x)))) + +(defun method-accepts-body? (m) + (member m '(:post :put :patch))) + +(defun generate-endpoint-form (app ep) + (let* ((method + (lzb:endpoint-method ep)) + + (method-name + (symbol-name method)) + + (content-type + (or (lzb:endpoint-content-type ep) + (lzb::default-content-type app))) + + (pattern + (lzb:endpoint-dispatch-pattern ep)) + + (variables + (lzb:endpoint-route-variables ep)) + + (function-name + (client-function-name method pattern)) + + (body? + (method-accepts-body? method)) + + (lambda-list + (client-function-lambda-list variables body?)) + + (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 + `(fetch ,fetch-path + (ps:create + method ,method-name + headers (ps:create "Content-Type" ,content-type) + redirect "follow" + body ,body)) + `(fetch ,fetch-path))))) + +(defun generate (app) + (let* ((module + (gensym "MODULE")) + + (module-name + (intern (lispify (symbol-name (lzb::app-name app))))) + + (defuns + (loop :for ep :in (lzb:app-endpoints app) + :collect (generate-endpoint-form app ep))) + + (exports + (loop :for defun :in defuns + :for name := (second defun) + :collect `(ps:@ ,module ,name) + :collect name))) + + `(defvar ,module-name + ((lambda (,module) + ,@defuns + (setf ,@exports) + ,module) + (ps:create))))) + diff --git a/src/lazybones.lisp b/src/lazybones.lisp index 97c7d40..ca168a5 100644 --- a/src/lazybones.lisp +++ b/src/lazybones.lisp @@ -332,6 +332,9 @@ Returns NIL on failure." (list (string-upcase var-name) (read-from-string (first decoder?))) (list (string-upcase var-name)))))) +(defun endpoint-route-variables (endpoint) + (route-variables (endpoint-dispatch-pattern endpoint))) + (defun route-variables (pattern) (loop for term in pattern when (listp term) diff --git a/src/package.lisp b/src/package.lisp index 04cc5bf..984288a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -49,7 +49,6 @@ #:*debugging* #:*allowed-keywords* #:http-error - #:generate-app-documentation #:provision-app #:app #:canned-response @@ -58,6 +57,13 @@ #:defendpoint #:defendpoint* #:endpoint + #:endpoint-method + #:endpoint-route + #:endpoint-params + #:endpoint-content-type + #:endpoint-dispatch-pattern + #:endpoint-route-variables + #:app-endpoints #:let-parameters #:map-parameters #:http-err |