passepartout: v0.5.0 File Reorganization
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Extract non-core fragments using self-repair criterion:
- core-context -> symbolic-awareness (224 lines, fboundp guards in think())
- heartbeat generation -> symbolic-events (renamed events-start-heartbeat)
Rename 23 files for clarity and new naming scheme:
- 6 core: core-package, core-transport, core-pipeline,
core-perceive, core-reason, core-act
- 13 system: symbolic-*, neuro-*, embedding-*, channel-shell
- 4 gateway: channel-cli, channel-tui-*, channel-tui-state
Utility relocations:
- markdown-strip -> programming-markdown
- plist-keywords-normalize -> programming-lisp
- cognitive-tool-prompt -> programming-tools
- VAULT-MEMORY -> security-vault
- Merge *backend-registry* into *probabilistic-backends*
Split gateway-messaging into channel-telegram/channel-signal/
channel-discord/channel-slack (4 independent skills)
Delete dead system-model.lisp (16-line wrapper)
Document self-repair criterion in DESIGN_DECISIONS
Version bump: 0.4.3 -> 0.5.0
This commit is contained in:
381
org/symbolic-archivist.org
Normal file
381
org/symbolic-archivist.org
Normal file
@@ -0,0 +1,381 @@
|
||||
#+TITLE: SKILL: Archivist (org-skill-archivist.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:archivist:scribe:gardener:
|
||||
#+PROPERTY: header-args:lisp :tangle ../lisp/symbolic-archivist.lisp
|
||||
|
||||
* Overview
|
||||
|
||||
The *Archivist* combines the former Scribe and Gardener skills into a unified
|
||||
maintenance subsystem. It runs as a background skill triggered by heartbeat
|
||||
events, performing two core functions:
|
||||
|
||||
- Scribe: Distills daily chronological logs into structured atomic notes with
|
||||
backlinks, maintaining the Zettelkasten knowledge base.
|
||||
- Gardener: Scans the Memex for structural issues — broken =[[file:...]]= links
|
||||
and orphaned =memory-object= entries — flagging them for human review.
|
||||
|
||||
** Contract
|
||||
|
||||
1. (archivist-extract-headlines content): parses Org content into a
|
||||
list of headline structures, each with ~:title~, ~:body~, ~:tags~.
|
||||
2. (archivist-headline-to-filename title): sanitizes a headline title
|
||||
into a valid filename — lowercased, special chars replaced.
|
||||
3. (archivist-create-note headline notes-dir source): writes a
|
||||
Zettelkasten note to disk with frontmatter and backlinks.
|
||||
4. (archivist-scribe-distill): heartbeat-driven — reads recent log
|
||||
entries from ~*history-store*~ and creates structured notes.
|
||||
5. (archivist-gardener-scan): heartbeat-driven — scans for broken
|
||||
file links and orphaned memory objects.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
#+end_src
|
||||
|
||||
** Archivist State
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *archivist-last-scribe* 0
|
||||
"Universal time of the last Scribe distillation run.")
|
||||
|
||||
#+end_src
|
||||
** *archivist-last-gardener*
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *archivist-last-gardener* 0
|
||||
"Universal time of the last Gardener scan run.")
|
||||
|
||||
#+end_src
|
||||
** *archivist-gardener-interval*
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *archivist-gardener-interval* 86400
|
||||
"Seconds between Gardener scans. Default: 24 hours.")
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
** Scribe: Knowledge Distillation
|
||||
|
||||
Reads daily log files from the Memex ~daily/= directory, extracts headlines
|
||||
and conceptual content, and creates atomic notes in ~notes/= with source
|
||||
backlinks. Tracks processed state via timestamp to avoid re-processing.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-scribe-distill ()
|
||||
"Distills daily log entries into atomic notes. Reads the Memex daily/
|
||||
directory for log files modified since the last run, extracts headlines
|
||||
as potential note seeds, and creates atomic note files in notes/ with
|
||||
backlinks to the source daily entry."
|
||||
(let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(daily-dir (merge-pathnames "daily/" memex-dir))
|
||||
(notes-dir (merge-pathnames "notes/" memex-dir))
|
||||
(now (get-universal-time))
|
||||
(notes-created 0))
|
||||
(unless (uiop:directory-exists-p daily-dir)
|
||||
(log-message "ARCHIVIST: Daily directory not found: ~a" daily-dir)
|
||||
(return-from archivist-scribe-distill nil))
|
||||
(ensure-directories-exist notes-dir)
|
||||
(handler-case
|
||||
(let ((daily-files (uiop:directory-files daily-dir "*.org")))
|
||||
(dolist (file daily-files)
|
||||
(let* ((filepath (namestring file))
|
||||
(file-mtime (ignore-errors (file-write-date filepath))))
|
||||
(when (and file-mtime (> file-mtime *archivist-last-scribe*))
|
||||
;; Extract headlines from daily log
|
||||
(let* ((content (handler-case (uiop:read-file-string filepath)
|
||||
(error () nil)))
|
||||
(headlines (when content
|
||||
(archivist-extract-headlines content))))
|
||||
(dolist (hl headlines)
|
||||
(when (archivist-create-note hl notes-dir filepath)
|
||||
(incf notes-created))))))))
|
||||
(error (c)
|
||||
(log-message "ARCHIVIST: Scribe error: ~a" c)))
|
||||
(setf *archivist-last-scribe* now)
|
||||
(when (> notes-created 0)
|
||||
(log-message "ARCHIVIST: Scribe created ~d atomic notes" notes-created))
|
||||
notes-created))
|
||||
|
||||
#+end_src
|
||||
** archivist-extract-headlines
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-extract-headlines (content)
|
||||
"Extracts first-level headlines and their content from Org text.
|
||||
Returns a list of plists: (:title <str> :content <str> :tags <list>)."
|
||||
(let ((lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(results nil)
|
||||
(current-title nil)
|
||||
(current-lines nil)
|
||||
(current-tags nil)
|
||||
(in-properties nil))
|
||||
(dolist (line lines)
|
||||
(let ((trimmed (string-trim '(#\Space) line)))
|
||||
(when (string= trimmed ":PROPERTIES:")
|
||||
(setf in-properties t))
|
||||
(when (string= trimmed ":END:")
|
||||
(setf in-properties nil))
|
||||
(when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed))
|
||||
(setf current-tags
|
||||
(mapcar (lambda (tag) (string-trim '(#\Space) tag))
|
||||
(uiop:split-string (string-trim '(#\Space) (subseq trimmed 6))
|
||||
:separator '(#\space #\tab)))))
|
||||
(cond
|
||||
;; First-level headline
|
||||
((and (uiop:string-prefix-p "* " trimmed)
|
||||
(not (uiop:string-prefix-p "**" trimmed)))
|
||||
;; Save previous
|
||||
(when current-title
|
||||
(push (list :title current-title
|
||||
:content (format nil "~{~a~^~%~}" (nreverse current-lines))
|
||||
:tags current-tags)
|
||||
results))
|
||||
(setf current-title (string-trim '(#\* #\Space) trimmed)
|
||||
current-lines nil
|
||||
current-tags nil
|
||||
in-properties nil))
|
||||
;; Content lines under current headline
|
||||
(current-title
|
||||
(unless (or (uiop:string-prefix-p "*" trimmed)
|
||||
(string= trimmed ":PROPERTIES:")
|
||||
(string= trimmed ":END:"))
|
||||
(push line current-lines))))))
|
||||
;; Save last headline
|
||||
(when current-title
|
||||
(push (list :title current-title
|
||||
:content (format nil "~{~a~^~%~}" (nreverse current-lines))
|
||||
:tags current-tags)
|
||||
results))
|
||||
(nreverse results)))
|
||||
|
||||
#+end_src
|
||||
** archivist-headline-to-filename
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-headline-to-filename (title)
|
||||
"Converts a headline title to a valid atomic note filename.
|
||||
Replaces spaces and special chars with underscores, downcases."
|
||||
(let* ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]" title ""))
|
||||
(underscored (cl-ppcre:regex-replace-all "\\s+" clean "_"))
|
||||
(lowered (string-downcase underscored)))
|
||||
(if (> (length lowered) 100)
|
||||
(subseq lowered 0 100)
|
||||
lowered)))
|
||||
|
||||
#+end_src
|
||||
** archivist-create-note
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-create-note (headline notes-dir source-filepath)
|
||||
"Creates an atomic note from a headline plist in the notes/ directory.
|
||||
Headline is a plist (:title <str> :content <str> :tags <list>).
|
||||
Returns T if note was created, nil if it already exists."
|
||||
(let* ((title (getf headline :title))
|
||||
(content (or (getf headline :content) ""))
|
||||
(tags (getf headline :tags))
|
||||
(filename (archivist-headline-to-filename title))
|
||||
(filepath (merge-pathnames (format nil "~a.org" filename) notes-dir))
|
||||
(source-basename (enough-namestring source-filepath
|
||||
(merge-pathnames "" notes-dir))))
|
||||
(when (uiop:file-exists-p filepath)
|
||||
(return-from archivist-create-note nil))
|
||||
(handler-case
|
||||
(progn
|
||||
(uiop:with-output-file (s filepath :if-exists nil)
|
||||
(format s "#+TITLE: ~a~%" title)
|
||||
(format s "#+FILETAGS: :atomic:note:~:[~;~{~a~^:~}~]~%" tags tags)
|
||||
(format s "~%* ~a~%" title)
|
||||
(format s ":PROPERTIES:~%")
|
||||
(format s ":CREATED: ~a~%" (org-id-generate))
|
||||
(format s ":SOURCE: ~a~%" source-basename)
|
||||
(format s ":END:~%")
|
||||
(format s "~%~a~%" content)
|
||||
(format s "~%* Backlinks~%")
|
||||
(format s "- Source: [[file:~a][~a]]~%" source-basename
|
||||
(file-namestring source-filepath)))
|
||||
(log-message "ARCHIVIST: Created note ~a" (namestring filepath))
|
||||
t)
|
||||
(error (c)
|
||||
(log-message "ARCHIVIST: Failed to create note ~a: ~a" filepath c)
|
||||
nil))))
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
** Gardener: Structural Maintenance
|
||||
|
||||
Scans the Memex for broken =[[file:...]]= links and orphaned =memory-object=
|
||||
entries. Flags issues with =:GARDENER:= tags for human review.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-gardener-scan ()
|
||||
"Scans the Memex for broken file links and orphaned memory objects.
|
||||
Broken links are =[[file:...]]= references whose target file does not exist.
|
||||
Orphaned objects are =memory-object= entries whose =:parent-id= references
|
||||
a deleted object. Returns a plist (:broken-links <count> :orphans <count>)."
|
||||
(let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
|
||||
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
|
||||
(org-files (archivist-find-org-files memex-dir))
|
||||
(broken-links 0)
|
||||
(orphans 0))
|
||||
;; Scan for broken links
|
||||
(dolist (file org-files)
|
||||
(handler-case
|
||||
(let* ((content (uiop:read-file-string file))
|
||||
(links (archivist-extract-file-links content)))
|
||||
(dolist (link links)
|
||||
(let ((target (merge-pathnames link (make-pathname :directory
|
||||
(pathname-directory file)))))
|
||||
(unless (uiop:file-exists-p target)
|
||||
(log-message "ARCHIVIST: Broken link in ~a -> ~a"
|
||||
(enough-namestring file memex-dir) link)
|
||||
(incf broken-links)))))
|
||||
(error ()
|
||||
(log-message "ARCHIVIST: Could not read ~a" file))))
|
||||
;; Scan for orphaned memory objects
|
||||
(handler-case
|
||||
(let ((deleted-ids (make-hash-table :test 'equal)))
|
||||
;; In practice, we check if parent-id points to a non-existent object
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore obj))
|
||||
(setf (gethash id deleted-ids) t))
|
||||
(if (boundp '*memory-store*)
|
||||
(symbol-value '*memory-store*)
|
||||
(make-hash-table :test 'equal)))
|
||||
(let ((store (if (boundp '*memory-store*)
|
||||
(symbol-value '*memory-store*)
|
||||
(make-hash-table :test 'equal))))
|
||||
(maphash (lambda (id obj)
|
||||
(let ((parent (memory-object-parent-id obj)))
|
||||
(when (and parent (not (gethash parent store)))
|
||||
(log-message "ARCHIVIST: Orphaned object ~a (parent ~a not found)"
|
||||
id parent)
|
||||
(incf orphans))))
|
||||
store)))
|
||||
(error ()
|
||||
(log-message "ARCHIVIST: Memory store not available for orphan scan")))
|
||||
(setf *archivist-last-gardener* (get-universal-time))
|
||||
(list :broken-links broken-links :orphans orphans)))
|
||||
|
||||
#+end_src
|
||||
** archivist-find-org-files
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-find-org-files (memex-dir)
|
||||
"Recursively finds all .org files under memex-dir, up to 3 levels deep."
|
||||
(let ((files nil))
|
||||
(labels ((walk (dir depth)
|
||||
(when (and (uiop:directory-exists-p dir) (< depth 3))
|
||||
(handler-case
|
||||
(dolist (entry (uiop:subdirectories dir))
|
||||
(walk entry (1+ depth)))
|
||||
(error ()))
|
||||
(handler-case
|
||||
(dolist (file (uiop:directory-files dir "*.org"))
|
||||
(push (namestring file) files))
|
||||
(error ())))))
|
||||
(walk memex-dir 0))
|
||||
files))
|
||||
|
||||
#+end_src
|
||||
** archivist-extract-file-links
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-extract-file-links (content)
|
||||
"Extracts all =[[file:...]]= link targets from Org content.
|
||||
Returns a list of link target strings."
|
||||
(let ((links nil))
|
||||
(cl-ppcre:do-register-groups (target)
|
||||
("\\[\\[file:([^\\]]+)\\]\\[" content)
|
||||
(unless (search "::" target) ;; skip internal anchors
|
||||
(pushnew target links :test #'string=)))
|
||||
;; Also handle bare [[file:target]] links
|
||||
(cl-ppcre:do-register-groups (target)
|
||||
("\\[\\[file:([^\\]]+)\\]\\]" content)
|
||||
(unless (search "::" target)
|
||||
(pushnew target links :test #'string=)))
|
||||
links))
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
** Archivist Runner
|
||||
|
||||
Triggered by heartbeat events, runs Scribe and Gardener on alternating schedules.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun archivist-run (action context)
|
||||
"Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
|
||||
and dispatches as needed. Called by the deterministic gate."
|
||||
(declare (ignore action context))
|
||||
(let ((now (get-universal-time)))
|
||||
;; Scribe runs every 6 hours (21600 seconds)
|
||||
(when (>= (- now *archivist-last-scribe*) 21600)
|
||||
(ignore-errors (archivist-scribe-distill)))
|
||||
;; Gardener runs every 24 hours
|
||||
(when (>= (- now *archivist-last-gardener*) *archivist-gardener-interval*)
|
||||
(ignore-errors
|
||||
(let ((result (archivist-gardener-scan)))
|
||||
(when (> (getf result :broken-links) 0)
|
||||
(log-message "ARCHIVIST: Gardener found ~d broken links, ~d orphans"
|
||||
(getf result :broken-links) (getf result :orphans)))))))
|
||||
nil)
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
|
||||
#+begin_src lisp
|
||||
(defskill :passepartout-system-archivist
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
||||
:deterministic #'archivist-run)
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-system-archivist-tests
|
||||
(:use :cl :passepartout)
|
||||
(:export #:archivist-suite))
|
||||
|
||||
(in-package :passepartout-system-archivist-tests)
|
||||
|
||||
(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
|
||||
(fiveam:in-suite archivist-suite)
|
||||
|
||||
(fiveam:test test-extract-headlines
|
||||
"Contract 1: archivist-extract-headlines parses Org content."
|
||||
(let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
|
||||
(headlines (archivist-extract-headlines content)))
|
||||
(fiveam:is (listp headlines))
|
||||
(fiveam:is (>= (length headlines) 1))))
|
||||
|
||||
(fiveam:test test-headline-to-filename
|
||||
"Contract 2: archivist-headline-to-filename sanitizes titles."
|
||||
(let ((filename (archivist-headline-to-filename "My Project: Overview")))
|
||||
(fiveam:is (search "my_project_overview" filename :test #'char-equal))
|
||||
(fiveam:is (not (search ":" filename)))))
|
||||
|
||||
(fiveam:test test-archivist-create-note
|
||||
"Contract 3: archivist-create-note writes a Zettelkasten note to disk."
|
||||
(let* ((tmp-dir "/tmp/passepartout-archivist-test/")
|
||||
(headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
|
||||
(uiop:ensure-all-directories-exist (list tmp-dir))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
|
||||
"Expected note creation to return T")
|
||||
(fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
|
||||
"Expected file test_note.org to exist"))
|
||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user