From da9f8ba322ea1de0db5fdfd04891c595e0ff91d8 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Feb 2022 10:38:48 -0600 Subject: hacking on documentation module --- lazybones-documentation.lisp | 19 ++++++++++-- lazybones.lisp | 71 +++++++++++++++++++++++++++++++++----------- package.lisp | 1 + 3 files changed, 71 insertions(+), 20 deletions(-) diff --git a/lazybones-documentation.lisp b/lazybones-documentation.lisp index bb94515..16164c5 100644 --- a/lazybones-documentation.lisp +++ b/lazybones-documentation.lisp @@ -24,20 +24,33 @@ newline (princ "## Endpoints") (dolist (ep (sorted-endpoints endpoints)) - (with-slots (method route authorizer endpoint-documentation) ep + (with-slots (method content-type route authorizer endpoint-documentation) ep newline (princ "### ") (princ method) (princ " ") (princ route) + (terpri) + (princ "*") + (princ (if content-type content-type default-content-type )) + (princ "*") newline (when authorizer (princ "Authorization Required: ") + newline (cond ((function-or-function-name-p authorizer) - (princ (documentation authorizer 'function))) + (princ (ensure-blockquote (documentation authorizer 'function)))) ((function-or-function-name-p default-authorizer) - (princ (documentation default-authorizer 'function)))) + (princ (ensure-blockquote (documentation default-authorizer 'function))))) newline) (princ endpoint-documentation) )))))) +(defun ensure-blockquote (string) + (concatenate 'string "> " + (str:replace-all + '(#\newline) + " +> " + string))) + (defun function-or-function-name-p (thing) (or (functionp thing) (and (symbolp thing) (fboundp thing)))) diff --git a/lazybones.lisp b/lazybones.lisp index 8e1228b..3345afe 100644 --- a/lazybones.lisp +++ b/lazybones.lisp @@ -24,6 +24,9 @@ ;;; LAZYBONES CLASSES +(defun default-app-name () + (intern (package-name *package*) *package*)) + (defclass app () ((name :reader app-name @@ -43,12 +46,12 @@ :type string :documentation "A string describing the app") (version - :reader app-version + :accessor app-version :initarg :vsn :initarg :version :initform "0.0.1" :type string) (authorizer - :reader request-authorizer + :accessor request-authorizer :initarg :auth :initform nil :documentation "A function of zero arguments that uses the request @@ -70,6 +73,41 @@ :accessor app-endpoints :initform nil))) +(defun error-content (code &optional (app *app*)) + (cdr (assoc code (app-error-response-contents app)))) + +(defun (setf error-content) (value code &optional (app *app*)) + (a:if-let (found (assoc code (app-error-response-contents app))) + (setf (cdr found) value) + (push (cons code value) (app-error-response-contents app)))) + +(defun expand-provision-app-option (app option value) + (list 'setf + (etypecase option + (keyword + (ecase option + ((:desc :description) `(lazybones::app-description ,app)) + (:title `(lazybones::app-title ,app)) + (:version `(lazybones::app-version ,app)) + (:content-type `(lazybones::default-content-type ,app)) + ((:auth :authorizer) `(lazybones::request-authorizer ,app)))) + (integer + `(lazybones::error-content ,option ,app))) + value)) + +(defmacro provision-app ((&optional name) &body body) + (assert (evenp (length body)) () "Odd number of forms in PROVISION-APP BODY.") + (let* ((the-app + (gensym)) + (provisioning + (loop for (k v . more) on body by #'cddr + collect (expand-provision-app-option the-app k v)))) + `(let ((,the-app + (if (null ',name) + (or (app) (make-instance 'app :name (default-app-name))) + (or (app ',name) (make-instance 'app :name ',name))))) + ,@provisioning))) + (defmethod initialize-instance :before ((app app) &key name &allow-other-keys) (when (app name) (error "an app named ~s already exists" name))) @@ -94,6 +132,10 @@ app, named with the package name." :reader endpoint-route :initarg :route :initform (error "endpoint route required")) + (content-type + :reader endpoint-content-type + :initarg :content-type + :initform nil) (authorizer :reader request-authorizer :initarg :auth @@ -286,20 +328,11 @@ any way to do it, hence NIL is returned." (appname method route (&key (auth nil) - (endpoint-class 'lazybones:endpoint) - (endpoint-initargs nil) - (app-class 'lazybones:app) - (app-initargs nil)) + content-type) &body body) "Defines and installs an ENDPOINT instance to the APP instance indicated by APPNAME, first checking an APP called APPNAME exits, making a new one if not." - (assert (and (symbolp endpoint-class) (subtypep endpoint-class 'lazybones:endpoint)) - () - "ENDPOINT-CLASS must be a literal symbol naming a subclass of LAZYBONES::ENDPOINT") - (assert (and (symbolp app-class) (subtypep app-class 'lazybones:app)) - () - "APP-CLASS must be a literal symbol naming a subclass of LAZYBONES::APP") (assert (member method +http-methods+) () "~a is not a valid http method keyword" method) @@ -313,24 +346,28 @@ making a new one if not." (real-body (if (stringp (first body)) (rest body) body))) `(let* ((,the-app - (or (app ',appname) (make-instance ',app-class :name ',appname ,@app-initargs))) + (or (app ',appname) (make-instance 'lazybones:app :name ',appname))) (,auth-method ,auth)) (register-endpoint ,the-app (make-instance - ',endpoint-class + 'lazybones:endpoint :method ,method :route ,route + :content-type ,content-type :pattern ',dispatch-pattern :doc ,documentation :auth ,auth-method - :function (lambda ,params ,@real-body) - ,@endpoint-initargs)))))) + :function + (lambda ,params + (setf (lazybones:response-header :content-type) + (or ,content-type (lazybones::default-content-type ,the-app))) + ,@real-body))))))) (defmacro defendpoint* (method route options &rest body) "Like DEFENDPOINT but uses the current package name as the app name." - `(defendpoint ,(intern (package-name cl:*package*)) ,method ,route ,options ,@body)) + `(defendpoint ,(default-app-name) ,method ,route ,options ,@body)) ;;; utilities diff --git a/package.lisp b/package.lisp index 126c046..826ad8a 100644 --- a/package.lisp +++ b/package.lisp @@ -40,6 +40,7 @@ #:*request* #:*response* #:generate-app-documentation + #:provision-app #:app #:create-server #:defendpoint -- cgit v1.2.3