amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v0.3.0 finish: TUI tests, embedding wiring, gateway :configured, focus commands, export cleanup
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Details

Browse Source 
- TUI: Fix stale contract (remove handle-return/*incoming-msgs*), rewrite
  10->13 tests (38 checks, 100% pass). Export missing symbols from TUI
  package. Fix view-chat contract arity.
- Gateway messaging: Add :configured key to registry (boolean, nil default).
  Fix contract to match (vault-based, not env-var-based).
- Async Embedding Gateway: Add *embedding-backend* var, embeddings-compute
  function. Modify ingest-ast to populate vectors on new objects.
  Add EMBEDDING_PROVIDER env var support. Add Contract + 4 tests (8 checks).
- Context Manager: Add /focus, /scope, /unfocus commands to TUI on-key
  handler. Commands degrade gracefully when context-manager not loaded.
- Export hygiene: Remove 30+ ghost exports (undefined symbols). Remove
  duplicate/mismatched names. Exports now match actual definitions.
This commit is contained in:
Amr Gharbeia
2026-05-05 17:42:03 -04:00
parent 035aac45e3
commit cd86509e3a
13 changed files with 572 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
lisp/core-defpackage.lisp
View File

@@ -5,15 +5,10 @@
#:read-framed-message
#:PROTO-GET
#:proto-get
#:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY
#:VAULT-MASK-STRING
#:*VAULT-MEMORY*
#:parse-message
#:make-hello-message
#:validate-communication-protocol-schema
#:start-daemon
#:stop-daemon
#:log-message
#:main
#:diagnostics-run-all
@@ -23,17 +18,10 @@
#:register-provider
#:provider-openai-request
#:provider-config
#:system-ready-p
#:run-setup-wizard
#:skill-gateway-register
#:skill-gateway-link
#:gateway-manager-main
#:ingest-ast
#:memory-object-get
#:list-objects-by-type
#:org-id-new
#:*memory-store*
#:*history-store*
#:memory-object
#:make-memory-object
#:memory-object-id
@@ -49,14 +37,7 @@
#:memory-object-scope
#:snapshot-memory
#:rollback-memory
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-resolve-path
#:context-get-skill-telemetry
#:telemetry-track
#:context-assemble-global-awareness
#:context-awareness-assemble
@@ -65,15 +46,12 @@
#:loop-process
#:perceive-gate
#:loop-gate-perceive
#:probabilistic-gate
#:consensus-gate
#:act-gate
#:loop-gate-act
#:reason-gate
#:loop-gate-reason
#:cognitive-verify
#:backend-cascade-call
#:dispatch-gate
#:register-pre-reason-handler
#:inject-stimulus
#:stimulus-inject
@@ -88,13 +66,10 @@
#:dispatcher-gate
#:wildcard-match
#:actuator-initialize
#:dispatch-action
#:action-dispatch
#:register-actuator
#:load-skill-from-org
#:skill-initialize-all
#:load-skill-with-timeout
#:topological-sort-skills
#:lisp-syntax-validate
#:defskill
#:*skill-registry*
@@ -105,6 +80,7 @@
#:embed-queue-object
#:embed-object
#:embed-all-pending
#:embedding-backend-hashing
#:embeddings-compute
#:skill
#:skill-name
@@ -115,12 +91,6 @@
#:skill-deterministic-fn
#:def-cognitive-tool
#:*cognitive-tool-registry*
#:verify-git-clean-p
#:engineering-standards-verify-lisp
#:engineering-standards-format-lisp
#:literate-check-block-balance
#:check-tangle-sync
#:*tangle-targets*
#:org-read-file
#:org-write-file
#:org-headline-add
@@ -130,11 +100,8 @@
#:gateway-start
#:org-property-set
#:org-todo-set
#:org-find-headline-by-id
#:org-find-headline-by-title
#:org-id-generate
#:org-id-format
#:org-ast-to-org
#:org-modify
#:lisp-validate
#:lisp-structural-check
@@ -144,13 +111,9 @@
#:lisp-format
#:lisp-list-definitions
#:lisp-extract
#:lisp-structural-wrap
#:lisp-inject
#:lisp-slurp
#:lisp-register
#:get-oc-config-dir
#:prompt-for
#:save-secret
#:get-tool-permission
#:set-tool-permission
#:check-tool-permission-gate
@@ -162,13 +125,7 @@
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
#:ask-probabilistic
#:register-probabilistic-backend
#:distill-prompt
#:*probabilistic-backends*
#:*provider-cascade*
#:vault-get
@@ -176,7 +133,6 @@
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute
#:find-headline-missing-id
#:gateway-cli-input
#:repl-eval
#:repl-inspect
@@ -190,8 +146,7 @@
#:gateway-registry-initialize
#:messaging-link
#:messaging-unlink
#:gateway-configured-p
#:dispatcher-flight-plan-create))
#:gateway-configured-p))
(in-package :passepartout)

7
lisp/core-memory.lisp
View File

@@ -80,6 +80,13 @@
:hash hash :scope scope))))
(unless existing-obj (setf (gethash hash *memory-history*) obj))
(setf (gethash id *memory-store*) obj)
;; Populate embedding vector for new objects
(when (and raw-content (not existing-obj) (not (memory-object-vector obj)))
(handler-case
(setf (memory-object-vector obj)
(embeddings-compute raw-content))
(error (c)
(log-message "INGEST: Embedding deferred: ~a" c))))
id)))
(defvar *memory-snapshots* nil)

15
lisp/gateway-messaging.lisp
View File

@@ -99,11 +99,13 @@
(setf (gethash "telegram" *gateway-registry*)
(list :poll-fn #'telegram-poll
:send-fn #'telegram-send
:default-interval 3))
:default-interval 3
:configured nil))
(setf (gethash "signal" *gateway-registry*)
(list :poll-fn #'signal-poll
:send-fn #'signal-send
:default-interval 5)))
:default-interval 5
:configured nil)))
(defun gateway-configured-p (platform)
"Returns T if a platform has a stored token."
@@ -228,8 +230,13 @@
(in-suite messaging-suite)
(test test-gateway-registry-initialize
"Contract 1: gateway-registry-initialize populates the registry."
"Contract 1: gateway-registry-initialize populates the registry with :configured key."
(clrhash passepartout::*gateway-registry*)
(gateway-registry-initialize)
(is (not (zerop (hash-table-count passepartout::*gateway-registry*))))
(is (getf (gethash "telegram" passepartout::*gateway-registry*) :configured)))
(let ((entry (gethash "telegram" passepartout::*gateway-registry*)))
(is (getf entry :poll-fn))
(is (getf entry :send-fn))
(is (getf entry :default-interval))
;; :configured key exists and is boolean (nil by default until linked)
(is (eq nil (getf entry :configured)))))

209
lisp/gateway-tui-main.lisp
View File

@@ -11,21 +11,51 @@
(push text (st :input-history))
(setf (st :input-hpos) 0)
(setf (st :scroll-offset) 0)
(cond
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
(handler-case
(let* ((*read-eval* t)
(*package* (find-package :passepartout.gateway-tui))
(r (eval (read-from-string (subseq text 6)))))
(add-msg :system (format nil "=> ~s" r)))
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
;; Normal message
(t
(add-msg :user text)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(cond
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
(handler-case
(let* ((*read-eval* t)
(*package* (find-package :passepartout.gateway-tui))
(r (eval (read-from-string (subseq text 6)))))
(add-msg :system (format nil "=> ~s" r)))
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
;; /focus <project> — set project context
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/focus "))
(let ((project (string-trim '(#\Space) (subseq text 7))))
(if (and (fboundp 'focus-project) (> (length project) 0))
(progn (funcall 'focus-project project nil)
(add-msg :system (format nil "Focused on project: ~a" project)))
(add-msg :system "Usage: /focus <project-name>"))))
;; /scope <scope> — change context scope
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/scope "))
(let ((scope-str (string-trim '(#\Space) (subseq text 7))))
(cond
((and (fboundp 'focus-session) (string-equal scope-str "session"))
(funcall 'focus-session)
(add-msg :system "Scope: session"))
((and (fboundp 'focus-project) (string-equal scope-str "project"))
(funcall 'focus-project nil nil)
(add-msg :system "Scope: project"))
((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
(funcall 'focus-memex)
(add-msg :system "Scope: memex"))
(t (add-msg :system "Usage: /scope memex|session|project")))))
;; /unfocus — pop context
((and (>= (length text) 8)
(string-equal (subseq text 0 8) "/unfocus"))
(if (fboundp 'unfocus)
(progn (funcall 'unfocus)
(add-msg :system "Popped context"))
(add-msg :system "Context manager not loaded")))
;; Normal message
(t
(add-msg :user text)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil)
(setf (st :dirty) (list t t t)))))
;; Backspace
@@ -168,19 +198,148 @@
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-tests
(:use :cl :passepartout)
(:use :cl :passepartout :passepartout.gateway-tui)
(:export #:tui-suite))
(in-package :passepartout-tui-tests)
(fiveam:def-suite tui-suite :description "Verification of the TUI parsing and styling logic")
(fiveam:def-suite tui-suite :description "Verification of the TUI model and event handling")
(fiveam:in-suite tui-suite)
(fiveam:test test-tui-connection-drop
"Tier 2 Chaos: Verify that handle-return degrades gracefully when the daemon connection is lost."
(let ((passepartout.gateway-tui::*incoming-msgs* nil)
(passepartout.gateway-tui::*input-buffer* (make-array 5 :element-type 'character :initial-contents "hello" :fill-pointer 5 :adjustable t))
(mock-stream (make-string-output-stream)))
(close mock-stream)
(passepartout.gateway-tui::handle-return mock-stream)
(fiveam:is (member "ERROR: Connection to daemon lost." passepartout.gateway-tui::*incoming-msgs* :test #'string=))))
(fiveam:test test-init-state
"Contract model.1: init-state returns fresh state plist with required keys."
(init-state)
(fiveam:is (eq t (st :running)))
(fiveam:is (eq :chat (st :mode)))
(fiveam:is (eq nil (st :connected)))
(fiveam:is (eq nil (st :stream)))
(fiveam:is (eq nil (st :messages)))
(fiveam:is (eq 0 (st :scroll-offset))))
(fiveam:test test-add-msg
"Contract model.2: add-msg appends a message with role, content, and time."
(init-state)
(add-msg :user "hello")
(let* ((msgs (st :messages))
(msg (first msgs)))
(fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content)))
(fiveam:is (stringp (getf msg :time)))
(fiveam:is (= 5 (length (getf msg :time))))))
(fiveam:test test-add-msg-dirty-flag
"Contract model.2: add-msg sets dirty flags for status and chat."
(init-state)
(setf (st :dirty) (list nil nil nil))
(add-msg :system "boot")
(let ((dirty (st :dirty)))
(fiveam:is (eq t (first dirty)))
(fiveam:is (eq t (second dirty)))
(fiveam:is (eq nil (third dirty)))))
(fiveam:test test-queue-event-roundtrip
"Contract model.3: queue-event + drain-queue preserves events in order."
(init-state)
(queue-event '(:type :key :payload (:ch 13)))
(queue-event '(:type :daemon :payload (:text "hi")))
(let ((evs (drain-queue)))
(fiveam:is (= 2 (length evs)))
(fiveam:is (equal '(:type :key :payload (:ch 13)) (first evs)))
(fiveam:is (equal '(:type :daemon :payload (:text "hi")) (second evs)))
(fiveam:is (null (drain-queue)))))
(fiveam:test test-on-key-enter-sends-user-message
"Contract 1: on-key with Enter extracts input, adds user message, clears buffer."
(init-state)
;; Simulate typing "test"
(dolist (ch '(#\t #\e #\s #\t))
(on-key (char-code ch)))
(fiveam:is (string= "test" (input-string)))
;; Simulate Enter key (char code 13)
(on-key 13)
;; Input buffer should be cleared
(fiveam:is (string= "" (input-string)))
;; A user message should be in the message list
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1))
(let ((last (first msgs)))
(fiveam:is (eq :user (getf last :role)))
(fiveam:is (string= "test" (getf last :content))))))
(fiveam:test test-on-key-eval-command
"Contract 1: on-key handles /eval command and displays result."
(init-state)
;; Type "/eval (+ 1 2)"
(dolist (ch (coerce "/eval (+ 1 2)" 'list))
(on-key (char-code ch)))
(on-key 13)
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1))
(let ((last-msg (first msgs)))
(fiveam:is (eq :system (getf last-msg :role)))
(fiveam:is (search "=> 3" (getf last-msg :content))))))
(fiveam:test test-on-key-backspace
"Contract 1: on-key with Backspace removes last character from buffer."
(init-state)
(dolist (ch '(#\a #\b #\c))
(on-key (char-code ch)))
(fiveam:is (string= "abc" (input-string)))
(on-key 127) ; Backspace
(fiveam:is (string= "ab" (input-string))))
(fiveam:test test-disconnect-daemon
"Contract 4: disconnect-daemon sets connected to nil and adds disconnect message."
(init-state)
(setf (st :connected) t
(st :stream) (make-string-output-stream))
(disconnect-daemon)
(fiveam:is (eq nil (st :connected)))
(fiveam:is (eq nil (st :stream)))
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1))
(fiveam:is (search "Disconnected" (getf (first msgs) :content)))))
(fiveam:test test-on-daemon-msg-handshake
"Contract 2: on-daemon-msg handles handshake action."
(init-state)
(on-daemon-msg '(:type :event :payload (:action :handshake :version "9.9")))
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))
(fiveam:is (search "Connected v9.9" (getf msg :content)))))
(fiveam:test test-on-daemon-msg-text
"Contract 2: on-daemon-msg routes text payload to agent message."
(init-state)
(on-daemon-msg '(:type :event :payload (:text "hello world")))
(let ((msg (first (st :messages))))
(fiveam:is (eq :agent (getf msg :role)))
(fiveam:is (string= "hello world" (getf msg :content)))))
(fiveam:test test-on-key-focus-command
"Contract 1: /focus command parses project name."
(init-state)
(dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch)))
(on-key 13)
(let ((msg (first (st :messages))))
;; When context-manager is loaded, shows "Focused"; otherwise shows "Usage"
(fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command
"Contract 1: /scope command with valid argument."
(init-state)
(dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch)))
(on-key 13)
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command
"Contract 1: /unfocus command dispatches correctly."
(init-state)
(dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch)))
(on-key 13)
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))))

4
lisp/gateway-tui-model.lisp
View File

@@ -2,7 +2,9 @@
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw))
:view-status :view-chat :view-input :redraw
:on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon))
(in-package :passepartout.gateway-tui)
(defvar *state* nil)

67
lisp/system-model-embedding.lisp
View File

@@ -53,9 +53,16 @@
(setf (aref vec i) (float (/ (aref digest i) 255.0) 0.0)))
vec))
(defvar *embedding-backend* nil
"Explicit backend override (nil = use *embedding-provider*).")
(defun embeddings-compute (text)
"Compute an embedding vector for text using the active backend."
(embed-object text))
(defun embed-object (text)
"Embed a single text string using the active backend."
(let* ((selected (or *embedding-provider* :hashing))
(let* ((selected (or *embedding-backend* *embedding-provider* :hashing))
(backend (case selected
(:local #'embedding-backend-local)
(:openai #'embedding-backend-openai)
@@ -74,14 +81,66 @@
(log-message "EMBEDDING: Queued object"))
(defun embed-all-pending ()
"Drain the embedding queue, batch-process all queued objects."
"Drain the embedding queue, store vectors in the store-keyed objects."
(let ((batch (nreverse *embedding-queue*)))
(setf *embedding-queue* nil)
(dolist (item batch)
(handler-case
(let ((text (if (stringp item) item (format nil "~a" item))))
(embed-object text))
(let ((id (getf item :id))
(text (getf item :text)))
(when (and id text)
(let ((vec (embeddings-compute text))
(obj (gethash id *memory-store*)))
(when (and obj vec (not (listp vec)))
(setf (memory-object-vector obj) vec))
(log-message "EMBEDDING: Computed vector for ~a (~d dims)" id (length vec)))))
(error (c)
(log-message "EMBEDDING: Failed to embed object: ~a" c))))))
;; Apply env var override at load time
(let ((provider-env (uiop:getenv "EMBEDDING_PROVIDER")))
(when provider-env
(let ((kw (intern (string-upcase provider-env) :keyword)))
(setf *embedding-provider* kw)
(log-message "EMBEDDING: Set provider to ~a from EMBEDDING_PROVIDER env" kw))))
(log-message "EMBEDDING: Gateway loaded with provider ~a" *embedding-provider*)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-embedding-tests
(:use :cl :passepartout)
(:export #:embedding-suite))
(in-package :passepartout-embedding-tests)
(fiveam:def-suite embedding-suite :description "Embedding gateway verification")
(fiveam:in-suite embedding-suite)
(fiveam:test test-embedding-backend-hashing
"Contract 2: hashing backend produces 8-element float vector."
(let ((vec (embedding-backend-hashing "hello world")))
(fiveam:is (arrayp vec))
(fiveam:is (= 8 (length vec)))
(fiveam:is (every #'numberp (coerce vec 'list)))))
(fiveam:test test-embedding-backend-hashing-deterministic
"Contract 2: same input produces same vector."
(let ((v1 (embedding-backend-hashing "test"))
(v2 (embedding-backend-hashing "test")))
(fiveam:is (equalp v1 v2))))
(fiveam:test test-embeddings-compute
"Contract 1: embeddings-compute returns a float vector."
(let ((vec (embeddings-compute "some text")))
(fiveam:is (arrayp vec))
(fiveam:is (> (length vec) 0))))
(fiveam:test test-embed-queue-and-drain
"Contract 3: embed-all-pending drains queue and stores vectors."
(let ((*embedding-queue* nil))
(embed-queue-object '(:id "test-obj" :text "sample text"))
(fiveam:is (= 1 (length *embedding-queue*)))
(embed-all-pending)
(fiveam:is (null *embedding-queue*))))