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  (:documentation "Used internally for docgen parts to signal a validation error."))
   5
   6 (defun get-symb-type (symb)
   7  (cond
   8   ((documentation symb 'variable) :variable)
   9   ((documentation symb 'structure) :structure)
  10   ((documentation symb 'function) :function)))
  11
  12 (defun validate-package (pkg)
  13  "VALIDATE-PACKAGE PKG => FAILURES
  14
  15   FAILURES: FAILURE*
  16   FAILURE: (:failure SYMB MSG)
  17
  18 ARGUMENTS AND VALUES:
  19
  20   PKG: A package symbol
  21   SYMB: Symbol the check failed on
  22   MSG: Message containing information about the failure
  23
  24 DESCRIPTION:
  25
  26   VALIDATE-PACKAGE takes in PKG and validates that all the external symbols
  27   adhere to documentation guidelines, exist, and can be parsed to be used
  28   for exporting.
  29
  30   Only one error per symbol will be reported at a time, all concatenated to
  31   a list in the aforementioned form."
  32  (macrolet
  33   ((with-success-check (symb &rest f)
  34     `(handler-case
  35       (progn ,@f :success)
  36       (validation-failure (v) (list :failure ,symb (validation-failure-msg v))))))
  37   (let
  38    ((symbs nil))
  39    (do-external-symbols (symb pkg) (push symb symbs))
  40    (setf symbs (sort symbs #'string< :key #'symbol-name))
  41    (remove :success
  42     (append
  43      (list (with-success-check pkg (docgen-pkg:doc->ast (find-package pkg))))
  44      (mapcar
  45       (lambda (symb)
  46        (with-success-check symb
  47         (case (get-symb-type symb)
  48          (:function (docgen-func:doc->ast symb))
  49          (:structure (docgen-struc:doc->ast symb))
  50          (:variable (docgen-var:doc->ast symb))
  51          (t (error (make-condition 'validation-failure :msg (format nil "Symbol ~A has no documentation" symb)))))))
  52       symbs))))))
  53
  54 (defun pretty-print-validate-packages (&rest pkgs)
  55  "PRETTY-PRINT-VALIDATE-PACKAGES &rest PKGS => SUCCESS
  56
  57   PKGS: PKG*
  58
  59 ARGUMENTS AND VALUES:
  60
  61   SUCCESS: Whether or not all symbols passed validation
  62   PKG: A package symbol
  63
  64 DESCRIPTION:
  65
  66   PRETTY-PRINT-VALIDATE-PACKAGES takes PKGS and runs validation on all of them.
  67   It dumps to standard out failures as it comes upon them, finally returning
  68   whether it was successful or not.
  69
  70   This can be used in travis tests to ensure that documentation can be generated
  71   at a later date.
  72
  73 EXAMPLES:
  74
  75   (pretty-print-validate-packages :pkg1 :pkg2) => t"
  76  (every
  77   #'identity
  78   (mapcar
  79    (lambda (pkg)
  80     (let
  81      ((failures (validate-package pkg)))
  82      (mapcar
  83       (lambda (failure)
  84        (format t "In ~A : ~A, documentation error found:~%  ~A~%" pkg (second failure) (third failure)))
  85       failures)
  86      (not failures)))
  87    pkgs)))
  88
  89 (defun table-of-contents (pkg)
  90  (format nil "## Contents~%~%~{~{* **~A [~A](#~A)** - ~A~}~%~}"
  91   (let
  92    ((symbs nil))
  93    (do-external-symbols (symb pkg) (push symb symbs))
  94    (setf symbs (sort symbs #'string< :key #'symbol-name))
  95    (mapcar
  96     (lambda (symb)
  97      (case (get-symb-type symb)
  98       (:function
  99        (list
 100         (docgen-func:ast->category-name (docgen-func:doc->ast symb))
 101         (docgen-func:ast->short-name (docgen-func:doc->ast symb))
 102         (docgen-func:ast->link (docgen-func:doc->ast symb))
 103         (docgen-func:ast->short-desc (docgen-func:doc->ast symb))))
 104       (:structure
 105        (list
 106         (docgen-struc:ast->category-name (docgen-struc:doc->ast symb))
 107         (docgen-struc:ast->short-name (docgen-struc:doc->ast symb))
 108         (docgen-struc:ast->link (docgen-struc:doc->ast symb))
 109         (docgen-struc:ast->short-desc (docgen-struc:doc->ast symb))))
 110       (:variable
 111        (list
 112         (docgen-var:ast->category-name (docgen-var:doc->ast symb))
 113         (docgen-var:ast->short-name (docgen-var:doc->ast symb))
 114         (docgen-var:ast->link (docgen-var:doc->ast symb))
 115         (docgen-var:ast->short-desc (docgen-var:doc->ast symb))))))
 116     symbs))))
 117
 118 (defun export-package (pkg)
 119  "EXPORT-PACKAGE PKG => MARKDOWN
 120
 121 ARGUMENTS AND VALUES:
 122
 123   PKG: A package symbol
 124   MARKDOWN: A string containing the markdown representation of this packages documentation
 125
 126 DESCRIPTION:
 127
 128   EXPORT-PACKAGE takes in PKG and converts all the documentation for the symbols
 129   into markdown with the hope of emulating the hyperspec style.
 130
 131   It should only be run after the package has been validated, as it assumes that
 132   all documentation it gets will be valid."
 133  (let
 134   ((symbs nil))
 135   (do-external-symbols (symb pkg) (push symb symbs))
 136   (setf symbs (sort symbs #'string< :key #'symbol-name))
 137   (with-output-to-string (str)
 138    (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))
 139    (format str "~A~%" (table-of-contents pkg))
 140    (format str "~{~A~^~%~}"
 141     (mapcar
 142      (lambda (symb)
 143       (case (get-symb-type symb)
 144        (:variable (docgen-var:ast->md (docgen-var:doc->ast symb)))
 145        (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))
 146        (:structure (docgen-struc:ast->md (docgen-struc:doc->ast symb)))))
 147      symbs)))))