1 files changed, 116 insertions, 0 deletions
diff --git a/src/documentation/markdown.lisp b/src/documentation/markdown.lisp
new file mode 100644
index 0000000..5f2b883
--- /dev/null
+++ b/src/documentation/markdown.lisp
@@ -0,0 +1,116 @@
+;; Copyright (C) 2022  colin@cicadas.surf
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;;; markdown.lisp -- documenting APP instances
+
+(defpackage #:lazybones/documentation.markdown
+  (:use #:cl)
+  (:export #:generate))
+
+(in-package  :lazybones/documentation.markdown)
+
+(defun sorted-endpoints (endpoints)
+  (sort (copy-seq endpoints) #'string< :key #'endpoint-route))
+
+(defun generate (app)
+  "For now, returns a single Markdown formatted 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
+           description
+           definitions)
+        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 content-type route authorizer params endpoint-documentation) ep
+            newline 
+            (princ "### ") (princ method) (princ " ") (princ (make-route-presentable route))
+            (terpri)
+            (princ "*")
+            (princ (if content-type content-type default-content-type ))
+            (princ "*")
+            (when authorizer 
+              newline
+              (princ "Authorization Required: ")
+              newline
+              (cond ((function-or-function-name-p authorizer)
+                     (princ (ensure-blockquote (documentation authorizer 'function))))
+                    ((function-or-function-name-p default-authorizer)
+                     (princ (ensure-blockquote (documentation default-authorizer 'function)))))
+              newline)
+            (a:when-let (vars (endpoint-route-vars ep)) 
+              newline
+              (princ "Route Variables: ") newline
+              (dolist (var vars)
+                (princ "- ") (princ var)
+                (a:when-let (val-parser (route-var-value-parser ep var))
+                  (princ ": ") (princ (strip-newlines (documentation val-parser 'function))))
+                (princ #\newline)))
+            (when params
+              newline
+              (princ "Documented Query Parameters: ") newline
+              (loop for (var parser) in params
+                    do (princ "- ") (princ (string-downcase (symbol-name var)))
+                       (princ ": ") (princ (strip-newlines (documentation parser 'function)))
+                       (princ #\newline)))
+            newline
+            (princ endpoint-documentation)))
+        newline
+        (when (plusp (hash-table-count definitions)) 
+          (princ "## Definitions") newline
+          (loop for name being the hash-key of definitions
+                for (node-id . text) being the hash-value of definitions
+                do (format *standard-output*
+                           "<h3 id='~a'>~a</h3>"
+                           node-id name)
+                   (princ #\newline) (princ #\newline)
+                   (princ text)
+                   (princ #\newline) (princ #\newline)))))))
+
+(defun ensure-blockquote (string)
+  (concatenate 'string "> "
+               (str:replace-all
+                '(#\newline)
+                "
+> "
+                string)))
+
+(defun strip-newlines (string)
+  (str:replace-all '(#\newline) "" string))
+
+(defun function-or-function-name-p (thing)
+  (or (functionp thing)
+      (and (symbolp thing) (fboundp thing))))
+
+(defun endpoint-route-vars (ep)
+  "return a list of route variables for endpoint EP"
+  (mapcar 'first (remove-if-not #'consp  (endpoint-dispatch-pattern ep))))
+
+(defun route-var-value-parser (ep var)
+  (second (assoc var (remove-if-not #'consp (endpoint-dispatch-pattern ep)))))
+
+(defun make-route-presentable (routestring)
+  (ppcre:regex-replace-all " [a-z0-9A-Z\-]+:" routestring ":"))