From: Frank Duncan <frank@kank.net>
Date: Thu, 13 Aug 2015 08:18:11 +0000 (-0500)
Subject: Add package documentation
X-Git-Tag: 0.1~3
X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=683928f90e320bed84a816e8b59521b1c6714991;p=sheep

Add package documentation
---

diff --git a/resources/success1.lisp b/resources/success1.lisp
index 57df504..9b1bd14 100644
--- a/resources/success1.lisp
+++ b/resources/success1.lisp
@@ -6,8 +6,7 @@ This is should all get pulled in and the markdown.md should be equal
 to success1.md.")
  (:export
   #:func-that-does-stuff #:noargs #:result-list #:has-no-examples
-  #:values-result #:has-optional #:has-keywords #:has-rest
-  ))
+  #:values-result #:has-optional #:has-keywords #:has-rest))
 
 (in-package #:success1)
 
diff --git a/resources/success1.md b/resources/success1.md
index e2b87f5..c5cfe16 100644
--- a/resources/success1.md
+++ b/resources/success1.md
@@ -1,3 +1,9 @@
+# Package SUCCESS1
+
+This defines a simple successful package.
+
+This is should all get pulled in and the markdown.md should be equal to success1.md.
+
 ## Function **FUNC-THAT-DOES-STUFF**
 
 #### Syntax:
diff --git a/src/main/docgen.asd b/src/main/docgen.asd
index eebdbe7..169a1b8 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 "docgen")))
+ :components ((:file "package") (:file "func") (:file "pkg") (:file "docgen")))
 
 (asdf:defsystem docgen
  :name "Documentation Generator"
diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp
index 2ed740b..bb1b7a9 100644
--- a/src/main/docgen.lisp
+++ b/src/main/docgen.lisp
@@ -3,23 +3,27 @@
 (define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg)))
 
 (defun validate-package (pkg)
- (let
-  ((symbs nil))
-  (do-external-symbols (symb pkg) (push symb symbs))
-  (setf symbs (sort symbs #'string< :key #'symbol-name))
-  (remove :success
-   (mapcar
-    (lambda (symb)
-     (handler-case
-      (progn
-       (docgen-func:doc->ast symb)
-       :success)
-      (validation-failure (v) (list :failure :msg (validation-failure-msg v)))))
-    symbs))))
+ (macrolet
+  ((with-success-check (&rest f)
+    `(handler-case
+      (progn ,@f :success)
+      (validation-failure (v) (list :failure :msg (validation-failure-msg v))))))
+  (let
+   ((symbs nil))
+   (do-external-symbols (symb pkg) (push symb symbs))
+   (setf symbs (sort symbs #'string< :key #'symbol-name))
+   (remove :success
+    (append
+     (list (with-success-check (docgen-pkg:doc->ast pkg)))
+     (mapcar
+      (lambda (symb) (with-success-check (docgen-func:doc->ast symb)))
+      symbs))))))
 
 (defun export-package (pkg)
  (let
   ((symbs nil))
   (do-external-symbols (symb pkg) (push symb symbs))
   (setf symbs (sort symbs #'string< :key #'symbol-name))
-  (format nil "~{~A~^~%~}" (mapcar (lambda (symb) (docgen-func:ast->md (docgen-func:doc->ast symb))) symbs))))
+  (with-output-to-string (str)
+   (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))
+   (format str "~{~A~^~%~}" (mapcar (lambda (symb) (docgen-func:ast->md (docgen-func:doc->ast symb))) symbs)))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 2f58913..3012351 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -3,3 +3,6 @@
 
 (defpackage #:docgen-func (:use :cl)
  (:export #:doc->ast #:ast->md))
+
+(defpackage #:docgen-pkg (:use :cl)
+ (:export #:doc->ast #:ast->md))
diff --git a/src/main/pkg.lisp b/src/main/pkg.lisp
new file mode 100644
index 0000000..1ce94be
--- /dev/null
+++ b/src/main/pkg.lisp
@@ -0,0 +1,35 @@
+(in-package #:docgen-pkg)
+
+(defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg)))
+
+(defun doc->ast (pkg)
+ (labels
+  ((validate (strs)
+    (mapcar
+     (lambda (str)
+      (cond
+       ((< 120 (length str)) (fire-error (format nil "Package description longer than 120 characters: ~A" str)))
+       ((cl-ppcre:scan "^ " str) (fire-error (format nil "Package description line started with space: ~A" str)))
+       ((cl-ppcre:scan " $" str) (fire-error (format nil "Package 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 pkg t))))
+   (validate lines)
+   (let
+    ((paragraphs (combine lines)))
+    (when (< 120 (length (first paragraphs))) (fire-error "First package paragraph is longer than 120 characters"))
+    (when (find "" paragraphs :test #'string=) (fire-error "Package description has two empty lines in it"))
+    (cons (package-name pkg) paragraphs)))))
+
+(defun ast->md (ast)
+ (format nil "# Package ~A~%~%~{~A~^~%~%~}"
+  (car ast)
+  (cdr ast)))
diff --git a/src/test/main.lisp b/src/test/main.lisp
index 3cfb79e..2706097 100644
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -27,8 +27,14 @@
  `(deftest
    ,source
    (lambda ()
-    (load ,source)
-    (ignore-errors (string= (slurp-file ,target) (docgen:export-package ,pkg))))))
+    (handler-case
+     (progn
+      (load ,source)
+      (string= (slurp-file ,target) (docgen:export-package ,pkg)))
+     (docgen:validation-failure (vf)
+      (format t "Error gotten: ~A~%"
+       (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
+     (error (e) (format t "Error gotten: ~A~%" e))))))
 
 (defmacro deffailure-func-test (name doc expected)
  `(deftest
diff --git a/wiki b/wiki
index ffe2711..1a8916f 160000
--- a/wiki
+++ b/wiki
@@ -1 +1 @@
-Subproject commit ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b
+Subproject commit 1a8916ff9faac67cbb461da9cc939d8bee63bf25