From e9d1b7da236295700286b7564960d84f9c5f0dbe Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Thu, 13 Aug 2015 05:39:13 -0500
Subject: [PATCH] Add structure documentation

---
 resources/emptydocs.lisp |  4 +++-
 resources/success1.lisp  |  7 +++++++
 resources/success1.md    |  6 ++++++
 src/main/docgen.asd      |  2 +-
 src/main/docgen.lisp     |  7 +++++--
 src/main/package.lisp    |  3 +++
 src/main/struc.lisp      | 39 +++++++++++++++++++++++++++++++++++++++
 src/test/main.lisp       |  1 +
 8 files changed, 65 insertions(+), 4 deletions(-)
 create mode 100644 src/main/struc.lisp

diff --git a/resources/emptydocs.lisp b/resources/emptydocs.lisp
index 7076c6a..6083831 100644
--- a/resources/emptydocs.lisp
+++ b/resources/emptydocs.lisp
@@ -1,6 +1,8 @@
 (defpackage #:emptydocs (:use :cl)
- (:export #:no-doc-func))
+ (:export #:no-doc-condition #:no-doc-func))
 
 (in-package #:emptydocs)
 
+(define-condition no-doc-condition nil nil)
+
 (defun no-doc-func (path x) path)
diff --git a/resources/success1.lisp b/resources/success1.lisp
index 9b1bd14..338b5b6 100644
--- a/resources/success1.lisp
+++ b/resources/success1.lisp
@@ -5,11 +5,18 @@
 This is should all get pulled in and the markdown.md should be equal
 to success1.md.")
  (:export
+  #:test-condition
   #:func-that-does-stuff #:noargs #:result-list #:has-no-examples
   #:values-result #:has-optional #:has-keywords #:has-rest))
 
 (in-package #:success1)
 
+(define-condition test-condition nil nil
+ (:documentation
+  "Simple documentation.
+
+For a simple condition."))
+
 (defun func-that-does-stuff (path x)
  "FUNC-THAT-DOES-STUFF PATH X => RESULT
 
diff --git a/resources/success1.md b/resources/success1.md
index c5cfe16..c3a91d1 100644
--- a/resources/success1.md
+++ b/resources/success1.md
@@ -162,6 +162,12 @@ _msg_---a string containing the failure message
 
 NOARGS runs all the things against a file and returns as soon as the first func error is found.
 
+## Condition TEST-CONDITION
+
+Simple documentation.
+
+For a simple condition.
+
 ## Function **VALUES-RESULT**
 
 #### Syntax:
diff --git a/src/main/docgen.asd b/src/main/docgen.asd
index 169a1b8..6927c03 100644
--- a/src/main/docgen.asd
+++ b/src/main/docgen.asd
@@ -8,7 +8,7 @@
 ; There's probably a better way, but I don't know it
 (asdf:defsystem docgen.internal
  :serial t
- :components ((:file "package") (:file "func") (:file "pkg") (:file "docgen")))
+ :components ((:file "package") (:file "func") (:file "pkg") (:file "struc") (:file "docgen")))
 
 (asdf:defsystem docgen
  :name "Documentation Generator"
diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp
index 48d2371..b3d251e 100644
--- a/src/main/docgen.lisp
+++ b/src/main/docgen.lisp
@@ -5,7 +5,7 @@
 (defun get-symb-type (symb)
  (cond
   ;((documentation symb 'variable) :variable)
-  ;((documentation symb 'structure) :structure)
+  ((documentation symb 'structure) :structure)
   ((documentation symb 'function) :function)))
 
 (defun validate-package (pkg)
@@ -26,6 +26,7 @@
        (with-success-check
         (case (get-symb-type symb)
          (:function (docgen-func:doc->ast symb))
+         (:structure (docgen-struc:doc->ast symb))
          (t (error (make-condition 'validation-failure :msg (format nil "Symbol ~A has no documentation" symb)))))))
       symbs))))))
 
@@ -51,6 +52,8 @@
    (format str "~{~A~^~%~}"
     (mapcar
      (lambda (symb)
+      (format t "HAHAHAH ~A ~A~%" symb (get-symb-type symb))
       (case (get-symb-type symb)
-       (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))))
+       (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))
+       (:structure (docgen-struc:ast->md (docgen-struc:doc->ast symb)))))
      symbs)))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 4580602..00c3bb7 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -6,3 +6,6 @@
 
 (defpackage #:docgen-pkg (:use :cl)
  (:export #:doc->ast #:ast->md))
+
+(defpackage #:docgen-struc (:use :cl)
+ (:export #:doc->ast #:ast->md))
diff --git a/src/main/struc.lisp b/src/main/struc.lisp
new file mode 100644
index 0000000..a616ee9
--- /dev/null
+++ b/src/main/struc.lisp
@@ -0,0 +1,39 @@
+(in-package #:docgen-struc)
+
+(defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg)))
+
+(defun doc->ast (struc)
+ (labels
+  ((validate (strs)
+    (mapcar
+     (lambda (str)
+      (cond
+       ((< 120 (length str)) (fire-error (format nil "Structure description longer than 120 characters: ~A" str)))
+       ((cl-ppcre:scan "^ " str) (fire-error (format nil "Structure description line started with space: ~A" str)))
+       ((cl-ppcre:scan " $" str) (fire-error (format nil "Structure description line ended with space: ~A" str)))))
+     strs))
+   (combine (strs)
+    (cond
+     ((not strs) (list ""))
+     ((string= "" (car strs)) (cons "" (combine (cdr strs))))
+     (t
+      (let
+       ((rest (combine (cdr strs))))
+       (cons (format nil "~A~A~A" (car strs) (if (string/= "" (car rest)) " " "") (car rest)) (cdr rest)))))))
+  (let
+   ((lines (cl-ppcre:split "\\n" (documentation struc 'structure))))
+   (validate lines)
+   (let
+    ((paragraphs (combine lines)))
+    (when (find "" paragraphs :test #'string=) (fire-error "Structure description has two empty lines in it"))
+    (cons
+     (cond
+      ((typep (make-instance struc) 'condition) :condition)
+      (t :struct))
+     (cons struc paragraphs))))))
+
+(defun ast->md (ast)
+ (format nil "## ~@(~A~) ~A~%~%~{~A~%~^~%~}"
+  (first ast)
+  (second ast)
+  (cddr ast)))
diff --git a/src/test/main.lisp b/src/test/main.lisp
index 1b796f5..a73dd7b 100644
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -71,4 +71,5 @@
 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
 (deffailuretest :emptydocs "resources/emptydocs.lisp"
  '((:failure "Package EMPTYDOCS has no documentation")
+   (:failure "Symbol NO-DOC-CONDITION has no documentation")
    (:failure "Symbol NO-DOC-FUNC has no documentation")))
-- 
2.25.1