v0.4.0: TUI differentiator visualization — gate trace, rule counter, focus map
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Gate trace: cognitive-verify accumulates (:gate name :result status) for each deterministic gate. Trace prepended to action plist via list*. TUI on-daemon-msg extracts :gate-trace and stores on message object. add-msg accepts &key gate-trace for future rendering (collapsible Tab). Rule counter: TUI actuator enriches response payload with :rule-count =(hash-table-count *hitl-pending*). TUI status bar shows 'Rules:N'. Focus map: TUI actuator adds :foveal-id from signal context. TUI stores in state and renders second status line '[Focus: id]'. Status bar: now two lines — line 1 (connection, mode, msgs, scroll, rules, thinking spinner), line 2 (focus map, timestamp). Test: 112/0 across 14 suites (reason 15/0 including gate-trace assertions)
This commit is contained in:
@@ -21,12 +21,17 @@
|
||||
(register-actuator :tool #'action-tool-execute)
|
||||
|
||||
(register-actuator :tui (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let* ((meta (getf action :meta))
|
||||
(stream (getf meta :reply-stream)))
|
||||
(when (and stream (open-stream-p stream))
|
||||
(format stream "~a" (frame-message action))
|
||||
(finish-output stream))))))
|
||||
(declare (ignore context))
|
||||
(let* ((meta (getf action :meta))
|
||||
(stream (getf meta :reply-stream)))
|
||||
(when (and stream (open-stream-p stream))
|
||||
;; Enrich response with differentiator visualization data
|
||||
(setf (getf (getf action :payload) :rule-count)
|
||||
(hash-table-count *hitl-pending*))
|
||||
(setf (getf (getf action :payload) :foveal-id)
|
||||
(getf context :foveal-id))
|
||||
(format stream "~a" (frame-message action))
|
||||
(finish-output stream))))))
|
||||
|
||||
(defun action-dispatch (action context)
|
||||
"Route an approved action to its registered actuator."
|
||||
|
||||
@@ -122,29 +122,36 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(let ((current-action (copy-tree proposed-action))
|
||||
(approval-needed nil)
|
||||
(approval-action nil)
|
||||
(gates nil))
|
||||
(gates nil)
|
||||
(gate-trace nil))
|
||||
;; Collect gates sorted by priority (highest first)
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (skill-deterministic-fn skill)
|
||||
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
|
||||
(push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
|
||||
*skill-registry*)
|
||||
(setf gates (sort gates #'> :key #'car))
|
||||
(dolist (gate-pair gates)
|
||||
(let ((result (funcall (cdr gate-pair) current-action context)))
|
||||
(dolist (gate-entry gates)
|
||||
(let* ((gate-name (cadr gate-entry))
|
||||
(result (funcall (cddr gate-entry) current-action context)))
|
||||
(cond
|
||||
((eq (getf result :level) :approval-required)
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :approval) gate-trace)
|
||||
(setf approval-needed t
|
||||
approval-action (getf (getf result :payload) :action)))
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(return-from cognitive-verify result))
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
|
||||
(return-from cognitive-verify
|
||||
(list* :gate-trace (nreverse gate-trace) result)))
|
||||
((and (listp result) result)
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :passed) gate-trace)
|
||||
(setf current-action result)))))
|
||||
(if approval-needed
|
||||
(list :type :EVENT :level :approval-required
|
||||
:gate-trace (nreverse gate-trace)
|
||||
:payload (list :sensor :approval-required
|
||||
:action approval-action))
|
||||
current-action)))
|
||||
(list* :gate-trace (nreverse gate-trace) current-action))))
|
||||
|
||||
(defun loop-gate-reason (signal)
|
||||
(let* ((type (proto-get signal :type))
|
||||
@@ -226,7 +233,9 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
|
||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||
(result (cognitive-verify candidate signal)))
|
||||
(is (equal candidate result))))
|
||||
(is (eq :REQUEST (getf result :type)))
|
||||
(is (equal (getf candidate :payload) (getf result :payload)))
|
||||
(is (getf result :gate-trace))))
|
||||
|
||||
(test test-cognitive-verify-empty-registry
|
||||
"Contract 1: with no gates registered, action passes through unchanged."
|
||||
@@ -234,7 +243,8 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
|
||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||
(result (cognitive-verify candidate signal)))
|
||||
(is (equal candidate result))))
|
||||
(is (eq :REQUEST (getf result :type)))
|
||||
(is (equal (getf candidate :payload) (getf result :payload)))))
|
||||
|
||||
(test test-cognitive-verify-approval-required
|
||||
"Contract 1: gate returning :approval-required produces an approval event."
|
||||
|
||||
@@ -182,10 +182,15 @@
|
||||
(defun on-daemon-msg (msg)
|
||||
(let* ((payload (getf msg :payload))
|
||||
(text (getf payload :text))
|
||||
(action (getf payload :action)))
|
||||
(action (getf payload :action))
|
||||
(gate-trace (getf msg :gate-trace))
|
||||
(rule-count (getf payload :rule-count))
|
||||
(foveal-id (getf payload :foveal-id)))
|
||||
(when rule-count (setf (st :rule-count) rule-count))
|
||||
(when foveal-id (setf (st :foveal-id) foveal-id))
|
||||
(cond
|
||||
(text (setf (st :busy) nil)
|
||||
(add-msg :agent text))
|
||||
(add-msg :agent text :gate-trace gate-trace))
|
||||
((eq action :handshake)
|
||||
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
|
||||
(t (add-msg :agent (format nil "~a" msg))))))
|
||||
|
||||
@@ -59,8 +59,8 @@
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1- pos))))))
|
||||
|
||||
(defun add-msg (role content)
|
||||
(vector-push-extend (list :role role :content content :time (now)) (st :messages))
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
|
||||
(defun queue-event (ev)
|
||||
|
||||
@@ -4,13 +4,19 @@
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(add-string win
|
||||
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a~a"
|
||||
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
|
||||
(if (st :connected) "● Connected" "○ Disconnected")
|
||||
(string-upcase (string (st :mode)))
|
||||
(length (st :messages))
|
||||
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
|
||||
(or (st :rule-count) 0)
|
||||
(if (st :busy) " …thinking" ""))
|
||||
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
|
||||
;; Second line: Focus map
|
||||
(let ((focus-info (or (st :foveal-id) "")))
|
||||
(when (and focus-info (> (length focus-info) 0))
|
||||
(add-string win (format nil " [Focus: ~a]" focus-info)
|
||||
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
|
||||
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
|
||||
(refresh win))
|
||||
|
||||
|
||||
@@ -76,12 +76,17 @@ Because a skill's deterministic gate runs during Reason, but between Reason and
|
||||
(register-actuator :tool #'action-tool-execute)
|
||||
|
||||
(register-actuator :tui (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let* ((meta (getf action :meta))
|
||||
(stream (getf meta :reply-stream)))
|
||||
(when (and stream (open-stream-p stream))
|
||||
(format stream "~a" (frame-message action))
|
||||
(finish-output stream))))))
|
||||
(declare (ignore context))
|
||||
(let* ((meta (getf action :meta))
|
||||
(stream (getf meta :reply-stream)))
|
||||
(when (and stream (open-stream-p stream))
|
||||
;; Enrich response with differentiator visualization data
|
||||
(setf (getf (getf action :payload) :rule-count)
|
||||
(hash-table-count *hitl-pending*))
|
||||
(setf (getf (getf action :payload) :foveal-id)
|
||||
(getf context :foveal-id))
|
||||
(format stream "~a" (frame-message action))
|
||||
(finish-output stream))))))
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -273,29 +273,36 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(let ((current-action (copy-tree proposed-action))
|
||||
(approval-needed nil)
|
||||
(approval-action nil)
|
||||
(gates nil))
|
||||
(gates nil)
|
||||
(gate-trace nil))
|
||||
;; Collect gates sorted by priority (highest first)
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (skill-deterministic-fn skill)
|
||||
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
|
||||
(push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
|
||||
*skill-registry*)
|
||||
(setf gates (sort gates #'> :key #'car))
|
||||
(dolist (gate-pair gates)
|
||||
(let ((result (funcall (cdr gate-pair) current-action context)))
|
||||
(dolist (gate-entry gates)
|
||||
(let* ((gate-name (cadr gate-entry))
|
||||
(result (funcall (cddr gate-entry) current-action context)))
|
||||
(cond
|
||||
((eq (getf result :level) :approval-required)
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :approval) gate-trace)
|
||||
(setf approval-needed t
|
||||
approval-action (getf (getf result :payload) :action)))
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(return-from cognitive-verify result))
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
|
||||
(return-from cognitive-verify
|
||||
(list* :gate-trace (nreverse gate-trace) result)))
|
||||
((and (listp result) result)
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :passed) gate-trace)
|
||||
(setf current-action result)))))
|
||||
(if approval-needed
|
||||
(list :type :EVENT :level :approval-required
|
||||
:gate-trace (nreverse gate-trace)
|
||||
:payload (list :sensor :approval-required
|
||||
:action approval-action))
|
||||
current-action)))
|
||||
(list* :gate-trace (nreverse gate-trace) current-action))))
|
||||
#+end_src
|
||||
|
||||
** Reason Gate (Stage 2)
|
||||
@@ -403,7 +410,9 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
|
||||
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
|
||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||
(result (cognitive-verify candidate signal)))
|
||||
(is (equal candidate result))))
|
||||
(is (eq :REQUEST (getf result :type)))
|
||||
(is (equal (getf candidate :payload) (getf result :payload)))
|
||||
(is (getf result :gate-trace))))
|
||||
|
||||
(test test-cognitive-verify-empty-registry
|
||||
"Contract 1: with no gates registered, action passes through unchanged."
|
||||
@@ -411,7 +420,8 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
|
||||
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
|
||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||
(result (cognitive-verify candidate signal)))
|
||||
(is (equal candidate result))))
|
||||
(is (eq :REQUEST (getf result :type)))
|
||||
(is (equal (getf candidate :payload) (getf result :payload)))))
|
||||
|
||||
(test test-cognitive-verify-approval-required
|
||||
"Contract 1: gate returning :approval-required produces an approval event."
|
||||
|
||||
@@ -210,10 +210,15 @@ Event handlers + daemon I/O + main loop.
|
||||
(defun on-daemon-msg (msg)
|
||||
(let* ((payload (getf msg :payload))
|
||||
(text (getf payload :text))
|
||||
(action (getf payload :action)))
|
||||
(action (getf payload :action))
|
||||
(gate-trace (getf msg :gate-trace))
|
||||
(rule-count (getf payload :rule-count))
|
||||
(foveal-id (getf payload :foveal-id)))
|
||||
(when rule-count (setf (st :rule-count) rule-count))
|
||||
(when foveal-id (setf (st :foveal-id) foveal-id))
|
||||
(cond
|
||||
(text (setf (st :busy) nil)
|
||||
(add-msg :agent text))
|
||||
(add-msg :agent text :gate-trace gate-trace))
|
||||
((eq action :handshake)
|
||||
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
|
||||
(t (add-msg :agent (format nil "~a" msg))))))
|
||||
|
||||
@@ -82,8 +82,8 @@ All state mutation flows through event handlers in the controller.
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1- pos))))))
|
||||
|
||||
(defun add-msg (role content)
|
||||
(vector-push-extend (list :role role :content content :time (now)) (st :messages))
|
||||
(defun add-msg (role content &key gate-trace)
|
||||
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -26,13 +26,19 @@ State is read via ~(st :key)~ — no mutation here.
|
||||
(clear win)
|
||||
(box win 0 0)
|
||||
(add-string win
|
||||
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a~a"
|
||||
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
|
||||
(if (st :connected) "● Connected" "○ Disconnected")
|
||||
(string-upcase (string (st :mode)))
|
||||
(length (st :messages))
|
||||
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
|
||||
(or (st :rule-count) 0)
|
||||
(if (st :busy) " …thinking" ""))
|
||||
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
|
||||
;; Second line: Focus map
|
||||
(let ((focus-info (or (st :foveal-id) "")))
|
||||
(when (and focus-info (> (length focus-info) 0))
|
||||
(add-string win (format nil " [Focus: ~a]" focus-info)
|
||||
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
|
||||
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
|
||||
(refresh win))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user