From: Frank Duncan Date: Tue, 11 Aug 2015 12:45:48 +0000 (-0500) Subject: Add function documentation checker/converter X-Git-Tag: 0.1~4 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c8ef06;p=sheep Add function documentation checker/converter --- diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..3430f36 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "wiki"] + path = wiki + url = https://github.com/frankduncan/docgen.wiki.git diff --git a/bin/test.sh b/bin/test.sh new file mode 100755 index 0000000..047a13f --- /dev/null +++ b/bin/test.sh @@ -0,0 +1,11 @@ +#!/bin/bash + +sbcl \ + --eval "(asdf:load-system :docgen)" \ + --eval "(load \"$1\")" \ + --eval "(format t \"----~%\")" \ + --eval "(format t \"~A\" (docgen:export-package $2))" \ + --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2 > fromcl.md + +vimdiff fromcl.md ${1/lisp/md} +rm fromcl.md diff --git a/resources/success1.lisp b/resources/success1.lisp new file mode 100644 index 0000000..57df504 --- /dev/null +++ b/resources/success1.lisp @@ -0,0 +1,187 @@ +(defpackage #:success1 (:use :cl) + (:documentation +"This defines a simple successful package. + +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 + )) + +(in-package #:success1) + +(defun func-that-does-stuff (path x) + "FUNC-THAT-DOES-STUFF PATH X => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + PATH: a pathname + X: a random value related to PATH + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + FUNC-THAT-DOES-STUFF runs all the things against a file and returns + as soon as the first func error is found. + + This second section uses PATH and X as something we should talk about, but + doesn't use all the arguments (let's include PATH here for fun) + +EXAMPLES: + + (func-that-does-stuff #P\"path/to/file.lisp\" t) => (:success \"path/to/file.lisp\") + (func-that-does-stuff #P\"path/to/error.lisp\" nil) => (:failure \"path/to/error.lisp\" \"Error msg\" 20 0)" + path) + +(defun result-list () + "RESULT-LIST => RESULT + + RESULT: FAILURE-RESULT* + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + NOARGS runs all the things against a file and returns + as soon as the first func error is found." + nil) + +(defun noargs () + "NOARGS => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + NOARGS runs all the things against a file and returns + as soon as the first func error is found. + +EXAMPLES: + + (func-that-does-stuff) => (:success \"path/to/file.lisp\") + (func-that-does-stuff) => (:failure \"path/to/error.lisp\" \"Error msg\" 20 0)" + nil) + +(defun has-no-examples () + "HAS-NO-EXAMPLES => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + HAS-NO-EXAMPLES runs all the things against a file and returns + as soon as the first func error is found." + nil) + +(defun values-result () + "VALUES-RESULT => RESULT1, RESULT2, RESULT3 + + RESULT1: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + RESULT2: second result + RESULT3: third result + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + VALUES-RESULT runs all the things against a file and returns + as soon as the first func error is found." + nil) + +(defun has-optional (path &optional x) + "HAS-OPTIONAL PATH &optional X => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + PATH: a pathname + X: a random value related to PATH + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + HAS-OPTIONAL runs all the things against a file and returns + as soon as the first func error is found. + + This second section uses PATH and X as something we should talk about, but + doesn't use all the arguments (let's include PATH here for fun)" + path) + +(defun has-keywords (path &key x) + "HAS-KEYWORDS PATH &key X => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + PATH: a pathname + X: a random value related to PATH + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + HAS-KEYWORDS runs all the things against a file and returns + as soon as the first func error is found. + + This second section uses PATH and X as something we should talk about, but + doesn't use all the arguments (let's include PATH here for fun)" + path) + +(defun has-rest (path &rest x) + "HAS-REST PATH &rest X => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:failure FILENAME MSG) + +ARGUMENTS AND VALUES: + + PATH: a pathname + X: a random value related to PATH + FILENAME: the file this func was run on + MSG: a string containing the failure message + +DESCRIPTION: + + HAS-REST runs all the things against a file and returns + as soon as the first func error is found. + + This second section uses PATH and X as something we should talk about, but + doesn't use all the arguments (let's include PATH here for fun)" + path) diff --git a/resources/success1.md b/resources/success1.md new file mode 100644 index 0000000..e2b87f5 --- /dev/null +++ b/resources/success1.md @@ -0,0 +1,178 @@ +## Function **FUNC-THAT-DOES-STUFF** + +#### Syntax: + +**func-that-does-stuff** _path_ _x_ => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_path_---a pathname +_x_---a random value related to _path_ +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_func-that-does-stuff_ runs all the things against a file and returns as soon as the first func error is found. + +This second section uses _path_ and _x_ as something we should talk about, but doesn't use all the arguments (let's include _path_ here for fun) + +#### Examples: + +```(func-that-does-stuff #P"path/to/file.lisp" t)``` => ```(:success "path/to/file.lisp")``` +```(func-that-does-stuff #P"path/to/error.lisp" nil)``` => ```(:failure "path/to/error.lisp" "Error msg" 20 0)``` + +## Function **HAS-KEYWORDS** + +#### Syntax: + +**has-keywords** _path_ _&key_ _x_ => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_path_---a pathname +_x_---a random value related to _path_ +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_has-keywords_ runs all the things against a file and returns as soon as the first func error is found. + +This second section uses _path_ and _x_ as something we should talk about, but doesn't use all the arguments (let's include _path_ here for fun) + +## Function **HAS-NO-EXAMPLES** + +#### Syntax: + +**has-no-examples** => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_has-no-examples_ runs all the things against a file and returns as soon as the first func error is found. + +## Function **HAS-OPTIONAL** + +#### Syntax: + +**has-optional** _path_ _&optional_ _x_ => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_path_---a pathname +_x_---a random value related to _path_ +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_has-optional_ runs all the things against a file and returns as soon as the first func error is found. + +This second section uses _path_ and _x_ as something we should talk about, but doesn't use all the arguments (let's include _path_ here for fun) + +## Function **HAS-REST** + +#### Syntax: + +**has-rest** _path_ _&rest_ _x_ => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_path_---a pathname +_x_---a random value related to _path_ +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_has-rest_ runs all the things against a file and returns as soon as the first func error is found. + +This second section uses _path_ and _x_ as something we should talk about, but doesn't use all the arguments (let's include _path_ here for fun) + +## Function **NOARGS** + +#### Syntax: + +**noargs** => _result_ + +```result::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_noargs_ runs all the things against a file and returns as soon as the first func error is found. + +#### Examples: + +```(func-that-does-stuff)``` => ```(:success "path/to/file.lisp")``` +```(func-that-does-stuff)``` => ```(:failure "path/to/error.lisp" "Error msg" 20 0)``` + +## Function **RESULT-LIST** + +#### Syntax: + +**result-list** => _result_ + +```result::= failure-result*``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +NOARGS runs all the things against a file and returns as soon as the first func error is found. + +## Function **VALUES-RESULT** + +#### Syntax: + +**values-result** => _result1_, _result2_, _result3_ + +```result1::= success-result | failure-result``` +```success-result::= (:success filename)``` +```failure-result::= (:failure filename msg)``` + +#### Arguments and Values: + +_result2_---second result +_result3_---third result +_filename_---the file this func was run on +_msg_---a string containing the failure message + +#### Description: + +_values-result_ runs all the things against a file and returns as soon as the first func error is found. diff --git a/src/main/docgen.asd b/src/main/docgen.asd index 5697064..eebdbe7 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 "docgen"))) + :components ((:file "package") (:file "func") (:file "docgen"))) (asdf:defsystem docgen :name "Documentation Generator" diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp index 7142dfe..2ed740b 100644 --- a/src/main/docgen.lisp +++ b/src/main/docgen.lisp @@ -1,5 +1,25 @@ (in-package #:docgen) -(defun validate-package (package)) +(define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg))) -(defun export-package (package)) +(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)))) + +(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)))) diff --git a/src/main/func.lisp b/src/main/func.lisp new file mode 100644 index 0000000..d3540a6 --- /dev/null +++ b/src/main/func.lisp @@ -0,0 +1,330 @@ +(in-package #:docgen-func) + +(defvar *doc*) +(defvar *prev-line*) +(defun peek () (car *doc*)) +(defun next () (setf *prev-line* (pop *doc*))) +(defun more () (not (not *doc*))) +(defun prev-line () *prev-line*) + +(defvar *keywords*) + +(defun add-keyword (type) + (setf *keywords* (remove-duplicates (cons type *keywords*) :test #'string=))) + +(defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg))) + +(defun expect-blank-line () + (let + ((prev (prev-line))) + (when (string/= "" (next)) (fire-error (format nil "Expected blank line after: ~A" prev))))) + +(defun verify-next-line (&key optional) + (cond + ((and optional (not (more))) t) + ((not (more)) (fire-error (format nil "Expected line after: ~A" (prev-line)))) + ((cl-ppcre:scan " $" (peek)) (fire-error (format nil "Can't end line with a space: ~A" (peek)))) + ((< 120 (length (peek))) (fire-error (format nil "Longer than 120 chars: ~A" (peek)))))) + +(defun decompose-type (type-line) + (labels + ((decompose-symbol (atom) + (cond + ((cl-ppcre:scan " " atom) (fire-error (format nil "Symbols had spaces in it: ~A" atom))) + ((cl-ppcre:scan ":.*[A-Z]" atom) (fire-error (format nil "Keyword symbols must all be lower case: ~A" atom))) + ((cl-ppcre:scan ":.*" atom) (list :keyword atom)) + ((cl-ppcre:scan "[a-z]" atom) (fire-error (format nil "Type symbols must all be upper case: ~A" atom))) + (t (list :type atom)))) + (asterisk-type (atom) + (when (cl-ppcre:scan "\\*$" atom) + (list :asterisk (list (decompose-symbol (subseq atom 0 (1- (length atom)))))))) + (symbol-type (def) + (list :symbol (list (decompose-symbol def)))) + (or-type (def) + (when (cl-ppcre:scan "\\|" def) + (when (cl-ppcre:scan "[\\(\\)]" def) (fire-error (format nil "Or types can't have lists in them: ~A" def))) + (when (cl-ppcre:scan "[^ ]\\|" def) + (fire-error (format nil "All or pipes must be prefaced by spaces: ~A" def))) + (when (cl-ppcre:scan "\\|[^ ]" def) + (fire-error (format nil "All or pipes must be concluded by spaces: ~A" def))) + (list :or (mapcar #'decompose-symbol (cl-ppcre:split " \\| " def))))) + (list-type (def) + (when + (cl-ppcre:scan "^\\(.*\\)$" def) + (when (cl-ppcre:scan "\\|" def) (fire-error (format nil "List types can't have | in them: ~A" def))) + (when (cl-ppcre:scan "^\\(.*[\\(\\)].*\\)$" def) + (fire-error (format nil "List types can't have sublists: ~A" def))) + (when (cl-ppcre:scan " " def) (fire-error (format nil "Lists can be seperated by only one space: ~A" def))) + (list + :list + (mapcar #'decompose-symbol (cl-ppcre:split " " (subseq def 1 (1- (length def))))))))) + (let + ((type-scanner (cl-ppcre:create-scanner "^ ([^ :]+): (.+)$"))) + (when (not (cl-ppcre:scan type-scanner type-line)) + (fire-error (format nil "Type line did not match \" TYPE: type-definition\": ~A" type-line))) + (cl-ppcre:register-groups-bind (type def) (type-scanner type-line) + (let + ((decomposed-def (or (or-type def) (list-type def) (asterisk-type def) (symbol-type def)))) + (when (not decomposed-def) (fire-error (format nil "Couldn't figure out how to decompose: ~A" def))) + (list + type + decomposed-def + (remove + nil + (mapcar + (lambda (symb-def) (when (eql :type (car symb-def)) (cadr symb-def))) + (cadr decomposed-def))))))))) + +(defun parse-types (types) + (if + (string/= "ARGUMENTS AND VALUES:" (peek)) + (multiple-value-bind (processed-types args-to-be-explained) (process-types types) + (expect-blank-line) + (values (list :types processed-types) args-to-be-explained)) + (values nil types))) + +(defun process-types (remaining-types &optional processed-types args-to-be-explained) + (verify-next-line) + (cond + ((string= "" (peek)) (values processed-types (append args-to-be-explained remaining-types))) + ((not remaining-types) + (fire-error (format nil "Ran out of types to talk about, but got a non empty line: ~A" (peek)))) + (t + (let + ((decomposed (decompose-type (peek)))) + (if (string/= (car decomposed) (car remaining-types)) + (process-types (cdr remaining-types) processed-types (append args-to-be-explained (list (car remaining-types)))) + (progn + (next) + (process-types + (append (cdr remaining-types) (third decomposed)) + (append processed-types (list (list (car decomposed) (second decomposed)))) + args-to-be-explained))))))) + +(defun description->paragraphs () + (verify-next-line :optional t) + (let + ((next-line (next))) + (cond + ((not next-line) (list "")) ; Can be last section + ((and (string= "" next-line) (not (more))) (fire-error "Can't end with empty line")) + ((cl-ppcre:scan "^ [^ ].+" next-line) + (let + ((rest-of-description (description->paragraphs))) + (cons + (format nil "~A~A~A" + (subseq next-line 2 (length next-line)) + (if (and (car rest-of-description) (string/= "" (car rest-of-description))) " " "") + (car rest-of-description)) + (cdr rest-of-description)))) + ((string= "" next-line) + (if (string= "EXAMPLES:" (peek)) + (list "") + (cons "" (description->paragraphs)))) + (t (fire-error (format nil "Got unexpected line, requires blank lines or start with two spaces: ~S" next-line)))))) + +(defun parse-description () + (when (string/= "DESCRIPTION:" (next)) (fire-error (format nil "Expected DESCRIPTION: instead of: ~A" (prev-line)))) + (expect-blank-line) + (let + ((paragraphs (description->paragraphs))) + (list :description (mapcar #'handle-text paragraphs)))) + +(defun process-examples () + (when (more) + (verify-next-line :optional t) + (cons + (let + ((example-scanner (cl-ppcre:create-scanner "^ ([^ ].+) => (.+)$")) + (next-line (next))) + (if (not (cl-ppcre:scan example-scanner next-line)) + (fire-error (format nil "Example line does not match \" example => result\": ~A" next-line)) + (cl-ppcre:register-groups-bind (example result) (example-scanner next-line) + (list example result)))) + (process-examples)))) + +(defun parse-examples () + (when (string/= "EXAMPLES:" (next)) (fire-error (format nil "Expected EXAMPLES: instead of: ~A" (prev-line)))) + (expect-blank-line) + (list :examples (process-examples))) + +; For formatting of things like types in there +(defun handle-text (text) + (labels + ((inject-keywords (text remaining-keywords) + (if + (not remaining-keywords) + (list text) + (apply #'append + (mapcar + (lambda + (text-item) + (cond + ((not (stringp text-item)) (list text-item)) + ((not (cl-ppcre:scan (car remaining-keywords) text-item)) (list text-item)) + (t + (let + ((split-text (cl-ppcre:split (car remaining-keywords) text-item :limit 1000))) + (apply #'append + (list (car split-text)) + (mapcar (lambda (ti) (list (list :keyword (car remaining-keywords)) ti)) (cdr split-text))))))) + (inject-keywords text (cdr remaining-keywords))))))) + (list :text (inject-keywords text *keywords*)))) +; (map +; (list :text text)) + +(defun process-argument-and-values (args-to-be-explained) + (verify-next-line) + (cond + ((string= "" (peek)) + (when args-to-be-explained + (fire-error (format nil "Unexplained arguments left: ~A" args-to-be-explained)))) + ((not args-to-be-explained) (fire-error (format nil "No arguments left, but next line isn't empty: ~A" (peek)))) + (t + (labels + ((decompose-arg (arg-line) + (let + ((arg-scanner (cl-ppcre:create-scanner "^ ([^ :]+): (.+)$"))) + (when (not (cl-ppcre:scan arg-scanner arg-line)) + (fire-error (format nil "Argument line did not match \" TYPE: desc\": ~A" arg-line))) + (cl-ppcre:register-groups-bind (arg desc) (arg-scanner arg-line) + (list arg desc))))) + (let + ((decomposed (decompose-arg (next)))) + (when + (string/= (car args-to-be-explained) (car decomposed)) + (fire-error (format nil "Expected a description for ~A but got one for ~A" + (car args-to-be-explained) + (car decomposed)))) + (cons + (list + (car decomposed) + (handle-text (cadr decomposed))) + (process-argument-and-values (cdr args-to-be-explained)))))))) + +(defun parse-arguments-and-values (args-to-be-explained) + (when (string/= "ARGUMENTS AND VALUES:" (next)) + (fire-error (format nil "Expected ARGUMENTS AND VALUES: instead of: ~A" (prev-line)))) + (expect-blank-line) + (let + ((processed-args-and-values (process-argument-and-values (remove-duplicates args-to-be-explained :test #'string=)))) + (expect-blank-line) + (list :arguments-and-values processed-args-and-values))) + +(defun parse-header (func) + (verify-next-line) + (let* + ((func-name (symbol-name func)) + (scanner (cl-ppcre:create-scanner (format nil "~A(.*) => (.*)$" func-name)))) + (when (not (cl-ppcre:scan scanner (peek))) + (fire-error (format nil "First line of ~A did not match: ~A {ARGS}* => {RESULT}*, ~A" func func-name (peek)))) + (cl-ppcre:register-groups-bind (args result) (scanner (next)) + (when (cl-ppcre:scan "[a-z]" func-name) + (fire-error (format nil "Function name should be all uppercase: ~A" func-name))) + (let + ((ast-of-start + (list + func-name + (mapcar + (lambda (arg) + (cond + ((cdr (assoc arg '(("&optional" . :&optional) ("&key" . &key) ("&rest" . &rest)) :test #'string=))) + ((cl-ppcre:scan "[a-z]" arg) + (fire-error (format nil "Argument in ~A should be all upper case: ~S" func-name arg))) + (t arg))) + (cdr (cl-ppcre:split " " args))) + (mapcar + (lambda (arg) + (cond + ((cl-ppcre:scan "[a-z]" arg) + (fire-error (format nil "Result in ~A should be all upper case: ~A" func-name arg))) + (t arg))) + (cl-ppcre:split ", " result))))) + (add-keyword func-name) + (expect-blank-line) + (values + (cons :function ast-of-start) + (remove-if-not #'stringp (append (second ast-of-start) (third ast-of-start)))))))) + +(defun internal-doc->ast (func doc) + (let + ((*doc* (cl-ppcre:split "\\n" doc :limit 1000)) + (*prev-line* nil) + (*keywords* nil)) + (multiple-value-bind (header types) (parse-header func) + (mapcar #'add-keyword types) + (cons header + (multiple-value-bind (types args-to-be-defined) (parse-types types) + (mapcar #'add-keyword args-to-be-defined) + (append + (when types (list types)) + (list + (parse-arguments-and-values args-to-be-defined) + (parse-description)) + (when (more) (list (parse-examples))))))))) + +(defun doc->ast (func) (internal-doc->ast func (documentation func 'function))) + +(defun format-text (text) + (format nil "~{~A~}" + (mapcar + (lambda (text) + (cond + ((stringp text) text) + ((and (listp text) (eql :keyword (car text))) (format nil "_~(~A~)_" (cadr text))) + (t (fire-error (format nil "Don't know how to convert text: ~S" text))))) + (cadr text)))) + +(defun format-header (header) + (format nil "## Function **~A** + +#### Syntax: + +**~(~A~)** ~{_~(~A~)_ ~}=> ~{_~(~A~)_~^, ~} + +" + (second header) + (second header) + (third header) + (fourth header))) + +(defun format-types (types) + (flet + ((recompose-type (type) + (case (car type) + (:list (format nil "(~{~(~A~)~^ ~})" (mapcar #'cadr (cadr type)))) + (:or (format nil "~{~(~A~)~^ | ~}" (mapcar #'cadr (cadr type)))) + (:asterisk (format nil "~(~A~)*" (cadr (car (cadr type)))))))) + (if (not types) + "" + (format nil "~{~A~%~}~%" + (mapcar + (lambda (type) (format nil "```~(~A~)::= ~A``` " (car type) (recompose-type (cadr type)))) + (cadr types)))))) + +(defun format-args-and-values (args-and-values) + (format nil "#### Arguments and Values:~%~%~{~A~%~}~%" + (mapcar + (lambda (arg-value) (format nil "_~(~A~)_---~A " (car arg-value) (format-text (cadr arg-value)))) + (cadr args-and-values)))) + +(defun format-description (description) + (format nil "#### Description:~%~%~{~A~%~^~%~}" (mapcar #'format-text (cadr description)))) + +(defun format-examples (examples) + (if (not examples) + "" + (format nil "~%#### Examples:~%~%~{~A~%~}" + (mapcar + (lambda (example) (format nil "```~A``` => ```~A``` " (car example) (cadr example))) + (cadr examples))))) + +(defun ast->md (ast) + (flet + ((get-section (name) (find name ast :key #'car))) + (format nil "~A~A~A~A~A" + (format-header (get-section :function)) + (format-types (get-section :types)) + (format-args-and-values (get-section :arguments-and-values)) + (format-description (get-section :description)) + (format-examples (get-section :examples))))) diff --git a/src/main/package.lisp b/src/main/package.lisp index c45dd5c..2f58913 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,2 +1,5 @@ (defpackage #:docgen (:use :cl) - (:export #:validate-package #:export-package)) + (:export #:validate-package #:export-package #:validation-failure)) + +(defpackage #:docgen-func (:use :cl) + (:export #:doc->ast #:ast->md)) diff --git a/src/test/docgen-test.asd b/src/test/docgen-test.asd index ea788a5..4cbe4c7 100644 --- a/src/test/docgen-test.asd +++ b/src/test/docgen-test.asd @@ -1,7 +1,8 @@ ; For why this is the way it is, see src/main/style-checker.asd (asdf:defsystem docgen-test.internal :components ((:file "package") - (:file "main"))) + (:file "main") + (:file "failures"))) (asdf:defsystem docgen-test :name "Document Generator Tests" diff --git a/src/test/failures.lisp b/src/test/failures.lisp new file mode 100644 index 0000000..b264dbb --- /dev/null +++ b/src/test/failures.lisp @@ -0,0 +1,378 @@ +(in-package #:docgen-test) + +(let + ((long-line (format nil "~A~A" + "This second section uses PATH and X as something we should talk about, " + "but doesn't use all the arguments (let's include PATH here for fun)"))) + (deffailure-func-test + "Long line" + (format nil "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + ~A" + long-line) + (format nil "Longer than 120 chars: ~A" long-line))) + +(deffailure-func-test + "Blank line - after args and vals" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + RESULT: a pathname + +DESCRIPTION: + +" + "Expected blank line after: ARGUMENTS AND VALUES:") + +(deffailure-func-test + "Blank line - after description" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + Fail here + +" + "Expected blank line after: DESCRIPTION:") + +(deffailure-func-test + "Blank line - after examples" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + Fail here + +EXAMPLES: + Fail here + +" + "Expected blank line after: EXAMPLES:") + +(deffailure-func-test + "Blank line - after header" + "UNUSED => RESULT + Fail here +" + "Expected blank line after: UNUSED => RESULT") + +(deffailure-func-test + "Two spaces - beginning of types" + "UNUSED => RESULT + + RESULT: RESULT1 + RESULT1: NOT-HERE +" + "Type line did not match \" TYPE: type-definition\": RESULT1: NOT-HERE") + +(deffailure-func-test + "Two spaces - beginning of args and values" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: fail here +" + "Argument line did not match \" TYPE: desc\": RESULT: fail here") + +(deffailure-func-test + "Two spaces - in description" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a result + +DESCRIPTION: + + This is a description + + About some + things" + "Got unexpected line, requires blank lines or start with two spaces: \" things\"") + +(deffailure-func-test + "Two spaces - in examples" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a result + +DESCRIPTION: + + This is a description + +EXAMPLES: + + (example1) => (yo) + (example2) => (yoyo)" + "Example line does not match \" example => result\": (example2) => (yoyo)") + +(deffailure-func-test + "Two spaces - in examples" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a result + +DESCRIPTION: + + This is a description + +EXAMPLES: + + (example1) => (yo) + (example2) => (yoyo)" + "Example line does not match \" example => result\": (example2) => (yoyo)") + +(deffailure-func-test + "Bad type - lowercase symbol" + "UNUSED => REsULT + + RESULT: RESULT1 + +" + "Result in UNUSED should be all upper case: REsULT") + +(deffailure-func-test + "Bad type - or type with list" + "UNUSED => RESULT + + RESULT: RESULT1 | (RESULT2 :success) + +" + "Or types can't have lists in them: RESULT1 | (RESULT2 :success)") + +(deffailure-func-test + "Bad type - or type with no space before pipe" + "UNUSED => RESULT + + RESULT: RESULT1| RESULT2 + +" + "All or pipes must be prefaced by spaces: RESULT1| RESULT2") + +(deffailure-func-test + "Bad type - or type with no space after pipe" + "UNUSED => RESULT + + RESULT: RESULT1 |RESULT2 + +" + "All or pipes must be concluded by spaces: RESULT1 |RESULT2") + +(deffailure-func-test + "Bad type - list separated by multiple spaces" + "UNUSED => RESULT + + RESULT: (RESULT1 :success) + +" + "Lists can be seperated by only one space: (RESULT1 :success)") + +(deffailure-func-test + "Bad type - list parens in them" + "UNUSED => RESULT + + RESULT: (RESULT1 (:success)) + +" + "List types can't have sublists: (RESULT1 (:success))") + +(deffailure-func-test + "Bad type - type line doesn't have colon" + "UNUSED => RESULT + + RESULT - RESULT1 + +" + "Type line did not match \" TYPE: type-definition\": RESULT - RESULT1") + +(deffailure-func-test + "Bad type - malformed type line with colon" + "UNUSED => RESULT + + RESULT: RESULT1 RESULT2 + +" + "Symbols had spaces in it: RESULT1 RESULT2") + +(deffailure-func-test + "types in type section that isn't in document" + "UNUSED => RESULT + + RESULT: RESULT1 + RESULT2: RESULT3 + +" + "Ran out of types to talk about, but got a non empty line: RESULT2: RESULT3") + +(deffailure-func-test + "Description - ends with empty line when last thing" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + Hello world + +" + "Can't end with empty line") + +(deffailure-func-test + "Description - malformed line" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + A mistake" + "Got unexpected line, requires blank lines or start with two spaces: \" A mistake\"") + +(deffailure-func-test + "Description - section doesn't start with description" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTAION: + +" + "Expected DESCRIPTION: instead of: DESCRIPTAION:") + +(deffailure-func-test + "Examples - doesn't have arrow" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + This is a mock description. + +EXAMPLES: + + (unused) - :success +" + "Example line does not match \" example => result\": (unused) - :success") + +(deffailure-func-test + "Examples - doesn't start with EXAMPLES" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + This is a mock description. + +EXAAMPLES: + + (unused) => :success" + "Got unexpected line, requires blank lines or start with two spaces: \"EXAAMPLES:\"") + +(deffailure-func-test + "Args-and-values - leftover unexplained args" + "UNUSED => RESULT + + RESULT: RESULT1 | RESULT2 + +ARGUMENTS AND VALUES: + + RESULT1: a pathname +" + "Unexplained arguments left: (RESULT2)") + +(deffailure-func-test + "Args-and-values - doesn't match TYPE: desc" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT - a pathname + +DESCRIPTION: + +" + "Argument line did not match \" TYPE: desc\": RESULT - a pathname") + +(deffailure-func-test + "Args-and-values - section doesn't start with ARGUMENTS AND VALUES:" + "UNUSED => RESULT + + RESULT: RESULT1 + +ARGUUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + +" + "Expected ARGUMENTS AND VALUES: instead of: ARGUUMENTS AND VALUES:") + +(deffailure-func-test + "Header - first line doesn't start with func-name (naturally all in upper case)" + "UNUUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + +" + "First line of UNUSED did not match: UNUSED {ARGS}* => {RESULT}*, UNUUSED => RESULT") + +(deffailure-func-test + "Header - arguments weren't in upper cse" + "UNUSED x => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + +" + "Argument in UNUSED should be all upper case: \"x\"") + +(deffailure-func-test + "Header - results weren't in upper case" + "UNUSED => REsULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + +" + "Result in UNUSED should be all upper case: REsULT") diff --git a/src/test/main.lisp b/src/test/main.lisp index 0858ada..3cfb79e 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -1,3 +1,51 @@ (in-package #:docgen-test) -(defun run-all-tests () t) +(defvar *tests* nil) + +; This really is just here to check against regressions +(defun run-all-tests () + (let + ((results (mapcar #'funcall (reverse *tests*)))) + (every #'identity results))) + +(defun slurp-file (filename &key (element-type 'character) (sequence-type 'string)) + (with-open-file (str filename :element-type element-type) + (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq))) + +(defmacro deftest (name f) + `(push + (lambda () + (let + ((success (funcall ,f))) + (if success + (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc) + (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc)) + success)) + *tests*)) + +(defmacro defsuccesstest (pkg source target) + `(deftest + ,source + (lambda () + (load ,source) + (ignore-errors (string= (slurp-file ,target) (docgen:export-package ,pkg)))))) + +(defmacro deffailure-func-test (name doc expected) + `(deftest + ,name + (lambda () + (handler-case + (progn + (funcall + (symbol-function (find-symbol "INTERNAL-DOC->AST" :docgen-func)) + 'unused + ,doc) + nil) + (docgen:validation-failure (vf) + (let + ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf))) + (or + (string= ,expected result) + (format t " Got error:~%~S~% but expected~%~S~%" result ,expected)))))))) + +(defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md") diff --git a/wiki b/wiki new file mode 160000 index 0000000..ffe2711 --- /dev/null +++ b/wiki @@ -0,0 +1 @@ +Subproject commit ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b