Add package documentation
authorFrank Duncan <frank@kank.net>
Thu, 13 Aug 2015 08:18:11 +0000 (03:18 -0500)
committerFrank Duncan <frank@kank.net>
Thu, 13 Aug 2015 10:17:26 +0000 (05:17 -0500)
resources/success1.lisp
resources/success1.md
src/main/docgen.asd
src/main/docgen.lisp
src/main/package.lisp
src/main/pkg.lisp [new file with mode: 0644]
src/test/main.lisp
wiki

index 57df504e22dfeaffdbaf8193e751c3b679db0303..9b1bd140a1c2fa909dd797410e343c0b10e45e02 100644 (file)
@@ -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)
 
index e2b87f5e943fe48f93bfd16b563563533fede1de..c5cfe16132692dda26cf0d382f137ae46dd41074 100644 (file)
@@ -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:
index eebdbe70e7ea08d8d814daa29fdbac3f0c956081..169a1b8b5caacfbd8461441df76bf31ac863a09e 100644 (file)
@@ -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"
index 2ed740bdd66a51892a3afe9556c52c4ce55a1530..bb1b7a9af5db6b5eeec33ac7e22971eb7c06a22c 100644 (file)
@@ -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)))))
index 2f5891395ca7ca5bd9b2bf3245ff44354bf94186..3012351c0131fb2c702a06e941687b0719d57925 100644 (file)
@@ -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 (file)
index 0000000..1ce94be
--- /dev/null
@@ -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)))
index 3cfb79e163d535176a4b2d3e197f766fd83304ab..270609760f7b101bc940a224c2f602f989af8115 100644 (file)
  `(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 ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b..1a8916ff9faac67cbb461da9cc939d8bee63bf25 160000 (submodule)
--- a/wiki
+++ b/wiki
@@ -1 +1 @@
-Subproject commit ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b
+Subproject commit 1a8916ff9faac67cbb461da9cc939d8bee63bf25