--- /dev/null
+[submodule "wiki"]
+ path = wiki
+ url = https://github.com/frankduncan/docgen.wiki.git
--- /dev/null
+#!/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
--- /dev/null
+(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)
--- /dev/null
+## 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.
; 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"
(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))))
--- /dev/null
+(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)))))
(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))
; 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"
--- /dev/null
+(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")
(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")
--- /dev/null
+Subproject commit ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b
projects / sheep / commitdiff