Add function documentation checker/converter

diff --git a/.gitmodules b/.gitmodules
new file mode 100644 (file)
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 (executable)
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 (file)
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 (file)
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 569706454de51849c90b8edb2bfbaf6afa77d9eb..eebdbe70e7ea08d8d814daa29fdbac3f0c956081 100644 (file)
--- 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
 ; 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"
 
 (asdf:defsystem docgen
  :name "Documentation Generator"

diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp
index 7142dfe4f6d6d65444fdacedb4c2ac57fd966675..2ed740bdd66a51892a3afe9556c52c4ce55a1530 100644 (file)
--- a/src/main/docgen.lisp
+++ b/src/main/docgen.lisp
@@ -1,5 +1,25 @@
 (in-package #:docgen)
 
 (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 (file)
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 c45dd5cd186ade97fae074702cd7cbae84b93808..2f5891395ca7ca5bd9b2bf3245ff44354bf94186 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,2 +1,5 @@
 (defpackage #:docgen (:use :cl)
 (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 ea788a54058b3cd4736a7ae6e3ad9295691d2e73..4cbe4c7e5c8cbbadd56858cbd15ad5a05f2536c3 100644 (file)
--- 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")
 ; 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"
 
 (asdf:defsystem docgen-test
   :name "Document Generator Tests"

diff --git a/src/test/failures.lisp b/src/test/failures.lisp
new file mode 100644 (file)
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 0858ada87e2a5a4cc27d1679b101d0e29f38af8a..3cfb79e163d535176a4b2d3e197f766fd83304ab 100644 (file)
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -1,3 +1,51 @@
 (in-package #:docgen-test)
 
 (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 (submodule)
index 0000000..ffe2711
--- /dev/null
+++ b/wiki
@@ -0,0 +1 @@
+Subproject commit ffe2711a19e5a213cfdf7b52e7ad7b4b25316a2b