X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=sheep;a=blobdiff_plain;f=src%2Fmain%2Fdocgen.lisp;h=48d237121c5d62c2fa8bd0f939d93de3fff09850;hp=bb1b7a9af5db6b5eeec33ac7e22971eb7c06a22c;hb=2a64bd9;hpb=683928f90e320bed84a816e8b59521b1c6714991 diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp index bb1b7a9..48d2371 100644 --- 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)))))