diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index 91cca43..57eaa60 100644 --- a/lisp/core-defpackage.lisp +++ b/lisp/core-defpackage.lisp @@ -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) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index 0acea25..42d7dc1 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -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) diff --git a/lisp/gateway-messaging.lisp b/lisp/gateway-messaging.lisp index e344353..aabc484 100644 --- a/lisp/gateway-messaging.lisp +++ b/lisp/gateway-messaging.lisp @@ -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))))) diff --git a/lisp/gateway-tui-main.lisp b/lisp/gateway-tui-main.lisp index f7824e2..fa3c950 100644 --- a/lisp/gateway-tui-main.lisp +++ b/lisp/gateway-tui-main.lisp @@ -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 — 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 ")))) + ;; /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))))) diff --git a/lisp/gateway-tui-model.lisp b/lisp/gateway-tui-model.lisp index bf35b39..1aef21a 100644 --- a/lisp/gateway-tui-model.lisp +++ b/lisp/gateway-tui-model.lisp @@ -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) diff --git a/lisp/system-model-embedding.lisp b/lisp/system-model-embedding.lisp index c9de226..8f1a42a 100644 --- a/lisp/system-model-embedding.lisp +++ b/lisp/system-model-embedding.lisp @@ -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*)))) diff --git a/org/core-defpackage.org b/org/core-defpackage.org index 4d60167..6108c36 100644 --- a/org/core-defpackage.org +++ b/org/core-defpackage.org @@ -30,15 +30,10 @@ The package definition. All public symbols are exported here. #: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 @@ -48,17 +43,10 @@ The package definition. All public symbols are exported here. #: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 @@ -74,14 +62,7 @@ The package definition. All public symbols are exported here. #: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 @@ -90,15 +71,12 @@ The package definition. All public symbols are exported here. #: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 @@ -113,13 +91,10 @@ The package definition. All public symbols are exported here. #: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* @@ -130,6 +105,7 @@ The package definition. All public symbols are exported here. #:embed-queue-object #:embed-object #:embed-all-pending + #:embedding-backend-hashing #:embeddings-compute #:skill #:skill-name @@ -140,12 +116,6 @@ The package definition. All public symbols are exported here. #: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 @@ -155,11 +125,8 @@ The package definition. All public symbols are exported here. #: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 @@ -169,13 +136,9 @@ The package definition. All public symbols are exported here. #: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 @@ -187,13 +150,7 @@ The package definition. All public symbols are exported here. #: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 @@ -201,7 +158,6 @@ The package definition. All public symbols are exported here. #:vault-get-secret #:vault-set-secret #:memory-objects-by-attribute - #:find-headline-missing-id #:gateway-cli-input #:repl-eval #:repl-inspect @@ -215,8 +171,7 @@ The package definition. All public symbols are exported here. #:gateway-registry-initialize #:messaging-link #:messaging-unlink - #:gateway-configured-p - #:dispatcher-flight-plan-create)) + #:gateway-configured-p)) #+end_src ** Package Implementation diff --git a/org/core-memory.org b/org/core-memory.org index b538dd7..5341f3b 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -37,7 +37,8 @@ The tradeoff is memory usage: each snapshot is a deep copy of every object in ac ** Contract 1. (ingest-ast ast &key scope): stores AST nodes in ~*memory-store*~. - Detaches children, gives each an ID, computes Merkle hash. Returns the + Detaches children, gives each an ID, computes Merkle hash, and + populates the ~:vector~ slot via ~embeddings-compute~. Returns the root ID string. 2. (memory-object-hash object): returns the SHA-256 Merkle hash of the object's content. Hash is deterministic — same content → same hash. @@ -228,6 +229,13 @@ Returns the ID of the root node. :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))) #+end_src diff --git a/org/gateway-messaging.org b/org/gateway-messaging.org index c80040d..8071527 100644 --- a/org/gateway-messaging.org +++ b/org/gateway-messaging.org @@ -20,7 +20,7 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code ** Contract 1. (gateway-registry-initialize): populates ~*gateway-registry*~ with - ~:configured~ status per platform based on env vars. + ~:configured~ key per platform (boolean, set when linked). 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. @@ -142,11 +142,13 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code (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." @@ -292,9 +294,14 @@ This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code (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))))) #+end_src diff --git a/org/gateway-tui-main.org b/org/gateway-tui-main.org index 044b5f9..8ecdf31 100644 --- a/org/gateway-tui-main.org +++ b/org/gateway-tui-main.org @@ -7,17 +7,20 @@ 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. +1. (on-key ch): dispatches key presses: Enter triggers send (extracts + input buffer, pushes history, sends to daemon, clears buffer), + ~/eval ~ evaluates a Lisp expression, ~/focus ~ switches + project context, ~/scope ~ changes context scope, + ~/unfocus~ pops context, Backspace deletes, arrows scroll chat + and history. Non-printable keys are ignored. 2. (on-daemon-msg msg): processes inbound daemon messages. Routes - responses to chat display, routes errors to log. + text responses to chat display (:agent), handshake to system + messages, routes errors to log via ~log-message~. 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~. +4. (tui-main): the main loop — connects to daemon, initializes + Croatoan windows, optionally starts Swank REPL, runs + render/input event loop at ~30fps. ** Event Handlers #+begin_src lisp @@ -34,21 +37,51 @@ Event handlers + daemon I/O + main loop. (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 — 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 ")))) + ;; /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 @@ -204,20 +237,149 @@ Event handlers + daemon I/O + main loop. (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 - "Contract 4: handle-return enqueues error on connection loss." - (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))))) #+end_src diff --git a/org/gateway-tui-model.org b/org/gateway-tui-model.org index 89550a2..598241b 100644 --- a/org/gateway-tui-model.org +++ b/org/gateway-tui-model.org @@ -22,7 +22,9 @@ All state mutation flows through event handlers in the controller. (: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) diff --git a/org/gateway-tui-view.org b/org/gateway-tui-view.org index ab3296a..3ae93f9 100644 --- a/org/gateway-tui-view.org +++ b/org/gateway-tui-view.org @@ -10,12 +10,13 @@ State is read via ~(st :key)~ — no mutation here. 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). +2. (view-chat win h): renders the scrolled chat message list. Takes + window and available height. 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. +4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~ + flags (status, chat, input). Minimizes terminal writes. ** Status Bar #+begin_src lisp diff --git a/org/system-model-embedding.org b/org/system-model-embedding.org index 90f55cf..cf7db24 100644 --- a/org/system-model-embedding.org +++ b/org/system-model-embedding.org @@ -88,9 +88,16 @@ This replaces the old ~system-embedding-gateway~ with the same logic but renamed ** Object embedding and queuing #+begin_src lisp +(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) @@ -109,15 +116,80 @@ This replaces the old ~system-embedding-gateway~ with the same logic but renamed (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*) #+end_src + +* Contract + +1. (embeddings-compute text): produces a vector (single-float array) for + any text string using the active backend (~*embedding-backend*~ or + ~*embedding-provider*~). +2. (embedding-backend-hashing text): zero-dependency fallback. Returns + an 8-element single-float vector deterministically from SHA-256. +3. (embed-all-pending): drains ~*embedding-queue*~, computes vectors for + all queued objects, and stores them in ~*memory-store*~ entries. + +* Test Suite +#+begin_src lisp +(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*)))) +#+end_src