1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3. See distributed LICENSE.txt.
2 (in-package #:sheep-var)
6 (defun peek () (car *doc*))
7 (defun next () (setf *prev-line* (pop *doc*)))
8 (defun more () (not (not *doc*)))
9 (defun prev-line () *prev-line*)
13 (defun add-keyword (type)
14 (setf *keywords* (remove-duplicates (cons type *keywords*) :test #'string=)))
16 (defun fire-error (msg) (error (make-instance 'sheep:validation-failure :msg msg)))
18 (defun expect-blank-line ()
21 (when (string/= "" (next)) (fire-error (format nil "Expected blank line after: ~A" prev)))))
23 (defun verify-next-line (&key optional)
25 ((and optional (not (more))) t)
26 ((not (more)) (fire-error (format nil "Expected line after: ~A" (prev-line))))
27 ((cl-ppcre:scan " $" (peek)) (fire-error (format nil "Can't end line with a space: ~A" (peek))))
28 ((< 120 (length (peek))) (fire-error (format nil "Longer than 120 chars: ~A" (peek))))))
30 (defun freeform->paragraphs (next next-optional)
31 (verify-next-line :optional t)
35 ((and next-optional (not next-line)) (list ""))
36 ((and (string= "" next-line) (not (more))) (fire-error "Can't end with empty line"))
37 ((cl-ppcre:scan "^ [^ ]+" next-line)
39 ((rest-of-freeform (freeform->paragraphs next next-optional)))
42 (subseq next-line 2 (length next-line))
43 (if (and (car rest-of-freeform) (string/= "" (car rest-of-freeform))) " " "")
44 (car rest-of-freeform))
45 (cdr rest-of-freeform))))
46 ((string= "" next-line)
47 (if (string= next (peek))
49 (cons "" (freeform->paragraphs next next-optional))))
50 (t (fire-error (format nil "Got unexpected line, requires blank lines or start with two spaces: ~S" next-line))))))
52 (defun parse-freeform (start section next next-optional)
53 (when (string/= start (next)) (fire-error (format nil "Expected ~A instead of: ~A" start (prev-line))))
56 ((paragraphs (freeform->paragraphs next next-optional)))
57 (list section (mapcar #'handle-text paragraphs))))
59 (defun process-examples ()
61 (verify-next-line :optional t)
64 ((example-scanner (cl-ppcre:create-scanner "^ ([^ ].+) => (.+)$"))
66 (if (not (cl-ppcre:scan example-scanner next-line))
67 (fire-error (format nil "Example line does not match \" example => result\": ~A" next-line))
68 (cl-ppcre:register-groups-bind (example result) (example-scanner next-line)
69 (list example result))))
72 (defun parse-examples ()
73 (when (string/= "EXAMPLES:" (next)) (fire-error (format nil "Expected EXAMPLES: instead of: ~A" (prev-line))))
75 (list :examples (process-examples)))
77 ; For formatting of things like types in there
78 (defun handle-text (text)
80 ((inject-keywords (text remaining-keywords)
82 (not remaining-keywords)
89 ((not (stringp text-item)) (list text-item))
90 ((not (cl-ppcre:scan (cl-ppcre:quote-meta-chars (car remaining-keywords)) text-item)) (list text-item))
93 ((split-text (cl-ppcre:split (cl-ppcre:quote-meta-chars (car remaining-keywords)) text-item :limit 1000)))
95 (list (car split-text))
96 (mapcar (lambda (ti) (list (list :keyword (car remaining-keywords)) ti)) (cdr split-text)))))))
97 (inject-keywords text (cdr remaining-keywords)))))))
98 (list :text (inject-keywords text *keywords*))))
102 (defun parse-header (var)
105 ((var-name (symbol-name var)))
106 (when (not (string= var-name (peek)))
107 (fire-error (format nil "First line of ~A did not match: ~A, ~A" var var-name (peek))))
108 (when (cl-ppcre:scan "[a-z]" var-name)
109 (fire-error (format nil "Variable name should be all uppercase: ~A" var-name)))
110 (add-keyword var-name)
113 (list :variable var-name)))
115 (defun internal-doc->ast (var doc)
117 ((*doc* (cl-ppcre:split "\\n" doc :limit 1000))
120 (cons (parse-header var)
123 (parse-freeform "VALUE TYPE:" :value-type "INITIAL VALUE:" nil)
124 (parse-freeform "INITIAL VALUE:" :initial-value "DESCRIPTION:" nil)
125 (parse-freeform "DESCRIPTION:" :description "EXAMPLES:" t))
126 (when (more) (list (parse-examples)))))))
128 (defun doc->ast (var) (internal-doc->ast var (documentation var 'variable)))
130 (defun format-text (text)
135 ((stringp text) text)
136 ((and (listp text) (eql :keyword (car text))) (format nil "_~(~A~)_" (cadr text)))
137 (t (fire-error (format nil "Don't know how to convert text: ~S" text)))))
140 (defun format-header (header)
141 (format nil "## Variable ~A
144 (cl-ppcre:quote-meta-chars (second header))))
146 (defun format-freeform (heading text)
147 (format nil "#### ~A:~%~%~{~A~%~^~%~}" heading (mapcar #'format-text (cadr text))))
149 (defun format-examples (examples)
152 (format nil "~%#### Examples:~%~%~{~A~%~}"
154 (lambda (example) (format nil "```~A``` => ```~A``` " (car example) (cadr example)))
159 ((get-section (name) (find name ast :key #'car)))
160 (format nil "~A~A~%~A~%~A~A"
161 (format-header (get-section :variable))
162 (format-freeform "Value Type" (get-section :value-type))
163 (format-freeform "Initial Value" (get-section :initial-value))
164 (format-freeform "Description" (get-section :description))
165 (format-examples (get-section :examples)))))
167 (defun ast->category-name (ast)
168 (declare (ignore ast))
171 (defun ast->short-name (ast)
172 (format nil "~(~A~)" (cl-ppcre:quote-meta-chars (second (find :variable ast :key #'car)))))
174 (defun ast->link (ast)
175 (format nil "variable-~(~A~)" (cl-ppcre:regex-replace-all "\\*" (second (find :variable ast :key #'car)) "")))
177 (defun ast->short-desc (ast)
178 (format-text (car (cadr (find :description ast :key #'car)))))