code.consxy.com Git - sheep/blob - src/main/docgen.lisp

   1 (in-package #:docgen)
   2
   3 (define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg)))
   4
   5 (defun get-symb-type (symb)
   6  (cond
   7   ;((documentation symb 'variable) :variable)
   8   ((documentation symb 'structure) :structure)
   9   ((documentation symb 'function) :function)))
  10
  11 (defun validate-package (pkg)
  12  (macrolet
  13   ((with-success-check (&rest f)
  14     `(handler-case
  15       (progn ,@f :success)
  16       (validation-failure (v) (list :failure (validation-failure-msg v))))))
  17   (let
  18    ((symbs nil))
  19    (do-external-symbols (symb pkg) (push symb symbs))
  20    (setf symbs (sort symbs #'string< :key #'symbol-name))
  21    (remove :success
  22     (append
  23      (list (with-success-check (docgen-pkg:doc->ast (find-package pkg))))
  24      (mapcar
  25       (lambda (symb)
  26        (with-success-check
  27         (case (get-symb-type symb)
  28          (:function (docgen-func:doc->ast symb))
  29          (:structure (docgen-struc:doc->ast symb))
  30          (t (error (make-condition 'validation-failure :msg (format nil "Symbol ~A has no documentation" symb)))))))
  31       symbs))))))
  32
  33 (defun pretty-print-validate-packages (&rest pkgs)
  34  (mapcar
  35   (lambda (pkg)
  36    (let
  37     ((failures (validate-package pkg)))
  38     (mapcar
  39      (lambda (failure)
  40       (format t "In package ~A, documentation error found:~%  ~A" pkg (cadr failure)))
  41      failures)
  42     (not failures)))
  43   pkgs))
  44
  45 (defun export-package (pkg)
  46  (let
  47   ((symbs nil))
  48   (do-external-symbols (symb pkg) (push symb symbs))
  49   (setf symbs (sort symbs #'string< :key #'symbol-name))
  50   (with-output-to-string (str)
  51    (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))
  52    (format str "~{~A~^~%~}"
  53     (mapcar
  54      (lambda (symb)
  55       (format t "HAHAHAH ~A ~A~%" symb (get-symb-type symb))
  56       (case (get-symb-type symb)
  57        (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))
  58        (:structure (docgen-struc:ast->md (docgen-struc:doc->ast symb)))))
  59      symbs)))))