hacking on documentation module

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