diff options
Diffstat (limited to 'lazybones.lisp')
| -rw-r--r-- | lazybones.lisp | 71 |
1 files changed, 54 insertions, 17 deletions
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 |