Amr Gharbeia
5a0d1b1c38
- vault: add vault-get-secret/vault-set-secret wrappers - programming-org: implement org-modify (text search-replace) and org-ast-render (AST to Org text) - programming-literate: implement literate-block-balance-check (paren validation) and literate-tangle-sync-check (org→lisp diff) - system-self-improve: replace stubs with surgical text editing and error diagnosis; remove dead first defskill - system-event-orchestrator: implement orchestrator-bootstrap (scan Org files for HOOK/CRON) - system-archivist: implement Scribe distillation (daily logs→atomic notes) and Gardener link/orphan repair - system-memory: implement memory-inspect with type/todo/orphan statistics - core-skills, core-context: fix path relic (skills/ → lisp/, org/) - docs: add Token Economics section to DESIGN_DECISIONS, remediation roadmap entries
65 lines
2.8 KiB
Common Lisp
65 lines
2.8 KiB
Common Lisp
(defun literate-extract-lisp-blocks (content)
|
|
"Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
|
|
Returns a list of block strings."
|
|
(let ((lines (uiop:split-string content :separator '(#\Newline)))
|
|
(blocks nil)
|
|
(in-block nil)
|
|
(current-block nil))
|
|
(dolist (line lines)
|
|
(let ((trimmed (string-trim '(#\Space) line)))
|
|
(cond
|
|
((uiop:string-prefix-p "#+begin_src lisp" trimmed)
|
|
(setf in-block t current-block nil))
|
|
((uiop:string-prefix-p "#+end_src" trimmed)
|
|
(when in-block
|
|
(push (format nil "~{~a~^~%~}" (nreverse current-block)) blocks)
|
|
(setf in-block nil current-block nil)))
|
|
(in-block
|
|
(push line current-block)))))
|
|
(nreverse blocks)))
|
|
|
|
(defun literate-block-balance-check (org-file)
|
|
"Verifies that all Lisp source blocks in an Org file have balanced parentheses.
|
|
Returns T if all blocks pass validation, or an error string listing failures."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-block-balance-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(let* ((content (uiop:read-file-string org-file))
|
|
(blocks (literate-extract-lisp-blocks content))
|
|
(failures nil))
|
|
(if (null blocks)
|
|
t
|
|
(progn
|
|
(loop for i from 0
|
|
for block in blocks
|
|
for (ok reason) = (multiple-value-list
|
|
(lisp-structural-check block))
|
|
unless ok
|
|
do (push (format nil "Block ~d: ~a" (1+ i) reason) failures))
|
|
(if failures
|
|
(format nil "Unbalanced blocks in ~a:~%~{~a~^~%~}" org-file failures)
|
|
t)))))
|
|
|
|
(defun literate-tangle-sync-check (org-file lisp-file)
|
|
"Verifies that the .lisp file matches the tangled output of the .org file.
|
|
Compares the concatenation of all lisp blocks from the Org file against the
|
|
contents of the Lisp file. Returns T if they match, or an error message."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(when (not (uiop:file-exists-p lisp-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Lisp file not found: ~a" lisp-file)))
|
|
(let* ((org-content (uiop:read-file-string org-file))
|
|
(org-blocks (literate-extract-lisp-blocks org-content))
|
|
(tangled (format nil "~{~a~^~%~%~}" org-blocks))
|
|
(lisp-content (uiop:read-file-string lisp-file)))
|
|
(if (string= (string-trim '(#\Space #\Newline) tangled)
|
|
(string-trim '(#\Space #\Newline) lisp-content))
|
|
t
|
|
(format nil "Tangle sync mismatch: ~a does not match ~a" org-file lisp-file))))
|
|
|
|
(defskill :passepartout-programming-literate
|
|
:priority 300
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|