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

v0.7.2: HITL panel collapse on approve/deny — TDD

Browse Source 
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:
Amr Gharbeia
2026-05-08 20:51:49 -04:00
parent 7c84dbfacb
commit 93a38d5308
4 changed files with 84 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
lisp/channel-tui-main.lisp
View File

@@ -125,16 +125,18 @@
;; /help command
((and (>= (length text) 9)
(string-equal (subseq text 0 9) "/approve "))
(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))))
(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))
(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))))
(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))
(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)

5
lisp/channel-tui-view.lisp
View File

@@ -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)

48
org/channel-tui-main.org
View File

@@ -159,16 +159,18 @@ Event handlers + daemon I/O + main loop.
;; /help command
((and (>= (length text) 9)
(string-equal (subseq text 0 9) "/approve "))
(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))))
(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))
(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))))
(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))
(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)

5
org/channel-tui-view.org
View File

@@ -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)