Add holistic checking

[sheep] / src / main / docgen.lisp

diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp
index bb1b7a9af5db6b5eeec33ac7e22971eb7c06a22c..48d237121c5d62c2fa8bd0f939d93de3fff09850 100644 (file)
--- a/src/main/docgen.lisp
+++ b/src/main/docgen.lisp
@@ -2,23 +2,45 @@
 
 (define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg)))
 
+(defun get-symb-type (symb)
+ (cond
+  ;((documentation symb 'variable) :variable)
+  ;((documentation symb 'structure) :structure)
+  ((documentation symb 'function) :function)))
+
 (defun validate-package (pkg)
  (macrolet
   ((with-success-check (&rest f)
     `(handler-case
       (progn ,@f :success)
-      (validation-failure (v) (list :failure :msg (validation-failure-msg v))))))
+      (validation-failure (v) (list :failure (validation-failure-msg v))))))
   (let
    ((symbs nil))
    (do-external-symbols (symb pkg) (push symb symbs))
    (setf symbs (sort symbs #'string< :key #'symbol-name))
    (remove :success
     (append
-     (list (with-success-check (docgen-pkg:doc->ast pkg)))
+     (list (with-success-check (docgen-pkg:doc->ast (find-package pkg))))
      (mapcar
-      (lambda (symb) (with-success-check (docgen-func:doc->ast symb)))
+      (lambda (symb)
+       (with-success-check
+        (case (get-symb-type symb)
+         (:function (docgen-func:doc->ast symb))
+         (t (error (make-condition 'validation-failure :msg (format nil "Symbol ~A has no documentation" symb)))))))
       symbs))))))
 
+(defun pretty-print-validate-packages (&rest pkgs)
+ (mapcar
+  (lambda (pkg)
+   (let
+    ((failures (validate-package pkg)))
+    (mapcar
+     (lambda (failure)
+      (format t "In package ~A, documentation error found:~%  ~A" pkg (cadr failure)))
+     failures)
+    (not failures)))
+  pkgs))
+
 (defun export-package (pkg)
  (let
   ((symbs nil))
@@ -26,4 +48,9 @@
   (setf symbs (sort symbs #'string< :key #'symbol-name))
   (with-output-to-string (str)
    (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))
-   (format str "~{~A~^~%~}" (mapcar (lambda (symb) (docgen-func:ast->md (docgen-func:doc->ast symb))) symbs)))))
+   (format str "~{~A~^~%~}"
+    (mapcar
+     (lambda (symb)
+      (case (get-symb-type symb)
+       (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))))
+     symbs)))))