add whole classes to documentation

6 files changed, 107 insertions, 4 deletions

diff --git a/clpmfile.lock b/clpmfile.lock
index 874567c..54750b5 100644
--- a/clpmfile.lock
+++ b/clpmfile.lock
@@ -71,6 +71,8 @@
  ("static-vectors"))
 ("trivial-backtrace" :version "2020-06-10" :source "quicklisp" :systems
  ("trivial-backtrace"))
+("trivial-documentation" :version "2016-12-07" :source "quicklisp" :systems
+ ("trivial-documentation"))
 ("trivial-features" :version "2021-12-09" :source "quicklisp" :systems
  ("trivial-features"))
 ("trivial-garbage" :version "2021-12-30" :source "quicklisp" :systems
@@ -148,7 +150,8 @@
 
 ("cl-unicode" ((:system :name "cl-ppcre-unicode") (:system :name "cl-unicode")))
 
-("closer-mop" ((:system :name "lazybones") (:system :name "closer-mop")))
+("closer-mop"
+ ((:system :name "trivial-documentation") (:system :name "closer-mop")))
 
 ("fast-io" ((:system :name "jonathan") (:system :name "fast-io")))
 
@@ -186,6 +189,9 @@
 ("trivial-backtrace"
  ((:system :name "hunchentoot") (:system :name "trivial-backtrace")))
 
+("trivial-documentation"
+ ((:system :name "lazybones") (:system :name "trivial-documentation")))
+
 ("trivial-features"
  ((:system :name "cl+ssl") (:system :name "trivial-features"))
  ((:system :name "cffi") (:system :name "trivial-features"))
diff --git a/example/lazybones-example-docs.md b/example/lazybones-example-docs.md
index a7dfca9..522d129 100644
--- a/example/lazybones-example-docs.md
+++ b/example/lazybones-example-docs.md
@@ -6,6 +6,17 @@ Just an API that defines some endpoints. These
 
 ## Endpoints
 
+### GET /animal/:genus:/:species:
+*text/plain*
+
+Route Variables: 
+
+- GENUS
+- SPECIES
+
+
+Prints information about [Animal](#animal) specified by  GENUS and SPECIES
+
 ### POST /crapshoot
 *text/plain*
 
@@ -97,3 +108,15 @@ An instance of person. As JSON, it looks like:
 
 
 
+<h3 id='#animal'>animal</h3>
+
+An animal
+
+**Slots:**
+- GENUS: The genus
+- SPECIES: The species
+- POPULATION: Population on Earth
+- HABITAT: Where the animal lives
+
+
+
diff --git a/example/lazybones-example.lisp b/example/lazybones-example.lisp
index 5eb00d9..018b4ae 100644
--- a/example/lazybones-example.lisp
+++ b/example/lazybones-example.lisp
@@ -135,3 +135,35 @@
     }
 
 ")
+
+(defclass animal ()
+  ((genus :initarg :genus :documentation "The genus")
+   (species :initarg :species :documentation "The species")
+   (population :initarg :population :documentation "Population on Earth")
+   (habitat :initarg :habitat :documentation "Where the animal lives"))
+  (:documentation "An animal"))
+
+;; add a documentation definition for animal class, the provided slots
+;; will show up in the api docs
+(lzb:add-class-to-definitions (lzb:app)
+                              'animal
+                              'genus 'species 'population 'habitat)
+
+(defvar +dummy-animal+
+  (make-instance 'animal
+                 :genus "Pseudocheirus"
+                 :species "Peregrinis"
+                 :population "Unknown"
+                 :habitat "Australia"))
+
+;; you can refer to definitions in docstrings
+(defendpoint* :get "/animal/:genus:/:species:" () ()
+  "Prints information about [Animal](#animal) specified by  GENUS and SPECIES"
+  (if (and (string-equal genus "Pseudocheirus")
+           (string-equal species "Peregrinis"))
+      (with-output-to-string (out)
+        (with-slots (genus species population habitat) +dummy-animal+
+            (format out "The ~a ~a lives in ~a. Population: ~a~%"
+                    genus species population habitat)))
+      (http-err 404)))
+
diff --git a/lazybones.asd b/lazybones.asd
index f5d819e..058257c 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -4,12 +4,12 @@
   :description "http route handling"
   :author "Colin Okay <okay@toyful.space>"
   :license  "AGPLv3"
-  :version "0.6.1"
+  :version "0.7.0"
   :serial t
   :depends-on (#:alexandria
                #:str
                #:cl-ppcre
-               #:closer-mop
+               #:trivial-documentation
                #:jonathan
                #:lisp-namespace)
   :components ((:file "package")
diff --git a/lazybones.lisp b/lazybones.lisp
index 66192a2..80d7f73 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -400,3 +400,42 @@ making a new one if not."
   "Remove definition keyed by LINK-TARGET from APP."
   (remhash name (app-definitions app)))
 
+(defun names-equal-p (s1 s2)
+  (or (equalp s1 s2)
+      (and (symbolp s1) (equalp (symbol-name s1) s2))
+      (and (symbolp s2) (equalp s1 (symbol-name s2)))
+      (and (symbolp s1) (symbolp s2)
+           (string-equal (symbol-name s1) (symbol-name s2)))))
+
+(defun getplist (indicator plist &key (test 'names-equal-p ) key)
+  (let ((indicator (if key (funcall key indicator) indicator))) 
+    (loop for (k0 v . more) on plist by #'cddr
+          for k = (if key (funcall key k0) k0)
+          when (funcall test indicator k)
+            return (values v t)
+          finally (return (values nil least-negative-long-float )))))
+
+(defun class-docs (class-name)
+  (closer-mop:ensure-finalized (find-class class-name))
+  (loop for plist in (trivial-documentation:symbol-definitions class-name)
+        when (eql :class (getf plist :kind))
+          return (list (getf plist :documentation)
+                       (getf plist :slots))))
+
+(defun add-class-to-definitions (app class-name &rest slot-names)
+  "Generates a definition entry from class and slot documentation
+CLASS-NAME should be a symbol, and SLOT-NAMES symbols."
+  (destructuring-bind (documentation slots) (class-docs class-name)
+    (set-definition (string-downcase (symbol-name class-name))
+                    (string-downcase (format nil "#~a" class-name))
+                    (with-output-to-string (*standard-output*)
+                      (princ documentation) 
+                      (princ #\newline) (princ #\newline)
+                      (princ "**Slots:**") (princ #\newline)
+                      (dolist (sn slot-names)
+                        (a:when-let (slot-doc (getplist sn slots))
+                          (princ "- ") (princ sn) (princ ": ")
+                          (princ slot-doc)
+                          (princ #\newline)))
+                      (princ #\newline))
+                    app)))
diff --git a/package.lisp b/package.lisp
index 07c003d..6503203 100644
--- a/package.lisp
+++ b/package.lisp
@@ -75,5 +75,8 @@
    #:response-header
    #:start-server
    #:stop-server
-   #:uninstall-app))
+   #:uninstall-app
+   #:set-definition
+   #:drop-definition
+   #:add-class-to-definitions))