From 683928f90e320bed84a816e8b59521b1c6714991 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Thu, 13 Aug 2015 03:18:11 -0500 Subject: [PATCH] Add package documentation --- resources/success1.lisp | 3 +-- resources/success1.md | 6 ++++++ src/main/docgen.asd | 2 +- src/main/docgen.lisp | 32 ++++++++++++++++++-------------- src/main/package.lisp | 3 +++ src/main/pkg.lisp | 35 +++++++++++++++++++++++++++++++++++ src/test/main.lisp | 10 ++++++++-- wiki | 2 +- 8 files changed, 73 insertions(+), 20 deletions(-) create mode 100644 src/main/pkg.lisp 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 -- 2.25.1