From f37b6e61cbebab71424ae9561cd5932776c952d9 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Tue, 8 Feb 2022 08:24:27 -0600
Subject: added support for basic documentation of apps

---
 lazybones-documentation.lisp | 43 +++++++++++++++++++++++++++++++++++++++++++
 lazybones.asd                |  3 ++-
 lazybones.lisp               | 33 ++++++++++++++++++++++++++-------
 package.lisp                 |  1 +
 4 files changed, 72 insertions(+), 8 deletions(-)
 create mode 100644 lazybones-documentation.lisp

diff --git a/lazybones-documentation.lisp b/lazybones-documentation.lisp
new file mode 100644
index 0000000..bb94515
--- /dev/null
+++ b/lazybones-documentation.lisp
@@ -0,0 +1,43 @@
+;;;; lazybones-documentation.lisp -- documenting APP instances
+
+(in-package  :lazybones)
+
+(defun sorted-endpoints (endpoints)
+  (sort (copy-seq endpoints) #'string< :key #'endpoint-route))
+
+(defun generate-app-documentation (app)
+  "For now, generates a single Markdown string that documents each endpoint in APP."
+  (symbol-macrolet ((newline (progn  (princ #\newline)(princ #\newline))))
+    (with-slots
+          (title
+           version
+           endpoints
+           (default-authorizer authorizer)
+           default-content-type
+           app-error-response-contents
+           description)
+        app
+      (with-output-to-string (*standard-output*) 
+        (princ "# ") (princ title) (princ " - ") (princ "v") (princ version) 
+        newline
+        (princ description)
+        newline
+        (princ "## Endpoints")
+        (dolist (ep (sorted-endpoints endpoints))
+          (with-slots (method route authorizer endpoint-documentation) ep
+            newline 
+            (princ "### ") (princ method) (princ " ") (princ route)
+            newline
+            (when authorizer 
+              (princ "Authorization Required: ")
+              (cond ((function-or-function-name-p authorizer)
+                     (princ (documentation authorizer 'function)))
+                    ((function-or-function-name-p default-authorizer)
+                     (princ (documentation default-authorizer 'function))))
+              newline)
+
+            (princ endpoint-documentation) ))))))
+
+(defun function-or-function-name-p (thing)
+  (or (functionp thing)
+      (and (symbolp thing) (fboundp thing))))
diff --git a/lazybones.asd b/lazybones.asd
index 3a1326c..7ed7adf 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -13,5 +13,6 @@
                #:jonathan
                #:lisp-namespace)
   :components ((:file "package")
-               (:file "lazybones")))
+               (:file "lazybones")
+               (:file "lazybones-documentation")))
 
diff --git a/lazybones.lisp b/lazybones.lisp
index 45da60b..8e1228b 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -30,6 +30,18 @@
     :initarg :name
     :initform (error "Appname is required")
     :type symbol)
+   (title
+    :accessor app-title
+    :initarg :title
+    :initform ""
+    :type string
+    :documentation "A string title")
+   (description
+    :accessor app-description
+    :initarg :description
+    :initform ""
+    :type string
+    :documentation "A string describing the app")
    (version
     :reader app-version
     :initarg :vsn :initarg :version
@@ -65,8 +77,13 @@
 (defmethod initialize-instance :after ((app app) &key)
   (setf (symbol-lazybones (app-name app)) app))
 
-(defun app (name)
-  (symbol-lazybones name nil))
+(defun app (&optional name)
+  "Get the APP instance named by the symbol NAME. If NAME is not
+supplied, get the default app. Every package has at most one default
+app, named with the package name."
+  (symbol-lazybones (or name
+                        (intern (package-name *package*) *package*))
+                    nil))
 
 (defclass endpoint ()
   ((method
@@ -237,8 +254,9 @@ applying HANDLER-FUNCTION slot of ENDPOINT to the ARGS list."
   (let ((*request* request)
         (*response* response)
         (*app* app))
-    (when (request-authorized-p endpoint) 
-      (apply (endpoint-request-handler endpoint) args))))
+    (if (request-authorized-p endpoint) 
+        (apply (endpoint-request-handler endpoint) args)
+        (http-err 404))))
 
 (defun request-authorized-p (endpoint)
   "Attempts to authorize an endpoint.
@@ -254,9 +272,10 @@ authorizer is used.
 Hence, if the endpoint authorizer is T and the app doesn't have an
 authorizer, then, the endpoint wants to be authorized but there isn't
 any way to do it, hence NIL is returned."
-  (a:if-let (specific-authorizer (request-authorizer endpoint))
-    (if (functionp specific-authorizer)
-        (funcall specific-authorizer)
+  (a:if-let (auth (request-authorizer endpoint))
+    (if (or (functionp auth)
+            (and (symbolp auth) (fboundp auth)))
+        (funcall auth)
         (when (request-authorizer *app*) ; perhaps this should be an if, and  
           (funcall (request-authorizer *app*))))
     t))
diff --git a/package.lisp b/package.lisp
index 6c90b5b..126c046 100644
--- a/package.lisp
+++ b/package.lisp
@@ -39,6 +39,7 @@
    #:*app*
    #:*request*
    #:*response*
+   #:generate-app-documentation
    #:app
    #:create-server
    #:defendpoint
-- 
cgit v1.2.3