Amr Gharbeia
ce90fd3e72
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Root cause chain: 1. proto-get was used throughout the pipeline but never defined — added to core-communication.org as a keyword-normalizing getf wrapper. 2. security-dispatcher.lisp was loaded by skill-initialize-all into a separate package, making HITL functions invisible to :passepartout. Fixed by adding to ASDF component list and excluding from skill loader. 3. org-id-generate was referenced from hitl-create but lives in an unexported skill package — replaced with uuid:make-v4-uuid. 4. uiop:string-prefix-p was called with :test keyword argument it does not accept — replaced with string-downcase normalization on both sides. Also: - Export hitl-create, hitl-approve, hitl-deny, hitl-handle-message, stimulus-inject from :passepartout for REPL accessibility.
443 lines
23 KiB
Org Mode
443 lines
23 KiB
Org Mode
#+TITLE: The Skill Engine (skills.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :org:skills:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/core-skills.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
The Skill Engine is the dynamic loading and lifecycle manager for all Passepartout skills. It discovers skill files in the skills directory, resolves their dependency order, loads them into jailed packages, and exports their public symbols into the ~passepartout~ package.
|
|
|
|
** Late-Binding Intelligence
|
|
|
|
Hardcoding logic into a compiled binary creates a brittle kernel. Every time you add a capability, you must recompile, restart, and re-deploy. Skills solve this by being:
|
|
|
|
1. **Discovered at boot** — the engine scans a directory for skill files and loads whatever it finds. No registration step needed.
|
|
2. **Dependency-ordered** — skills declare dependencies via ~#+DEPENDS_ON:~ headers. The topological sort ensures they load in the right order.
|
|
3. **Hot-reloadable** — a skill can be replaced at runtime without restarting the daemon. The new version is compiled into a fresh jail package and swapped in.
|
|
4. **Self-documenting** — each skill is a single Org file containing prose, code, metadata, and tests. The "Why" and the "How" are unified.
|
|
|
|
** The Jailed Package Model
|
|
|
|
Every skill loads into its own package (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~). This prevents name conflicts between skills — two skills can define a function called ~process~ without collision, because each lives in its own namespace.
|
|
|
|
After loading, the engine exports the skill's public symbols into the ~passepartout~ package, making them available to other skills and the org. The export filter uses the skill's short name as a prefix — for example, the BOUNCER skill exports only symbols starting with ~BOUNCER-~.
|
|
|
|
This is how the "thin org, fat skills" principle works in practice: the org provides the loading infrastructure; the skills provide all the intelligence.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Utility functions
|
|
|
|
Helper functions used by the skill loader and other components.
|
|
|
|
*** Cosine similarity
|
|
|
|
Computes the cosine similarity between two numeric vectors. Used by the peripheral vision system for semantic relevance scoring — if the agent's current focus has a vector embedding, objects with similar embeddings get promoted to foveal detail.
|
|
|
|
#+begin_src lisp
|
|
(defun vector-cosine-similarity (v1 v2)
|
|
"Computes cosine similarity between two vectors."
|
|
(let* ((len1 (length v1)) (len2 (length v2)))
|
|
(if (or (zerop len1) (zerop len2))
|
|
0.0
|
|
(let* ((dot 0.0d0) (n1 0.0d0) (n2 0.0d0))
|
|
(dotimes (i (min len1 len2))
|
|
(let* ((x (coerce (elt v1 i) 'double-float)) (y (coerce (elt v2 i) 'double-float)))
|
|
(incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
|
|
(if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
|
|
#+end_src
|
|
|
|
*** Secret masking
|
|
|
|
Simple mask function and the vault memory hash table. Used by the Bouncer skill and credentials vault to prevent secrets from appearing in logs.
|
|
|
|
#+begin_src lisp
|
|
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
|
|
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
|
|
#+end_src
|
|
|
|
** Skill data structures
|
|
|
|
The ~skill~ struct holds all metadata about a loaded skill: its name, priority, dependencies, trigger function, probabilistic prompt generator, deterministic gate, and system prompt augmentor. The ~skill-entry~ struct tracks the loading state of each discovered skill file.
|
|
|
|
#+begin_src lisp
|
|
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defvar *skill-registry* (make-hash-table :test 'equal))
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defvar *skill-catalog* (make-hash-table :test 'equal)
|
|
"Tracks all discovered skill files and their loading state.")
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
|
|
#+end_src
|
|
|
|
** Skill discovery (skill-triggered-find)
|
|
|
|
Iterates the registry and returns the highest-priority skill whose trigger function matches the current context. Only skills with a probabilistic prompt are considered (purely deterministic skills don't need LLM attention).
|
|
|
|
This is how the system determines which skill "owns" the current user input. For example, if the REPL skill's trigger matches the input, the REPL skill provides the prompt template that shapes how the LLM responds.
|
|
|
|
#+begin_src lisp
|
|
(defun skill-triggered-find (context)
|
|
"Returns the highest priority skill whose trigger matches context."
|
|
(let ((triggered nil))
|
|
(maphash (lambda (name skill)
|
|
(declare (ignore name))
|
|
(when (and (skill-probabilistic-prompt skill)
|
|
(ignore-errors (funcall (skill-trigger-fn skill) context)))
|
|
(push skill triggered)))
|
|
*skill-registry*)
|
|
(first (sort triggered #'> :key #'skill-priority))))
|
|
#+end_src
|
|
|
|
** Skill registration macro (defskill)
|
|
|
|
The primary API for skills. Each skill file calls this once to register itself. The macro creates a ~skill~ struct and stores it in ~*skill-registry*~ keyed by the skill's name.
|
|
|
|
The ~:system-prompt-augment~ slot is optional. If provided, it's a function that receives the context and returns a string to append to the LLM's system prompt. This allows skills to inject domain-specific instructions into every reasoning cycle.
|
|
|
|
#+begin_src lisp
|
|
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
|
|
"Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
|
|
`(setf (gethash (string-downcase (string ,name)) *skill-registry*)
|
|
(make-skill :name (string-downcase (string ,name))
|
|
:priority (or ,priority 10)
|
|
:dependencies ',dependencies
|
|
:trigger-fn ,trigger
|
|
:probabilistic-prompt ,probabilistic
|
|
:deterministic-fn ,deterministic
|
|
:system-prompt-augment ,system-prompt-augment)))
|
|
#+end_src
|
|
|
|
** Dependency resolution (skill-dependencies-resolve)
|
|
|
|
Recursively resolves all transitive dependencies for a given skill, returning an ordered list. Uses a standard graph traversal with a ~seen~ set to prevent infinite recursion from circular dependencies.
|
|
|
|
#+begin_src lisp
|
|
(defun skill-dependencies-resolve (skill-name)
|
|
"Resolves transitive dependencies. Returns list of skill names in dependency order."
|
|
(let ((resolved nil) (seen nil))
|
|
(labels ((visit (name)
|
|
(unless (member name seen :test #'equal)
|
|
(push name seen)
|
|
(let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
|
|
(when skill
|
|
(dolist (dep (skill-dependencies skill)) (visit dep))))
|
|
(push name resolved))))
|
|
(visit skill-name)
|
|
(nreverse resolved))))
|
|
#+end_src
|
|
|
|
** Skill File Analysis (skill-metadata-parse)
|
|
|
|
Extracts the ~:ID~ and ~#+DEPENDS_ON:~ declarations from a skill's Org file. Used by the topological sorter to order skills correctly.
|
|
|
|
#+begin_src lisp
|
|
(defun skill-metadata-parse (filepath)
|
|
"Extracts ID and DEPENDS_ON tags from org file."
|
|
(let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
|
|
(let ((id-start (search ":ID:" content)))
|
|
(when id-start
|
|
(let ((id-end (position #\Newline content :start id-start)))
|
|
(when id-end (setf id (string-trim " " (subseq content (+ id-start 4) id-end)))))))
|
|
(let ((pos 0))
|
|
(loop while (setf pos (search "#+DEPENDS_ON:" content :start2 pos))
|
|
do (let ((end (position #\Newline content :start pos)))
|
|
(when end
|
|
(let ((line (string-trim " " (subseq content (+ pos 13) end))))
|
|
(dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
|
|
(unless (string= d "") (push d dependencies))))
|
|
(setf pos end)))))
|
|
(values id (reverse dependencies))))
|
|
#+end_src
|
|
|
|
** Dependency Resolution (skill-topological-sort)
|
|
|
|
Returns a list of skill filepaths sorted by dependency order. Uses Kahn's algorithm: collect all files, build an adjacency graph from ~#+DEPENDS_ON:~ declarations, and topologically sort them. Skills with no dependencies are sorted alphabetically.
|
|
|
|
Both ~.org~ and ~.lisp~ files are included. For each skill, the ~.org~ file supplies the dependency metadata; if a ~.lisp~ file exists, it's loaded instead of tangling from the ~.org~ at load time.
|
|
|
|
#+begin_src lisp
|
|
(defun skill-topological-sort (skills-dir)
|
|
"Returns a list of skill filepaths sorted by dependency."
|
|
(let* ((org-files (uiop:directory-files skills-dir "*.org"))
|
|
(lisp-files (uiop:directory-files skills-dir "*.lisp"))
|
|
(all-files (append org-files lisp-files))
|
|
(files (remove-if (lambda (f)
|
|
(let ((n (pathname-name f)))
|
|
(or (string= n "core-defpackage")
|
|
(string= n "core-skills")
|
|
(string= n "core-communication")
|
|
(string= n "core-memory")
|
|
(string= n "core-context")
|
|
(string= n "core-loop-perceive")
|
|
(string= n "core-loop-reason")
|
|
(string= n "core-loop-act")
|
|
(string= n "core-loop")
|
|
(string= n "core-manifest")
|
|
(string= n "security-dispatcher"))))
|
|
all-files))
|
|
(adj (make-hash-table :test 'equal))
|
|
(name-to-file (make-hash-table :test 'equal))
|
|
(id-to-file (make-hash-table :test 'equal))
|
|
(result nil)
|
|
(visited (make-hash-table :test 'equal))
|
|
(stack (make-hash-table :test 'equal)))
|
|
(dolist (file files)
|
|
(let ((filename (pathname-name file)))
|
|
(if (uiop:string-suffix-p (namestring file) ".lisp")
|
|
(progn
|
|
(setf (gethash (string-downcase filename) name-to-file) file)
|
|
(unless (gethash (string-downcase filename) adj)
|
|
(setf (gethash (string-downcase filename) adj) nil)))
|
|
(multiple-value-bind (id deps) (skill-metadata-parse file)
|
|
(setf (gethash (string-downcase filename) name-to-file) file)
|
|
(when id (setf (gethash (string-downcase id) id-to-file) file))
|
|
(setf (gethash (string-downcase filename) adj) deps)))))
|
|
(labels ((visit (file)
|
|
(let* ((filename (pathname-name file))
|
|
(node-key (string-downcase filename)))
|
|
(unless (gethash node-key visited)
|
|
(setf (gethash node-key stack) t)
|
|
(dolist (dep (gethash node-key adj))
|
|
(let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
|
|
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
|
|
(dep-file (if is-id-p
|
|
(gethash dep-key id-to-file)
|
|
(or (gethash dep-key id-to-file)
|
|
(gethash dep-key name-to-file)))))
|
|
(when dep-file
|
|
(let ((dep-filename (pathname-name dep-file)))
|
|
(if (gethash (string-downcase dep-filename) stack)
|
|
(error "Circular dependency detected")
|
|
(visit dep-file))))))
|
|
(setf (gethash node-key stack) nil)
|
|
(setf (gethash node-key visited) t)
|
|
(push file result)))))
|
|
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
|
|
(dolist (name filenames)
|
|
(let ((file (gethash (string-downcase name) name-to-file)))
|
|
(when file (visit file)))))
|
|
(nreverse result))))
|
|
#+end_src
|
|
|
|
** Jailed Loading (skill-load-from-org)
|
|
|
|
The primary skill loader. Given a path to an ~.org~ file:
|
|
|
|
1. Reads the Org file and collects all ~#+begin_src lisp~ blocks (excluding test blocks and blocks with ~:tangle no~)
|
|
2. Validates the Lisp syntax before loading
|
|
3. Creates a jailed package named after the skill (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~) with ~:use :passepartout~
|
|
4. Evaluates the collected Lisp forms in that package
|
|
5. Scans the package for symbols matching the skill's name prefix and exports them to the ~passepartout~ package
|
|
|
|
The validation step is critical: invalid Lisp in an org block would crash the loader. The validator uses ~read~ with ~*read-eval*~ bound to nil to safely detect syntax errors without evaluating.
|
|
|
|
#+begin_src lisp
|
|
(defun lisp-syntax-validate (code-string)
|
|
"Checks if a string contains valid Common Lisp forms."
|
|
(handler-case
|
|
(let ((*read-eval* nil))
|
|
(with-input-from-string (s (format nil "(progn ~a)" code-string))
|
|
(loop for form = (read s nil :eof) until (eq form :eof)))
|
|
(values t nil))
|
|
(error (c) (values nil (format nil "~a" c)))))
|
|
|
|
(defun skill-package-forms-strip (code-string)
|
|
"Removes in-package forms so symbols get defined in skill package."
|
|
(let ((lines (uiop:split-string code-string :separator '(#\Newline)))
|
|
(result ""))
|
|
(dolist (line lines)
|
|
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
|
|
(unless (uiop:string-prefix-p "(in-package" trimmed)
|
|
(setf result (concatenate 'string result line (string #\Newline))))))
|
|
result))
|
|
|
|
(defun tangle-target-extract (line)
|
|
"Extracts the value of the :tangle header."
|
|
(let ((pos (search ":tangle" line)))
|
|
(when pos
|
|
(let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
|
|
(let ((end (position #\Space rest)))
|
|
(if end (subseq rest 0 end) rest))))))
|
|
|
|
(defun load-skill-from-org (filepath)
|
|
"Parses and evaluates Lisp blocks from an Org file."
|
|
(let* ((skill-base-name (pathname-name filepath))
|
|
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
|
|
(setf (skill-entry-status entry) :loading)
|
|
(handler-case
|
|
(let* ((content (uiop:read-file-string filepath))
|
|
(lines (uiop:split-string content :separator '(#\Newline)))
|
|
(in-lisp-block nil) (collect-this-block nil) (lisp-code "")
|
|
(pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
|
|
(dolist (line lines)
|
|
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
|
(cond
|
|
((uiop:string-prefix-p "#+begin_src lisp" clean-line)
|
|
(setf in-lisp-block t)
|
|
(let ((target (tangle-target-extract clean-line)))
|
|
(setf collect-this-block (or (null target)
|
|
(and (not (search "no" target))
|
|
(not (search "/tests" target)))))))
|
|
((uiop:string-prefix-p "#+end_src" clean-line)
|
|
(setf in-lisp-block nil) (setf collect-this-block nil))
|
|
((and in-lisp-block collect-this-block)
|
|
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
|
(uiop:string-prefix-p ":END:" (string-upcase clean-line))
|
|
(uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
|
|
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
|
(if (= (length lisp-code) 0)
|
|
(setf (skill-entry-status entry) :ready)
|
|
(progn
|
|
(multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
|
|
(unless valid-p (error err)))
|
|
(unless (find-package pkg-name)
|
|
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
|
|
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
|
(log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
|
|
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
|
|
|
|
(let* ((target-pkg (find-package :passepartout))
|
|
(raw-name (string-upcase skill-base-name))
|
|
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
|
|
(subseq raw-name 10)
|
|
raw-name)))
|
|
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
|
|
(do-symbols (sym (find-package pkg-name))
|
|
(when (eq (symbol-package sym) (find-package pkg-name))
|
|
(let ((sn (symbol-name sym)))
|
|
(when (or (uiop:string-prefix-p raw-name sn)
|
|
(uiop:string-prefix-p short-name sn)
|
|
(string-equal sn "DIAGNOSTICS-MAIN")
|
|
(string-equal sn "DIAGNOSTICS-RUN-ALL")
|
|
(string-equal sn "SETUP-WIZARD-RUN"))
|
|
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
|
|
(let ((existing (find-symbol sn target-pkg)))
|
|
(when (and existing (not (eq existing sym)))
|
|
(unintern existing target-pkg)))
|
|
(import sym target-pkg)
|
|
(export sym target-pkg))))))
|
|
|
|
(setf (skill-entry-status entry) :ready)))
|
|
t)
|
|
(error (c)
|
|
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
|
|
(setf (skill-entry-status entry) :failed) nil))))
|
|
#+end_src
|
|
|
|
** Loading from Pre-Tangled Lisp (skill-load-from-lisp)
|
|
|
|
Loads a pre-tangled ~.lisp~ file directly, without parsing the Org source. This is faster than ~load-skill-from-org~ because it skips the block extraction and syntax validation (the Lisp was already validated when tangled).
|
|
|
|
The same jailed package and symbol export process applies.
|
|
|
|
#+begin_src lisp
|
|
(defun load-skill-from-lisp (filepath)
|
|
"Loads a .lisp skill file directly, filtering out in-package forms."
|
|
(let* ((skill-base-name (pathname-name filepath))
|
|
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
|
|
(setf (skill-entry-status entry) :loading)
|
|
(handler-case
|
|
(let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
|
|
(pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
|
|
(multiple-value-bind (valid-p err) (lisp-syntax-validate content)
|
|
(unless valid-p (error err)))
|
|
(unless (find-package pkg-name)
|
|
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
|
|
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
|
(log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
|
|
(with-input-from-string (s content)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (handler-case (eval form)
|
|
(error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
|
|
(let* ((target-pkg (find-package :passepartout))
|
|
(raw-name (string-upcase skill-base-name))
|
|
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
|
|
(subseq raw-name 10)
|
|
raw-name)))
|
|
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
|
|
(do-symbols (sym (find-package pkg-name))
|
|
(when (eq (symbol-package sym) (find-package pkg-name))
|
|
(let ((sn (symbol-name sym)))
|
|
(when (or (uiop:string-prefix-p raw-name sn)
|
|
(uiop:string-prefix-p short-name sn)
|
|
(string-equal sn "DIAGNOSTICS-MAIN")
|
|
(string-equal sn "DIAGNOSTICS-RUN-ALL")
|
|
(string-equal sn "SETUP-WIZARD-RUN"))
|
|
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
|
|
(let ((existing (find-symbol sn target-pkg)))
|
|
(when (and existing (not (eq existing sym)))
|
|
(unintern existing target-pkg)))
|
|
(import sym target-pkg)
|
|
(export sym target-pkg))))))
|
|
(setf (skill-entry-status entry) :ready))
|
|
(error (c)
|
|
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
|
|
(setf (skill-entry-status entry) :failed) nil))))
|
|
#+end_src
|
|
|
|
** Initialize (skill-initialize-all)
|
|
|
|
Boot-time entry point. Scans the skills directory, topologically sorts the files, and loads each one. Called from ~main~ in the metabolic loop and from the REPL for hot-reload.
|
|
|
|
Skills are loaded from ~$PASSEPARTOUT_DATA_DIR/lisp/~ where both core and skill
|
|
files live after tangling. The org source files live in ~org/~.
|
|
|
|
#+begin_src lisp
|
|
(defun skill-initialize-all ()
|
|
"Initializes all skills from the XDG data directory."
|
|
(let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
|
|
(skills-dir (merge-pathnames "lisp/" (uiop:ensure-directory-pathname data-dir))))
|
|
(unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
|
|
(let ((sorted-files (skill-topological-sort skills-dir)))
|
|
(log-message "LOADER: Initializing ~a skills..." (length sorted-files))
|
|
(dolist (file sorted-files)
|
|
(if (uiop:string-suffix-p (namestring file) ".lisp")
|
|
(load-skill-from-lisp file)
|
|
(load-skill-from-org file)))
|
|
(log-message "LOADER: Boot Complete."))))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
Verifies that the topological sorter correctly orders skills by their ~#+DEPENDS_ON:~ declarations.
|
|
#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-boot-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:boot-suite))
|
|
|
|
(in-package :passepartout-boot-tests)
|
|
|
|
(def-suite boot-suite :description "Verification of the Skill Engine loader")
|
|
(in-suite boot-suite)
|
|
|
|
(test test-topological-sort-basic
|
|
(let ((tmp-dir "/tmp/passepartout-boot-test/"))
|
|
(uiop:ensure-all-directories-exist (list tmp-dir))
|
|
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
(format out "#+DEPENDS_ON: skill-b-id~%"))
|
|
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
(format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
|
|
(unwind-protect
|
|
(let ((sorted (passepartout::skill-topological-sort tmp-dir)))
|
|
(let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
|
|
(pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
|
|
(is (< pos-b pos-a))))
|
|
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
|
#+end_src
|