15 KiB
15 KiB
SKILL: Archivist (org-skill-archivist.org)
- Overview
- Implementation
- Package Context
- Archivist State
- archivist-last-gardener
- archivist-gardener-interval
- Scribe: Knowledge Distillation
- archivist-extract-headlines
- archivist-headline-to-filename
- archivist-create-note
- Gardener: Structural Maintenance
- archivist-find-org-files
- archivist-extract-file-links
- Archivist Runner
- Skill Registration
- Test Suite
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 orphanedmemory-objectentries — flagging them for human review.
Contract
- (archivist-extract-headlines content): parses Org content into a
list of headline structures, each with
:title,:body,:tags. - (archivist-headline-to-filename title): sanitizes a headline title into a valid filename — lowercased, special chars replaced.
- (archivist-create-note headline notes-dir source): writes a Zettelkasten note to disk with frontmatter and backlinks.
- (archivist-scribe-distill): heartbeat-driven — reads recent log
entries from
*history-store*and creates structured notes. - (archivist-gardener-scan): heartbeat-driven — scans for broken file links and orphaned memory objects.
Implementation
Package Context
(in-package :passepartout)Archivist State
;; REPL-VERIFIED: 2026-05-03T13:00:00
(in-package :passepartout)
(defvar *archivist-last-scribe* 0
"Universal time of the last Scribe distillation run.")archivist-last-gardener
;; REPL-VERIFIED: 2026-05-03T13:00:00
(defvar *archivist-last-gardener* 0
"Universal time of the last Gardener scan run.")archivist-gardener-interval
;; REPL-VERIFIED: 2026-05-03T13:00:00
(defvar *archivist-gardener-interval* 86400
"Seconds between Gardener scans. Default: 24 hours.")#+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
(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))archivist-extract-headlines
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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)))archivist-headline-to-filename
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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)))archivist-create-note
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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
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
(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)))archivist-find-org-files
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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))archivist-extract-file-links
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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
Archivist Runner
Triggered by heartbeat events, runs Scribe and Gardener on alternating schedules.
;; REPL-VERIFIED: 2026-05-03T13:00:00
(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)Skill Registration
(defskill :passepartout-system-archivist
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic #'archivist-run)Test Suite
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-system-archivist-tests
(:use :cl :fiveam :passepartout)
(:export #:archivist-suite))
(in-package :passepartout-system-archivist-tests)
(def-suite archivist-suite :description "Verification of the Archivist skill")
(in-suite archivist-suite)
(test test-extract-headlines
"Contract 1: archivist-extract-headlines parses Org content."
(let* ((content "* My Headline :tag1:tag2:~%Body text here~%* Another Headline")
(headlines (archivist-extract-headlines content)))
(is (listp headlines))
(is (>= (length headlines) 1))))
(test test-headline-to-filename
"Contract 2: archivist-headline-to-filename sanitizes titles."
(let ((filename (archivist-headline-to-filename "My Project: Overview")))
(is (search "my_project_overview" filename :test #'char-equal))
(is (not (search ":" filename))))
(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
(is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
"Expected note creation to return T")
(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)))))