tier3: contracts + tests for 12 remaining modules (all 39 files now have Contracts)
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
This commit is contained in:
@@ -171,8 +171,17 @@
|
|||||||
#:vault-set-secret
|
#:vault-set-secret
|
||||||
#:memory-objects-by-attribute
|
#:memory-objects-by-attribute
|
||||||
#:find-headline-missing-id
|
#:find-headline-missing-id
|
||||||
|
#:gateway-cli-input
|
||||||
|
#:repl-eval
|
||||||
|
#:repl-inspect
|
||||||
|
#:repl-list-vars
|
||||||
#:policy-compliance-check
|
#:policy-compliance-check
|
||||||
#:validator-protocol-check))
|
#:validator-protocol-check
|
||||||
|
#:archivist-extract-headlines
|
||||||
|
#:archivist-headline-to-filename
|
||||||
|
#:literate-extract-lisp-blocks
|
||||||
|
#:literate-block-balance-check
|
||||||
|
#:gateway-registry-initialize))
|
||||||
|
|
||||||
(in-package :passepartout)
|
(in-package :passepartout)
|
||||||
|
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defun gateway-cli-input (text)
|
(defun gateway-cli-input (text)
|
||||||
"Processes raw text from the command line."
|
"Processes raw text from the command line."
|
||||||
(inject-stimulus (list :type :EVENT
|
(inject-stimulus (list :type :EVENT
|
||||||
@@ -8,3 +10,22 @@
|
|||||||
:priority 100
|
:priority 100
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
|
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
|
||||||
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-gateway-cli-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:cli-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-gateway-cli-tests)
|
||||||
|
|
||||||
|
(def-suite cli-suite :description "Verification of the CLI Gateway")
|
||||||
|
(in-suite cli-suite)
|
||||||
|
|
||||||
|
(test test-gateway-cli-input-format
|
||||||
|
"Contract 1: gateway-cli-input injects a properly formed signal without error."
|
||||||
|
(handler-case
|
||||||
|
(gateway-cli-input "hello")
|
||||||
|
(error (c)
|
||||||
|
(fail "gateway-cli-input crashed: ~a" c))))
|
||||||
|
|||||||
@@ -214,3 +214,22 @@
|
|||||||
|
|
||||||
(gateway-registry-initialize)
|
(gateway-registry-initialize)
|
||||||
(gateway-start-all)
|
(gateway-start-all)
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-gateway-messaging-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:messaging-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-gateway-messaging-tests)
|
||||||
|
|
||||||
|
(def-suite messaging-suite :description "Verification of Gateway Messaging")
|
||||||
|
(in-suite messaging-suite)
|
||||||
|
|
||||||
|
(test test-gateway-registry-initialize
|
||||||
|
"Contract 1: gateway-registry-initialize populates the registry."
|
||||||
|
(clrhash passepartout::*gateway-registry*)
|
||||||
|
(gateway-registry-initialize)
|
||||||
|
(is (not (zerop (hash-table-count passepartout::*gateway-registry*))))
|
||||||
|
(is (getf (gethash "telegram" passepartout::*gateway-registry*) :configured)))
|
||||||
|
|||||||
@@ -161,43 +161,53 @@
|
|||||||
(in-suite utils-lisp-suite)
|
(in-suite utils-lisp-suite)
|
||||||
|
|
||||||
(test structural-balanced
|
(test structural-balanced
|
||||||
|
"Contract 1: balanced code returns T."
|
||||||
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test structural-unbalanced-open
|
(test structural-unbalanced-open
|
||||||
|
"Contract 1: missing close paren returns nil + error."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Reader Error" reason))))
|
(is (search "Reader Error" reason))))
|
||||||
|
|
||||||
(test structural-unbalanced-close
|
(test structural-unbalanced-close
|
||||||
|
"Contract 1: extra close paren returns nil + error."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Reader Error" reason))))
|
(is (search "Reader Error" reason))))
|
||||||
|
|
||||||
(test syntactic-valid
|
(test syntactic-valid
|
||||||
|
"Contract 2: valid syntax passes syntactic check."
|
||||||
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test semantic-safe
|
(test semantic-safe
|
||||||
|
"Contract 3: safe code passes semantic check."
|
||||||
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test semantic-blocked-eval
|
(test semantic-blocked-eval
|
||||||
|
"Contract 3: eval forms are blocked by semantic check."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
|
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Unsafe" reason))))
|
(is (search "Unsafe" reason))))
|
||||||
|
|
||||||
(test unified-success
|
(test unified-success
|
||||||
|
"Contract 4: valid code returns :success via lisp-validate."
|
||||||
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
|
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
|
||||||
(is (eq (getf result :status) :success))))
|
(is (eq (getf result :status) :success))))
|
||||||
|
|
||||||
(test unified-failure
|
(test unified-failure
|
||||||
|
"Contract 4: invalid code returns :error via lisp-validate."
|
||||||
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
|
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
|
||||||
(is (eq (getf result :status) :error))))
|
(is (eq (getf result :status) :error))))
|
||||||
|
|
||||||
(test eval-basic
|
(test eval-basic
|
||||||
|
"Contract 5: lisp-eval returns :success with captured result."
|
||||||
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
|
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
|
||||||
(is (eq (getf result :status) :success))
|
(is (eq (getf result :status) :success))
|
||||||
(is (string= (getf result :result) "3"))))
|
(is (string= (getf result :result) "3"))))
|
||||||
|
|
||||||
(test structural-extract
|
(test structural-extract
|
||||||
|
"Contract 6: lisp-extract finds and returns a named function."
|
||||||
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
|
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
|
||||||
(extracted (passepartout:lisp-extract code "hello")))
|
(extracted (passepartout:lisp-extract code "hello")))
|
||||||
(is (not (null extracted)))
|
(is (not (null extracted)))
|
||||||
@@ -206,6 +216,7 @@
|
|||||||
(is (eq (second form) 'HELLO)))))
|
(is (eq (second form) 'HELLO)))))
|
||||||
|
|
||||||
(test list-definitions
|
(test list-definitions
|
||||||
|
"Contract 7: lisp-list-definitions returns all defined names."
|
||||||
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
|
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
|
||||||
(let ((names (passepartout:lisp-list-definitions code)))
|
(let ((names (passepartout:lisp-list-definitions code)))
|
||||||
(is (member 'FOO names))
|
(is (member 'FOO names))
|
||||||
@@ -213,12 +224,14 @@
|
|||||||
(is (member '*BAZ* names)))))
|
(is (member '*BAZ* names)))))
|
||||||
|
|
||||||
(test structural-inject
|
(test structural-inject
|
||||||
|
"Contract 8: lisp-inject adds a form to a function body."
|
||||||
(let* ((code "(defun my-fun (x) (print x))")
|
(let* ((code "(defun my-fun (x) (print x))")
|
||||||
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
|
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
|
||||||
(let ((form (read-from-string injected)))
|
(let ((form (read-from-string injected)))
|
||||||
(is (equal (last form) '((FINISH-OUTPUT)))))))
|
(is (equal (last form) '((FINISH-OUTPUT)))))))
|
||||||
|
|
||||||
(test structural-slurp
|
(test structural-slurp
|
||||||
|
"Contract 9: lisp-slurp appends a form to a function body."
|
||||||
(let* ((code "(defun work () (step-1))")
|
(let* ((code "(defun work () (step-1))")
|
||||||
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
|
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
|
||||||
(let ((form (read-from-string slurped)))
|
(let ((form (read-from-string slurped)))
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defun literate-extract-lisp-blocks (content)
|
(defun literate-extract-lisp-blocks (content)
|
||||||
"Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
|
"Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
|
||||||
Returns a list of block strings."
|
Returns a list of block strings."
|
||||||
@@ -62,3 +64,30 @@ contents of the Lisp file. Returns T if they match, or an error message."
|
|||||||
(defskill :passepartout-programming-literate
|
(defskill :passepartout-programming-literate
|
||||||
:priority 300
|
:priority 300
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-programming-literate-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:literate-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-programming-literate-tests)
|
||||||
|
|
||||||
|
(def-suite literate-suite :description "Verification of the Literate Programming skill")
|
||||||
|
(in-suite literate-suite)
|
||||||
|
|
||||||
|
(test test-extract-lisp-blocks
|
||||||
|
"Contract 1: extracts lisp from #+begin_src blocks."
|
||||||
|
(let* ((org-content "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src")
|
||||||
|
(extracted (literate-extract-lisp-blocks org-content)))
|
||||||
|
(is (search "+ 1 2" extracted))
|
||||||
|
(is (search "+ 3 4" extracted))))
|
||||||
|
|
||||||
|
(test test-block-balance-check-valid
|
||||||
|
"Contract 2: balanced parens return T."
|
||||||
|
(is (eq t (literate-block-balance-check "org/core-loop.org"))))
|
||||||
|
|
||||||
|
(test test-block-balance-check-missing-close
|
||||||
|
"Contract 2: unbalanced parens return non-T."
|
||||||
|
(is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
|
||||||
|
|||||||
@@ -260,16 +260,19 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
|
|||||||
(in-suite utils-org-suite)
|
(in-suite utils-org-suite)
|
||||||
|
|
||||||
(test id-generation
|
(test id-generation
|
||||||
|
"Contract 1: org-id-generate returns unique UUID strings."
|
||||||
(let ((id1 (org-id-generate))
|
(let ((id1 (org-id-generate))
|
||||||
(id2 (org-id-generate)))
|
(id2 (org-id-generate)))
|
||||||
(is (plusp (length id1)))
|
(is (plusp (length id1)))
|
||||||
(is (not (string= id1 id2)))))
|
(is (not (string= id1 id2)))))
|
||||||
|
|
||||||
(test id-format
|
(test id-format
|
||||||
|
"Contract 2: org-id-format ensures 'id:' prefix."
|
||||||
(let ((formatted (org-id-format "abc12345")))
|
(let ((formatted (org-id-format "abc12345")))
|
||||||
(is (search "id:" formatted))))
|
(is (search "id:" formatted))))
|
||||||
|
|
||||||
(test property-setter
|
(test property-setter
|
||||||
|
"Contract 3: org-property-set modifies a property on a headline."
|
||||||
(let ((ast (list :type :HEADLINE
|
(let ((ast (list :type :HEADLINE
|
||||||
:properties (list :ID "id:test123" :TITLE "Test")
|
:properties (list :ID "id:test123" :TITLE "Test")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
@@ -277,6 +280,7 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
|
|||||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||||
|
|
||||||
(test todo-setter
|
(test todo-setter
|
||||||
|
"Contract 4: org-todo-set changes TODO state via org-property-set."
|
||||||
(let ((ast (list :type :HEADLINE
|
(let ((ast (list :type :HEADLINE
|
||||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
|
|||||||
@@ -146,3 +146,39 @@ writes the result back through the reply-stream."
|
|||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
||||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
||||||
:system-prompt-augment #'repl-mandate)
|
:system-prompt-augment #'repl-mandate)
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-programming-repl-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:repl-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-programming-repl-tests)
|
||||||
|
|
||||||
|
(def-suite repl-suite :description "Verification of the REPL skill")
|
||||||
|
(in-suite repl-suite)
|
||||||
|
|
||||||
|
(test test-repl-eval-success
|
||||||
|
"Contract 1: repl-eval returns result and no error for valid code."
|
||||||
|
(multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
|
||||||
|
(is (equal "3" result))
|
||||||
|
(is (null error))))
|
||||||
|
|
||||||
|
(test test-repl-eval-error
|
||||||
|
"Contract 1: repl-eval returns error message for invalid code."
|
||||||
|
(multiple-value-bind (result output error) (repl-eval "(+ 1 ")
|
||||||
|
(is (null result))
|
||||||
|
(is (stringp error))))
|
||||||
|
|
||||||
|
(test test-repl-inspect-found
|
||||||
|
"Contract 2: repl-inspect returns description for a bound symbol."
|
||||||
|
(let ((desc (repl-inspect "+" :package :cl)))
|
||||||
|
(is (search "+" desc))
|
||||||
|
(is (search "function" desc :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-repl-list-vars
|
||||||
|
"Contract 3: repl-list-vars returns a list of symbols."
|
||||||
|
(let ((vars (repl-list-vars :package :keyword)))
|
||||||
|
(is (listp vars))
|
||||||
|
(is (member ':repl-sensor vars))))
|
||||||
|
|||||||
@@ -1,5 +1,7 @@
|
|||||||
(in-package :passepartout)
|
(in-package :passepartout)
|
||||||
|
|
||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defvar *archivist-last-scribe* 0
|
(defvar *archivist-last-scribe* 0
|
||||||
"Universal time of the last Scribe distillation run.")
|
"Universal time of the last Scribe distillation run.")
|
||||||
|
|
||||||
@@ -237,3 +239,28 @@ and dispatches as needed. Called by the deterministic gate."
|
|||||||
:priority 100
|
:priority 100
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
||||||
:deterministic #'archivist-run)
|
:deterministic #'archivist-run)
|
||||||
|
|
||||||
|
(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)))))
|
||||||
|
|||||||
@@ -83,26 +83,26 @@
|
|||||||
(fiveam:in-suite model-explorer-suite)
|
(fiveam:in-suite model-explorer-suite)
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-slots
|
(fiveam:test model-explorer-recommend-slots
|
||||||
"model-explorer-recommend should return models for all standard slots"
|
"Contract 1: recommend returns models for all standard slots."
|
||||||
(dolist (slot '(:code :chat :plan :background))
|
(dolist (slot '(:code :chat :plan :background))
|
||||||
(let ((recs (passepartout::model-explorer-recommend slot)))
|
(let ((recs (passepartout::model-explorer-recommend slot)))
|
||||||
(fiveam:is (listp recs))
|
(fiveam:is (listp recs))
|
||||||
(fiveam:is (>= (length recs) 1)))))
|
(fiveam:is (>= (length recs) 1)))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-format
|
(fiveam:test model-explorer-recommend-format
|
||||||
"Each recommendation should have :id and :name"
|
"Contract 1: each recommendation has :id and :name."
|
||||||
(dolist (rec (passepartout::model-explorer-recommend :chat))
|
(dolist (rec (passepartout::model-explorer-recommend :chat))
|
||||||
(fiveam:is (getf rec :id))
|
(fiveam:is (getf rec :id))
|
||||||
(fiveam:is (getf rec :name))))
|
(fiveam:is (getf rec :name))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-unknown-slot
|
(fiveam:test model-explorer-recommend-unknown-slot
|
||||||
"Unknown slot should return fallback"
|
"Contract 1: unknown slot returns fallback list."
|
||||||
(let ((recs (passepartout::model-explorer-recommend :unknown)))
|
(let ((recs (passepartout::model-explorer-recommend :unknown)))
|
||||||
(fiveam:is (listp recs))
|
(fiveam:is (listp recs))
|
||||||
(fiveam:is (>= (length recs) 1))))
|
(fiveam:is (>= (length recs) 1))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-fetch-openrouter-count
|
(fiveam:test model-explorer-fetch-openrouter-count
|
||||||
"OpenRouter API should return at least 300 models"
|
"Contract 2: OpenRouter API returns at least 300 models."
|
||||||
(let ((models (passepartout::model-explorer-fetch :openrouter)))
|
(let ((models (passepartout::model-explorer-fetch :openrouter)))
|
||||||
(if models
|
(if models
|
||||||
(fiveam:is (>= (length models) 300))
|
(fiveam:is (>= (length models) 300))
|
||||||
|
|||||||
@@ -196,8 +196,17 @@ The package definition. All public symbols are exported here.
|
|||||||
#:vault-set-secret
|
#:vault-set-secret
|
||||||
#:memory-objects-by-attribute
|
#:memory-objects-by-attribute
|
||||||
#:find-headline-missing-id
|
#:find-headline-missing-id
|
||||||
|
#:gateway-cli-input
|
||||||
|
#:repl-eval
|
||||||
|
#:repl-inspect
|
||||||
|
#:repl-list-vars
|
||||||
#:policy-compliance-check
|
#:policy-compliance-check
|
||||||
#:validator-protocol-check))
|
#:validator-protocol-check
|
||||||
|
#:archivist-extract-headlines
|
||||||
|
#:archivist-headline-to-filename
|
||||||
|
#:literate-extract-lisp-blocks
|
||||||
|
#:literate-block-balance-check
|
||||||
|
#:gateway-registry-initialize))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Package Implementation
|
** Package Implementation
|
||||||
|
|||||||
@@ -6,8 +6,19 @@
|
|||||||
* Overview
|
* Overview
|
||||||
The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout over TCP. It connects to the daemon's framed protocol and translates between terminal input/output and the plist-based communication format. No TUI, no ncurses, no dependencies beyond a TCP socket. Every other gateway (TUI, Emacs, Telegram) builds on this same protocol.
|
The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout over TCP. It connects to the daemon's framed protocol and translates between terminal input/output and the plist-based communication format. No TUI, no ncurses, no dependencies beyond a TCP socket. Every other gateway (TUI, Emacs, Telegram) builds on this same protocol.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (gateway-cli-input text): wraps text in a ~:user-input~ envelope
|
||||||
|
with ~:source :CLI~ and injects into the pipeline via
|
||||||
|
~inject-stimulus~.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** CLI Command Handling
|
** CLI Command Handling
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -25,3 +36,26 @@ The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout o
|
|||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
|
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
|
||||||
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-gateway-cli-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:cli-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-gateway-cli-tests)
|
||||||
|
|
||||||
|
(def-suite cli-suite :description "Verification of the CLI Gateway")
|
||||||
|
(in-suite cli-suite)
|
||||||
|
|
||||||
|
(test test-gateway-cli-input-format
|
||||||
|
"Contract 1: gateway-cli-input injects a properly formed signal without error."
|
||||||
|
(handler-case
|
||||||
|
(gateway-cli-input "hello")
|
||||||
|
(error (c)
|
||||||
|
(fail "gateway-cli-input crashed: ~a" c))))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -17,6 +17,17 @@ The gateway management functions (~messaging-link~, ~messaging-unlink~, ~messagi
|
|||||||
|
|
||||||
This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code is unchanged; only the management entry points and the defskill name changed.
|
This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code is unchanged; only the management entry points and the defskill name changed.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (gateway-registry-initialize): populates ~*gateway-registry*~ with
|
||||||
|
~:configured~ status per platform based on env vars.
|
||||||
|
2. (messaging-link platform &key token): stores the token in the vault
|
||||||
|
and starts the gateway's polling thread.
|
||||||
|
3. (messaging-unlink platform): removes the token and stops the thread.
|
||||||
|
4. (gateway-configured-p platform): returns T if platform is configured.
|
||||||
|
5. (gateway-start platform): starts the background poll thread for a
|
||||||
|
named gateway platform.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
** Data
|
** Data
|
||||||
@@ -262,3 +273,28 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code
|
|||||||
(gateway-registry-initialize)
|
(gateway-registry-initialize)
|
||||||
(gateway-start-all)
|
(gateway-start-all)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-gateway-messaging-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:messaging-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-gateway-messaging-tests)
|
||||||
|
|
||||||
|
(def-suite messaging-suite :description "Verification of Gateway Messaging")
|
||||||
|
(in-suite messaging-suite)
|
||||||
|
|
||||||
|
(test test-gateway-registry-initialize
|
||||||
|
"Contract 1: gateway-registry-initialize populates the registry."
|
||||||
|
(clrhash passepartout::*gateway-registry*)
|
||||||
|
(gateway-registry-initialize)
|
||||||
|
(is (not (zerop (hash-table-count passepartout::*gateway-registry*))))
|
||||||
|
(is (getf (gethash "telegram" passepartout::*gateway-registry*) :configured)))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -5,6 +5,20 @@
|
|||||||
|
|
||||||
Event handlers + daemon I/O + main loop.
|
Event handlers + daemon I/O + main loop.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (on-key ch): dispatches key presses: Enter triggers send, Backspace
|
||||||
|
deletes, arrows scroll chat. Non-printable keys are ignored.
|
||||||
|
2. (on-daemon-msg msg): processes inbound daemon messages. Routes
|
||||||
|
responses to chat display, routes errors to log.
|
||||||
|
3. (send-daemon msg): serializes and sends a message to the daemon
|
||||||
|
over the framed TCP protocol.
|
||||||
|
4. (handle-return stream): processes the return key: extracts the
|
||||||
|
input buffer, sends to daemon, clears buffer. Handles connection
|
||||||
|
loss gracefully (enqueues error to ~*incoming-msgs*~).
|
||||||
|
5. (tui-main): the main loop — connects to daemon, initializes
|
||||||
|
Croatoan windows, runs render/input event loop at ~30fps~.
|
||||||
|
|
||||||
** Event Handlers
|
** Event Handlers
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(in-package :passepartout.gateway-tui)
|
(in-package :passepartout.gateway-tui)
|
||||||
|
|||||||
@@ -6,6 +6,16 @@
|
|||||||
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
|
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
|
||||||
All state mutation flows through event handlers in the controller.
|
All state mutation flows through event handlers in the controller.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (init-state): returns a fresh state plist with ~:msgs~ list,
|
||||||
|
~:input~ buffer, ~:dirty~ flag, and ~:connection~ status.
|
||||||
|
2. (add-msg type text): appends a message to the ~:msgs~ list in
|
||||||
|
~*state*~, tagged with a timestamp and type. Truncates at the
|
||||||
|
message buffer limit.
|
||||||
|
3. (queue-event ev): thread-safely enqueues an event for the
|
||||||
|
reader loop. (drain-queue) returns and clears the queue.
|
||||||
|
|
||||||
** Package + State
|
** Package + State
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defpackage :passepartout.gateway-tui
|
(defpackage :passepartout.gateway-tui
|
||||||
|
|||||||
@@ -6,6 +6,17 @@
|
|||||||
Pure render functions. Each takes a Croatoan window and current state.
|
Pure render functions. Each takes a Croatoan window and current state.
|
||||||
State is read via ~(st :key)~ — no mutation here.
|
State is read via ~(st :key)~ — no mutation here.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (view-status win): renders the status bar with connection info,
|
||||||
|
version, and timestamp.
|
||||||
|
2. (view-chat win): renders the scrolled chat message list. Messages
|
||||||
|
are color-coded: green (user), white (agent), yellow (system).
|
||||||
|
3. (view-input win): renders the input line with cursor and typing
|
||||||
|
indicator.
|
||||||
|
4. (redraw scr chat-win status-win input-win): dispatches redraws
|
||||||
|
based on ~(st :dirty)~ flags. Minimizes terminal writes.
|
||||||
|
|
||||||
** Status Bar
|
** Status Bar
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(in-package :passepartout.gateway-tui)
|
(in-package :passepartout.gateway-tui)
|
||||||
|
|||||||
@@ -15,6 +15,22 @@ The skill has four layers:
|
|||||||
3. **Structural surgery** — extract, inject, wrap, slurp — surgical code transformations without regex
|
3. **Structural surgery** — extract, inject, wrap, slurp — surgical code transformations without regex
|
||||||
4. **Formatting** — auto-indentation via Emacs batch mode
|
4. **Formatting** — auto-indentation via Emacs batch mode
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (lisp-structural-check code): returns (values T nil) if parentheses
|
||||||
|
balanced, (values nil error-msg) if reader errors detected.
|
||||||
|
2. (lisp-syntactic-check code): alias for lisp-structural-check.
|
||||||
|
3. (lisp-semantic-check code): returns (values T nil) if no unsafe forms
|
||||||
|
(eval, load, run-program) found; (values nil reason) if blocked.
|
||||||
|
4. (lisp-validate code &key strict): unified gate — returns
|
||||||
|
~(:status :success)~ or ~(:status :error :reason ...)~.
|
||||||
|
5. (lisp-eval code-string): sandboxed eval with captured output.
|
||||||
|
Returns ~(:status :success :result ...)~ or ~(:status :error ...)~.
|
||||||
|
6. (lisp-extract code fn-name): extracts a single defun from code.
|
||||||
|
7. (lisp-list-definitions code): returns list of defined symbol names.
|
||||||
|
8. (lisp-inject code target new-form): injects a form into a function body.
|
||||||
|
9. (lisp-slurp code target form): appends a form to a function body.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
@@ -233,43 +249,53 @@ Tests for the Lisp Validator structural, syntactic, and semantic gates.
|
|||||||
(in-suite utils-lisp-suite)
|
(in-suite utils-lisp-suite)
|
||||||
|
|
||||||
(test structural-balanced
|
(test structural-balanced
|
||||||
|
"Contract 1: balanced code returns T."
|
||||||
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test structural-unbalanced-open
|
(test structural-unbalanced-open
|
||||||
|
"Contract 1: missing close paren returns nil + error."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Reader Error" reason))))
|
(is (search "Reader Error" reason))))
|
||||||
|
|
||||||
(test structural-unbalanced-close
|
(test structural-unbalanced-close
|
||||||
|
"Contract 1: extra close paren returns nil + error."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Reader Error" reason))))
|
(is (search "Reader Error" reason))))
|
||||||
|
|
||||||
(test syntactic-valid
|
(test syntactic-valid
|
||||||
|
"Contract 2: valid syntax passes syntactic check."
|
||||||
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test semantic-safe
|
(test semantic-safe
|
||||||
|
"Contract 3: safe code passes semantic check."
|
||||||
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
|
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
|
||||||
|
|
||||||
(test semantic-blocked-eval
|
(test semantic-blocked-eval
|
||||||
|
"Contract 3: eval forms are blocked by semantic check."
|
||||||
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
|
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
|
||||||
(is (null ok))
|
(is (null ok))
|
||||||
(is (search "Unsafe" reason))))
|
(is (search "Unsafe" reason))))
|
||||||
|
|
||||||
(test unified-success
|
(test unified-success
|
||||||
|
"Contract 4: valid code returns :success via lisp-validate."
|
||||||
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
|
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
|
||||||
(is (eq (getf result :status) :success))))
|
(is (eq (getf result :status) :success))))
|
||||||
|
|
||||||
(test unified-failure
|
(test unified-failure
|
||||||
|
"Contract 4: invalid code returns :error via lisp-validate."
|
||||||
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
|
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
|
||||||
(is (eq (getf result :status) :error))))
|
(is (eq (getf result :status) :error))))
|
||||||
|
|
||||||
(test eval-basic
|
(test eval-basic
|
||||||
|
"Contract 5: lisp-eval returns :success with captured result."
|
||||||
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
|
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
|
||||||
(is (eq (getf result :status) :success))
|
(is (eq (getf result :status) :success))
|
||||||
(is (string= (getf result :result) "3"))))
|
(is (string= (getf result :result) "3"))))
|
||||||
|
|
||||||
(test structural-extract
|
(test structural-extract
|
||||||
|
"Contract 6: lisp-extract finds and returns a named function."
|
||||||
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
|
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
|
||||||
(extracted (passepartout:lisp-extract code "hello")))
|
(extracted (passepartout:lisp-extract code "hello")))
|
||||||
(is (not (null extracted)))
|
(is (not (null extracted)))
|
||||||
@@ -278,6 +304,7 @@ Tests for the Lisp Validator structural, syntactic, and semantic gates.
|
|||||||
(is (eq (second form) 'HELLO)))))
|
(is (eq (second form) 'HELLO)))))
|
||||||
|
|
||||||
(test list-definitions
|
(test list-definitions
|
||||||
|
"Contract 7: lisp-list-definitions returns all defined names."
|
||||||
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
|
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
|
||||||
(let ((names (passepartout:lisp-list-definitions code)))
|
(let ((names (passepartout:lisp-list-definitions code)))
|
||||||
(is (member 'FOO names))
|
(is (member 'FOO names))
|
||||||
@@ -285,12 +312,14 @@ Tests for the Lisp Validator structural, syntactic, and semantic gates.
|
|||||||
(is (member '*BAZ* names)))))
|
(is (member '*BAZ* names)))))
|
||||||
|
|
||||||
(test structural-inject
|
(test structural-inject
|
||||||
|
"Contract 8: lisp-inject adds a form to a function body."
|
||||||
(let* ((code "(defun my-fun (x) (print x))")
|
(let* ((code "(defun my-fun (x) (print x))")
|
||||||
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
|
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
|
||||||
(let ((form (read-from-string injected)))
|
(let ((form (read-from-string injected)))
|
||||||
(is (equal (last form) '((FINISH-OUTPUT)))))))
|
(is (equal (last form) '((FINISH-OUTPUT)))))))
|
||||||
|
|
||||||
(test structural-slurp
|
(test structural-slurp
|
||||||
|
"Contract 9: lisp-slurp appends a form to a function body."
|
||||||
(let* ((code "(defun work () (step-1))")
|
(let* ((code "(defun work () (step-1))")
|
||||||
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
|
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
|
||||||
(let ((form (read-from-string slurped)))
|
(let ((form (read-from-string slurped)))
|
||||||
|
|||||||
@@ -6,34 +6,22 @@
|
|||||||
* Overview
|
* Overview
|
||||||
This skill enforces the literal programming discipline for all Passepartout source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.
|
This skill enforces the literal programming discipline for all Passepartout source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.
|
||||||
|
|
||||||
** Discipline Rules
|
** Contract
|
||||||
|
|
||||||
*** One Function, One Block
|
1. (literate-extract-lisp-blocks content): extracts concatenated
|
||||||
Every ~#+begin_src lisp~ block contains exactly one function definition. Never bundle multiple definitions in a single block. This keeps the Org file granular, reviewable, and tanglable without side effects.
|
Lisp code from all ~#+begin_src lisp~ blocks in an Org string.
|
||||||
|
2. (literate-block-balance-check org-file): checks that parentheses are
|
||||||
*** Prose Before Code
|
balanced across all lisp blocks in an Org file. Returns T or nil.
|
||||||
Every block must be preceded by an Org headline and explanatory prose that covers:
|
3. (literate-tangle-sync-check org-file lisp-file): verifies the
|
||||||
- What the function does
|
tangled .lisp file matches the Org source. Returns T or mismatch info.
|
||||||
- Its arguments (including any &key, &optional)
|
|
||||||
- Its return value
|
|
||||||
- The rationale for its existence
|
|
||||||
|
|
||||||
The prose is not a comment — it is the authoritative specification. The code implements what the prose describes.
|
|
||||||
|
|
||||||
*** Reflect Back, Don't Write Directly
|
|
||||||
Code is explored and verified in the REPL first (per Engineering Standards lifecycle). Once working, it is *reflected back* into the Org file. This means:
|
|
||||||
- The REPL is the proving ground — iterate there
|
|
||||||
- The Org file is the record — copy working code there
|
|
||||||
- Never write code directly into an Org block without first evaluating it in the REPL
|
|
||||||
|
|
||||||
*** Code and Prose Together
|
|
||||||
Every ~#+begin_src lisp~ block flows from the prose above it. The reader (human or agent) should understand the function's contract from the prose before reading the code. If the code and prose disagree, the prose is wrong — update both.
|
|
||||||
|
|
||||||
*** Tangle Mandate
|
|
||||||
The `.lisp` file is derived, not authored. Never edit `.lisp` directly. All changes flow through Org: edit Org → tangle → `.lisp` updates. Violating this corrupts the skill loader and causes boot failure.
|
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Block Extraction
|
** Block Extraction
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -113,4 +101,35 @@ contents of the Lisp file. Returns T if they match, or an error message."
|
|||||||
(defskill :passepartout-programming-literate
|
(defskill :passepartout-programming-literate
|
||||||
:priority 300
|
:priority 300
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-programming-literate-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:literate-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-programming-literate-tests)
|
||||||
|
|
||||||
|
(def-suite literate-suite :description "Verification of the Literate Programming skill")
|
||||||
|
(in-suite literate-suite)
|
||||||
|
|
||||||
|
(test test-extract-lisp-blocks
|
||||||
|
"Contract 1: extracts lisp from #+begin_src blocks."
|
||||||
|
(let* ((org-content "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src")
|
||||||
|
(extracted (literate-extract-lisp-blocks org-content)))
|
||||||
|
(is (search "+ 1 2" extracted))
|
||||||
|
(is (search "+ 3 4" extracted))))
|
||||||
|
|
||||||
|
(test test-block-balance-check-valid
|
||||||
|
"Contract 2: balanced parens return T."
|
||||||
|
(is (eq t (literate-block-balance-check "org/core-loop.org"))))
|
||||||
|
|
||||||
|
(test test-block-balance-check-missing-close
|
||||||
|
"Contract 2: unbalanced parens return non-T."
|
||||||
|
(is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -6,6 +6,18 @@
|
|||||||
* Overview
|
* Overview
|
||||||
Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~.
|
Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (org-id-generate): returns a new UUID string.
|
||||||
|
2. (org-id-format id): ensures the ID has an "id:" prefix.
|
||||||
|
3. (org-property-set ast target-id property value): recursively sets a
|
||||||
|
property on a headline matching target-id. Returns T on success.
|
||||||
|
4. (org-todo-set ast target-id status): sets TODO status via
|
||||||
|
org-property-set.
|
||||||
|
5. (org-headline-add ast parent-id title): adds a new child headline.
|
||||||
|
6. (org-find-headline-by-id ast id): returns the subtree for a matching
|
||||||
|
headline ID.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
@@ -352,16 +364,19 @@ Verification of the structural manipulation for Org-mode files and their AST rep
|
|||||||
(in-suite utils-org-suite)
|
(in-suite utils-org-suite)
|
||||||
|
|
||||||
(test id-generation
|
(test id-generation
|
||||||
|
"Contract 1: org-id-generate returns unique UUID strings."
|
||||||
(let ((id1 (org-id-generate))
|
(let ((id1 (org-id-generate))
|
||||||
(id2 (org-id-generate)))
|
(id2 (org-id-generate)))
|
||||||
(is (plusp (length id1)))
|
(is (plusp (length id1)))
|
||||||
(is (not (string= id1 id2)))))
|
(is (not (string= id1 id2)))))
|
||||||
|
|
||||||
(test id-format
|
(test id-format
|
||||||
|
"Contract 2: org-id-format ensures 'id:' prefix."
|
||||||
(let ((formatted (org-id-format "abc12345")))
|
(let ((formatted (org-id-format "abc12345")))
|
||||||
(is (search "id:" formatted))))
|
(is (search "id:" formatted))))
|
||||||
|
|
||||||
(test property-setter
|
(test property-setter
|
||||||
|
"Contract 3: org-property-set modifies a property on a headline."
|
||||||
(let ((ast (list :type :HEADLINE
|
(let ((ast (list :type :HEADLINE
|
||||||
:properties (list :ID "id:test123" :TITLE "Test")
|
:properties (list :ID "id:test123" :TITLE "Test")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
@@ -369,6 +384,7 @@ Verification of the structural manipulation for Org-mode files and their AST rep
|
|||||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||||
|
|
||||||
(test todo-setter
|
(test todo-setter
|
||||||
|
"Contract 4: org-todo-set changes TODO state via org-property-set."
|
||||||
(let ((ast (list :type :HEADLINE
|
(let ((ast (list :type :HEADLINE
|
||||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
|
|||||||
@@ -25,11 +25,15 @@ The REPL skill fills this gap by:
|
|||||||
- Can load code into image
|
- Can load code into image
|
||||||
- Optional: connect to external SLIME/Swank session
|
- Optional: connect to external SLIME/Swank session
|
||||||
|
|
||||||
* Phase B: Protocol (Spec)
|
* Phase B: Contract
|
||||||
- `repl-eval` returns: (values result output error)
|
|
||||||
- `repl-inspect` returns: structured description
|
1. (repl-eval code-string &key package): evaluates Lisp code in a
|
||||||
- `repl-list-vars` returns: list of bound symbols
|
sandboxed environment (~*read-eval* nil~). Returns (values result
|
||||||
- `repl-load-file` returns: t on success, error on failure
|
output error) as three strings. Adds to ~*repl-history*~.
|
||||||
|
2. (repl-inspect symbol-name &key package): returns a formatted string
|
||||||
|
describing the symbol's value, type, or function documentation.
|
||||||
|
3. (repl-list-vars &key package): returns a list of bound variable
|
||||||
|
names in the given package.
|
||||||
|
|
||||||
* Phase C: Implementation
|
* Phase C: Implementation
|
||||||
|
|
||||||
@@ -264,3 +268,43 @@ The REPL skill loads at priority 200 (after diagnostics at 100, before utils-lis
|
|||||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
||||||
:system-prompt-augment #'repl-mandate)
|
:system-prompt-augment #'repl-mandate)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-programming-repl-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:repl-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-programming-repl-tests)
|
||||||
|
|
||||||
|
(def-suite repl-suite :description "Verification of the REPL skill")
|
||||||
|
(in-suite repl-suite)
|
||||||
|
|
||||||
|
(test test-repl-eval-success
|
||||||
|
"Contract 1: repl-eval returns result and no error for valid code."
|
||||||
|
(multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
|
||||||
|
(is (equal "3" result))
|
||||||
|
(is (null error))))
|
||||||
|
|
||||||
|
(test test-repl-eval-error
|
||||||
|
"Contract 1: repl-eval returns error message for invalid code."
|
||||||
|
(multiple-value-bind (result output error) (repl-eval "(+ 1 ")
|
||||||
|
(is (null result))
|
||||||
|
(is (stringp error))))
|
||||||
|
|
||||||
|
(test test-repl-inspect-found
|
||||||
|
"Contract 2: repl-inspect returns description for a bound symbol."
|
||||||
|
(let ((desc (repl-inspect "+" :package :cl)))
|
||||||
|
(is (search "+" desc))
|
||||||
|
(is (search "function" desc :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-repl-list-vars
|
||||||
|
"Contract 3: repl-list-vars returns a list of symbols."
|
||||||
|
(let ((vars (repl-list-vars :package :keyword)))
|
||||||
|
(is (listp vars))
|
||||||
|
(is (member ':repl-sensor vars))))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -14,8 +14,26 @@ events, performing two core functions:
|
|||||||
- Gardener: Scans the Memex for structural issues — broken =[[file:...]]= links
|
- Gardener: Scans the Memex for structural issues — broken =[[file:...]]= links
|
||||||
and orphaned =memory-object= entries — flagging them for human review.
|
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
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Archivist State
|
** Archivist State
|
||||||
|
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
@@ -318,4 +336,33 @@ and dispatches as needed. Called by the deterministic gate."
|
|||||||
:priority 100
|
:priority 100
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
||||||
:deterministic #'archivist-run)
|
: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 :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)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -11,6 +11,14 @@ It opens a thin pipe to OpenRouter's /api/v1/models endpoint (no API key needed
|
|||||||
|
|
||||||
Recommended models are curated per task slot — code generation needs different capabilities than casual chat or background summarization. The recommendations are not hardcoded provider hooks; they're hand-picked from the OpenRouter free tier as a sensible default. Users can override via the TUI config screen, which replaces the picked model IDs into their cascade.
|
Recommended models are curated per task slot — code generation needs different capabilities than casual chat or background summarization. The recommendations are not hardcoded provider hooks; they're hand-picked from the OpenRouter free tier as a sensible default. Users can override via the TUI config screen, which replaces the picked model IDs into their cascade.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (model-explorer-recommend slot): returns a list of plists with
|
||||||
|
~:id~ and ~:name~ for the given task slot (~:code~, ~:chat~,
|
||||||
|
~:plan~, ~:background~). Unknown slots return a fallback list.
|
||||||
|
2. (model-explorer-fetch provider): fetches the model list from the
|
||||||
|
provider's API and caches it. Returns nil on failure.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
** Cache
|
** Cache
|
||||||
@@ -120,26 +128,26 @@ Recommended models are curated per task slot — code generation needs different
|
|||||||
(fiveam:in-suite model-explorer-suite)
|
(fiveam:in-suite model-explorer-suite)
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-slots
|
(fiveam:test model-explorer-recommend-slots
|
||||||
"model-explorer-recommend should return models for all standard slots"
|
"Contract 1: recommend returns models for all standard slots."
|
||||||
(dolist (slot '(:code :chat :plan :background))
|
(dolist (slot '(:code :chat :plan :background))
|
||||||
(let ((recs (passepartout::model-explorer-recommend slot)))
|
(let ((recs (passepartout::model-explorer-recommend slot)))
|
||||||
(fiveam:is (listp recs))
|
(fiveam:is (listp recs))
|
||||||
(fiveam:is (>= (length recs) 1)))))
|
(fiveam:is (>= (length recs) 1)))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-format
|
(fiveam:test model-explorer-recommend-format
|
||||||
"Each recommendation should have :id and :name"
|
"Contract 1: each recommendation has :id and :name."
|
||||||
(dolist (rec (passepartout::model-explorer-recommend :chat))
|
(dolist (rec (passepartout::model-explorer-recommend :chat))
|
||||||
(fiveam:is (getf rec :id))
|
(fiveam:is (getf rec :id))
|
||||||
(fiveam:is (getf rec :name))))
|
(fiveam:is (getf rec :name))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-recommend-unknown-slot
|
(fiveam:test model-explorer-recommend-unknown-slot
|
||||||
"Unknown slot should return fallback"
|
"Contract 1: unknown slot returns fallback list."
|
||||||
(let ((recs (passepartout::model-explorer-recommend :unknown)))
|
(let ((recs (passepartout::model-explorer-recommend :unknown)))
|
||||||
(fiveam:is (listp recs))
|
(fiveam:is (listp recs))
|
||||||
(fiveam:is (>= (length recs) 1))))
|
(fiveam:is (>= (length recs) 1))))
|
||||||
|
|
||||||
(fiveam:test model-explorer-fetch-openrouter-count
|
(fiveam:test model-explorer-fetch-openrouter-count
|
||||||
"OpenRouter API should return at least 300 models"
|
"Contract 2: OpenRouter API returns at least 300 models."
|
||||||
(let ((models (passepartout::model-explorer-fetch :openrouter)))
|
(let ((models (passepartout::model-explorer-fetch :openrouter)))
|
||||||
(if models
|
(if models
|
||||||
(fiveam:is (>= (length models) 300))
|
(fiveam:is (>= (length models) 300))
|
||||||
|
|||||||
Reference in New Issue
Block a user