1 (in-package #:docgen-var)
5 (defun peek () (car *doc*))
6 (defun next () (setf *prev-line* (pop *doc*)))
7 (defun more () (not (not *doc*)))
8 (defun prev-line () *prev-line*)
12 (defun add-keyword (type)
13 (setf *keywords* (remove-duplicates (cons type *keywords*) :test #'string=)))
15 (defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg)))
17 (defun expect-blank-line ()
20 (when (string/= "" (next)) (fire-error (format nil "Expected blank line after: ~A" prev)))))
22 (defun verify-next-line (&key optional)
24 ((and optional (not (more))) t)
25 ((not (more)) (fire-error (format nil "Expected line after: ~A" (prev-line))))
26 ((cl-ppcre:scan " $" (peek)) (fire-error (format nil "Can't end line with a space: ~A" (peek))))
27 ((< 120 (length (peek))) (fire-error (format nil "Longer than 120 chars: ~A" (peek))))))
29 (defun freeform->paragraphs (next next-optional)
30 (verify-next-line :optional t)
34 ((and next-optional (not next-line)) (list ""))
35 ((and (string= "" next-line) (not (more))) (fire-error "Can't end with empty line"))
36 ((cl-ppcre:scan "^ [^ ]+" next-line)
38 ((rest-of-freeform (freeform->paragraphs next next-optional)))
41 (subseq next-line 2 (length next-line))
42 (if (and (car rest-of-freeform) (string/= "" (car rest-of-freeform))) " " "")
43 (car rest-of-freeform))
44 (cdr rest-of-freeform))))
45 ((string= "" next-line)
46 (if (string= next (peek))
48 (cons "" (freeform->paragraphs next next-optional))))
49 (t (fire-error (format nil "Got unexpected line, requires blank lines or start with two spaces: ~S" next-line))))))
51 (defun parse-freeform (start section next next-optional)
52 (when (string/= start (next)) (fire-error (format nil "Expected ~A instead of: ~A" start (prev-line))))
55 ((paragraphs (freeform->paragraphs next next-optional)))
56 (list section (mapcar #'handle-text paragraphs))))
58 (defun process-examples ()
60 (verify-next-line :optional t)
63 ((example-scanner (cl-ppcre:create-scanner "^ ([^ ].+) => (.+)$"))
65 (if (not (cl-ppcre:scan example-scanner next-line))
66 (fire-error (format nil "Example line does not match \" example => result\": ~A" next-line))
67 (cl-ppcre:register-groups-bind (example result) (example-scanner next-line)
68 (list example result))))
71 (defun parse-examples ()
72 (when (string/= "EXAMPLES:" (next)) (fire-error (format nil "Expected EXAMPLES: instead of: ~A" (prev-line))))
74 (list :examples (process-examples)))
76 ; For formatting of things like types in there
77 (defun handle-text (text)
79 ((inject-keywords (text remaining-keywords)
81 (not remaining-keywords)
88 ((not (stringp text-item)) (list text-item))
89 ((not (cl-ppcre:scan (cl-ppcre:quote-meta-chars (car remaining-keywords)) text-item)) (list text-item))
92 ((split-text (cl-ppcre:split (cl-ppcre:quote-meta-chars (car remaining-keywords)) text-item :limit 1000)))
94 (list (car split-text))
95 (mapcar (lambda (ti) (list (list :keyword (car remaining-keywords)) ti)) (cdr split-text)))))))
96 (inject-keywords text (cdr remaining-keywords)))))))
97 (list :text (inject-keywords text *keywords*))))
101 (defun parse-header (var)
104 ((var-name (symbol-name var)))
105 (when (not (string= var-name (peek)))
106 (fire-error (format nil "First line of ~A did not match: ~A, ~A" var var-name (peek))))
107 (when (cl-ppcre:scan "[a-z]" var-name)
108 (fire-error (format nil "Variable name should be all uppercase: ~A" var-name)))
109 (add-keyword var-name)
112 (list :variable var-name)))
114 (defun internal-doc->ast (var doc)
116 ((*doc* (cl-ppcre:split "\\n" doc :limit 1000))
119 (cons (parse-header var)
122 (parse-freeform "VALUE TYPE:" :value-type "INITIAL VALUE:" nil)
123 (parse-freeform "INITIAL VALUE:" :initial-value "DESCRIPTION:" nil)
124 (parse-freeform "DESCRIPTION:" :description "EXAMPLES:" t))
125 (when (more) (list (parse-examples)))))))
127 (defun doc->ast (var) (internal-doc->ast var (documentation var 'variable)))
129 (defun format-text (text)
134 ((stringp text) text)
135 ((and (listp text) (eql :keyword (car text))) (format nil "_~(~A~)_" (cadr text)))
136 (t (fire-error (format nil "Don't know how to convert text: ~S" text)))))
139 (defun format-header (header)
140 (format nil "## Variable ~A
143 (cl-ppcre:quote-meta-chars (second header))))
145 (defun format-freeform (heading text)
146 (format nil "#### ~A:~%~%~{~A~%~^~%~}" heading (mapcar #'format-text (cadr text))))
148 (defun format-examples (examples)
151 (format nil "~%#### Examples:~%~%~{~A~%~}"
153 (lambda (example) (format nil "```~A``` => ```~A``` " (car example) (cadr example)))
158 ((get-section (name) (find name ast :key #'car)))
159 (format nil "~A~A~%~A~%~A~A"
160 (format-header (get-section :variable))
161 (format-freeform "Value Type" (get-section :value-type))
162 (format-freeform "Initial Value" (get-section :initial-value))
163 (format-freeform "Description" (get-section :description))
164 (format-examples (get-section :examples)))))
166 (defun ast->category-name (ast)
167 (declare (ignore ast))
170 (defun ast->short-name (ast)
171 (format nil "~(~A~)" (cl-ppcre:quote-meta-chars (second (find :variable ast :key #'car)))))
173 (defun ast->link (ast)
174 (format nil "variable-~(~A~)" (cl-ppcre:regex-replace-all "\\*" (second (find :variable ast :key #'car)) "")))
176 (defun ast->short-desc (ast)
177 (format-text (car (cadr (find :description ast :key #'car)))))