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

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