v0.7.2: HITL panel collapse on approve/deny — TDD
resolve-hitl-panel marks the most recent panel message with :panel-resolved (:approved or :denied) and writes back to the message vector. View-chat renders resolved panels with dimmed color instead of :hitl theme color. /approve and /deny handlers call resolve-hitl-panel after sending structured events to the daemon. Confirmation messages now use checkmark/crossmark prefixes. - channel-tui-main: resolve-hitl-panel fn, wired into handlers - channel-tui-view: is-resolved check for panel dimming - +2 tests: panel-after-approve, panel-after-deny - TUI Main: 88/89 (1 pre-existing flake)
This commit is contained in:
@@ -128,13 +128,15 @@
|
||||
(let ((token (string-trim '(#\Space) (subseq text 9))))
|
||||
(send-daemon (list :type :event :payload
|
||||
(list :action :hitl-respond :token token :decision :approved)))
|
||||
(add-msg :system (format nil "Approved: ~a" token))))
|
||||
(add-msg :system (format nil "✓ Approved: ~a" token))
|
||||
(resolve-hitl-panel :approved)))
|
||||
((and (>= (length text) 6)
|
||||
(string-equal (subseq text 0 6) "/deny "))
|
||||
(let ((token (string-trim '(#\Space) (subseq text 6))))
|
||||
(send-daemon (list :type :event :payload
|
||||
(list :action :hitl-respond :token token :decision :denied)))
|
||||
(add-msg :system (format nil "Denied: ~a" token))))
|
||||
(add-msg :system (format nil "✗ Denied: ~a" token))
|
||||
(resolve-hitl-panel :denied)))
|
||||
;; /help command
|
||||
;; /why command — show last gate trace
|
||||
((string-equal text "/why")
|
||||
@@ -506,6 +508,17 @@
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
|
||||
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
|
||||
(defun resolve-hitl-panel (decision)
|
||||
"Mark the most recent HITL panel message as resolved with DECISION."
|
||||
(loop for i from (1- (length (st :messages))) downto 0
|
||||
for m = (aref (st :messages) i)
|
||||
when (and (getf m :panel) (not (getf m :panel-resolved)))
|
||||
do (setf (getf m :panel-resolved) decision)
|
||||
(setf (aref (st :messages) i) m)
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(loop-finish)))
|
||||
|
||||
(defun on-daemon-msg (msg)
|
||||
(let* ((payload (getf msg :payload))
|
||||
(text (getf payload :text))
|
||||
@@ -996,18 +1009,33 @@
|
||||
(fiveam:is (search "rm -rf" (getf m :content)))))
|
||||
|
||||
(fiveam:test test-hitl-panel-after-approve
|
||||
"Contract v0.7.2: /approve adds confirmation after panel."
|
||||
"Contract v0.7.2: /approve adds confirmation and marks panel resolved."
|
||||
(init-state)
|
||||
(on-daemon-msg '(:type :EVENT :level :approval-required
|
||||
:payload (:sensor :approval-required :message "test")))
|
||||
(dolist (ch (coerce "/approve HITL-test" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
;; Panel message (index 0) should be marked resolved
|
||||
(let ((m (aref (st :messages) 0)))
|
||||
(fiveam:is (getf m :panel)))
|
||||
(fiveam:is (getf m :panel))
|
||||
(fiveam:is (eq :approved (getf m :panel-resolved))))
|
||||
;; Last message should be the approval confirmation
|
||||
(let ((m (aref (st :messages) (1- (length (st :messages))))))
|
||||
(fiveam:is (search "Approved" (getf m :content)))))
|
||||
|
||||
(fiveam:test test-hitl-panel-after-deny
|
||||
"Contract v0.7.2: /deny marks panel as denied."
|
||||
(init-state)
|
||||
(on-daemon-msg '(:type :EVENT :level :approval-required
|
||||
:payload (:sensor :approval-required :message "blocked")))
|
||||
(dolist (ch (coerce "/deny HITL-deny" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(let ((m (aref (st :messages) 0)))
|
||||
(fiveam:is (getf m :panel))
|
||||
(fiveam:is (eq :denied (getf m :panel-resolved)))))
|
||||
|
||||
(fiveam:test test-hitl-approve-parsed
|
||||
"Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text."
|
||||
(init-state)
|
||||
|
||||
@@ -85,11 +85,14 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
|
||||
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
|
||||
(is-panel (getf msg :panel))
|
||||
(is-resolved (getf msg :panel-resolved))
|
||||
(line-text (format nil "~a [~a] ~a" prefix time content))
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
;; HITL panel: render with colored border
|
||||
(when is-panel
|
||||
(setf color (theme-color :hitl)))
|
||||
(setf color (if is-resolved
|
||||
(theme-color :dim)
|
||||
(theme-color :hitl))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y (1- h))
|
||||
(if (eq role :agent)
|
||||
|
||||
@@ -162,13 +162,15 @@ Event handlers + daemon I/O + main loop.
|
||||
(let ((token (string-trim '(#\Space) (subseq text 9))))
|
||||
(send-daemon (list :type :event :payload
|
||||
(list :action :hitl-respond :token token :decision :approved)))
|
||||
(add-msg :system (format nil "Approved: ~a" token))))
|
||||
(add-msg :system (format nil "✓ Approved: ~a" token))
|
||||
(resolve-hitl-panel :approved)))
|
||||
((and (>= (length text) 6)
|
||||
(string-equal (subseq text 0 6) "/deny "))
|
||||
(let ((token (string-trim '(#\Space) (subseq text 6))))
|
||||
(send-daemon (list :type :event :payload
|
||||
(list :action :hitl-respond :token token :decision :denied)))
|
||||
(add-msg :system (format nil "Denied: ~a" token))))
|
||||
(add-msg :system (format nil "✗ Denied: ~a" token))
|
||||
(resolve-hitl-panel :denied)))
|
||||
;; /help command
|
||||
;; /why command — show last gate trace
|
||||
((string-equal text "/why")
|
||||
@@ -540,6 +542,17 @@ Event handlers + daemon I/O + main loop.
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
|
||||
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
|
||||
(defun resolve-hitl-panel (decision)
|
||||
"Mark the most recent HITL panel message as resolved with DECISION."
|
||||
(loop for i from (1- (length (st :messages))) downto 0
|
||||
for m = (aref (st :messages) i)
|
||||
when (and (getf m :panel) (not (getf m :panel-resolved)))
|
||||
do (setf (getf m :panel-resolved) decision)
|
||||
(setf (aref (st :messages) i) m)
|
||||
(setf (st :dirty) (list nil t nil))
|
||||
(loop-finish)))
|
||||
|
||||
(defun on-daemon-msg (msg)
|
||||
(let* ((payload (getf msg :payload))
|
||||
(text (getf payload :text))
|
||||
@@ -1043,18 +1056,33 @@ Event handlers + daemon I/O + main loop.
|
||||
(fiveam:is (search "rm -rf" (getf m :content)))))
|
||||
|
||||
(fiveam:test test-hitl-panel-after-approve
|
||||
"Contract v0.7.2: /approve adds confirmation after panel."
|
||||
"Contract v0.7.2: /approve adds confirmation and marks panel resolved."
|
||||
(init-state)
|
||||
(on-daemon-msg '(:type :EVENT :level :approval-required
|
||||
:payload (:sensor :approval-required :message "test")))
|
||||
(dolist (ch (coerce "/approve HITL-test" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
;; Panel message (index 0) should be marked resolved
|
||||
(let ((m (aref (st :messages) 0)))
|
||||
(fiveam:is (getf m :panel)))
|
||||
(fiveam:is (getf m :panel))
|
||||
(fiveam:is (eq :approved (getf m :panel-resolved))))
|
||||
;; Last message should be the approval confirmation
|
||||
(let ((m (aref (st :messages) (1- (length (st :messages))))))
|
||||
(fiveam:is (search "Approved" (getf m :content)))))
|
||||
|
||||
(fiveam:test test-hitl-panel-after-deny
|
||||
"Contract v0.7.2: /deny marks panel as denied."
|
||||
(init-state)
|
||||
(on-daemon-msg '(:type :EVENT :level :approval-required
|
||||
:payload (:sensor :approval-required :message "blocked")))
|
||||
(dolist (ch (coerce "/deny HITL-deny" 'list))
|
||||
(on-key (char-code ch)))
|
||||
(on-key 13)
|
||||
(let ((m (aref (st :messages) 0)))
|
||||
(fiveam:is (getf m :panel))
|
||||
(fiveam:is (eq :denied (getf m :panel-resolved)))))
|
||||
|
||||
(fiveam:test test-hitl-approve-parsed
|
||||
"Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text."
|
||||
(init-state)
|
||||
|
||||
@@ -133,11 +133,14 @@ Returns list of trimmed strings. Single words wider than width are split."
|
||||
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
|
||||
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
|
||||
(is-panel (getf msg :panel))
|
||||
(is-resolved (getf msg :panel-resolved))
|
||||
(line-text (format nil "~a [~a] ~a" prefix time content))
|
||||
(wrapped (word-wrap line-text (- w 2))))
|
||||
;; HITL panel: render with colored border
|
||||
(when is-panel
|
||||
(setf color (theme-color :hitl)))
|
||||
(setf color (if is-resolved
|
||||
(theme-color :dim)
|
||||
(theme-color :hitl))))
|
||||
(dolist (line wrapped)
|
||||
(when (< y (1- h))
|
||||
(if (eq role :agent)
|
||||
|
||||
Reference in New Issue
Block a user