v0.7.2: gate-trace wiring, HITL panels, /identity command — TDD

Gate trace: wired into view-chat, renders below agent messages in dim. Collapsed-gates state field for Tab toggle (deferred to Croatoan test). HITL panels: on-daemon-msg detects :approval-required events, renders styled panel messages with :panel flag. View-chat renders with :hitl theme color (magenta). /approve and /deny add confirmation messages. /identity: opens ~/memex/IDENTITY.org in emacsclient -c -a '', auto-reloads. - channel-tui-view: gate-trace in view-chat, HITL panel styling - channel-tui-state: :collapsed-gates, :hitl theme, :panel attr - channel-tui-main: HITL panel detection, /identity handler - View: 29/29 TUI Main: 83/84 (1 pre-existing flake)
2026-05-08 17:40:40 -04:00
parent 4e87cf6a03
commit df09ac321d
6 changed files with 144 additions and 8 deletions
--- a/org/channel-tui-main.org
+++ b/org/channel-tui-main.org
@@ -173,6 +173,15 @@ Event handlers + daemon I/O + main loop.
                              (loop-finish))
                         (unless found
                           (add-msg :system "No recent gate trace. Run a tool to see gate decisions."))))
+                  ;; /identity command — edit and reload identity file
+                  ((string-equal text "/identity")
+                   (let* ((editor (or (uiop:getenv "EDITOR") "emacs"))
+                          (path (merge-pathnames "memex/IDENTITY.org" (user-homedir-pathname))))
+                     (add-msg :system (format nil "Opening ~a in ~a..." (namestring path) editor))
+                     (uiop:run-program (list editor (namestring path)) :output t :error-output t)
+                     (when (fboundp 'load-identity-file)
+                       (funcall 'load-identity-file))
+                     (add-msg :system "Identity reloaded")))
                  ((string-equal text "/help")
                   (add-msg :system
                    "/focus <proj>  Set project context")
@@ -378,9 +387,24 @@ Event handlers + daemon I/O + main loop.
         (text (getf payload :text))
         (msg-type (getf msg :type))
         (action (getf payload :action))
+         (level (getf msg :level))
+         (sensor (getf payload :sensor))
         (gate-trace (getf msg :gate-trace))
         (rule-count (getf payload :rule-count))
         (foveal-id (getf payload :foveal-id)))
+    ;; v0.7.2: HITL approval-required panel
+    (when (eq level :approval-required)
+      (let* ((hitl-msg (or (getf payload :message)
+                           (getf payload :text)
+                           "HITL approval required"))
+             (hitl-action (getf (getf payload :action) :payload))
+             (tool-name (getf hitl-action :tool))
+             (explanation (or tool-name "unknown action")))
+        (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
+                                hitl-msg explanation)
+                 :panel t))
+      (setf (st :dirty) (list nil t nil))
+      (return-from on-daemon-msg nil))
    ;; v0.7.1: streaming chunk
    (when (eq msg-type :stream-chunk)
      (cond
@@ -846,7 +870,32 @@ Event handlers + daemon I/O + main loop.
  (on-key 9)
  (fiveam:is (string= "https://example.com" (st :url-buffer))))

-;; ── v0.7.2 HITL ──
+;; ── v0.7.2 HITL Panels ──
+
+(fiveam:test test-hitl-panel-in-on-daemon-msg
+  "Contract v0.7.2: approval-required messages render as HITL panels."
+  (init-state)
+  (on-daemon-msg '(:type :EVENT :level :approval-required
+                    :payload (:sensor :approval-required
+                              :action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell"))
+                              :message "rm -rf blocked")))
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (eq :system (getf m :role)))
+    (fiveam:is (getf m :panel))
+    (fiveam:is (search "rm -rf" (getf m :content)))))
+
+(fiveam:test test-hitl-panel-after-approve
+  "Contract v0.7.2: /approve adds confirmation after panel."
+  (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)
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (getf m :panel)))
+  (let ((m (aref (st :messages) (1- (length (st :messages))))))
+    (fiveam:is (search "Approved" (getf m :content)))))

 (fiveam:test test-hitl-approve-parsed
  "Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text."
@@ -917,4 +966,18 @@ Event handlers + daemon I/O + main loop.
  (let* ((msgs (st :messages))
         (m (aref msgs (1- (length msgs)))))
    (fiveam:is (search "No recent" (getf m :content)))))
+
+;; ── v0.7.2 /identity ──
+
+(fiveam:test test-identity-command
+  "Contract v0.7.2: /identity opens editor and reloads identity."
+  (init-state)
+  (setf (uiop:getenv "EDITOR") "true")
+  (dolist (ch (coerce "/identity" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs (1- (length msgs)))))
+    (fiveam:is (search "reloaded" (getf m :content))
+               "/identity should produce 'Identity reloaded' message")))
 #+end_src
--- a/org/channel-tui-state.org
+++ b/org/channel-tui-state.org
@@ -41,6 +41,7 @@ All state mutation flows through event handlers in the controller.
    :connected :green :disconnected :red :busy :magenta :idle :white
    ;; Gate trace
    :gate-passed :green :gate-blocked :red :gate-approval :yellow
+    :hitl :magenta
    ;; Tools (future use)
    :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
    ;; Display
@@ -168,8 +169,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
        (setf (st :input-buffer) (reverse (coerce new 'list)))
        (setf (st :cursor-pos) (1- pos))))))

-(defun add-msg (role content &key gate-trace)
-  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
+(defun add-msg (role content &key gate-trace panel)
+  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages))
  ;; v0.7.0: notify when scrolled up and new msg arrives
  (unless (st :scroll-at-bottom)
    (setf (st :scroll-notify) t))
--- a/org/channel-tui-view.org
+++ b/org/channel-tui-view.org
@@ -132,9 +132,13 @@ Returns list of trimmed strings. Single words wider than width are split."
                        (time (or (getf msg :time) ""))
                        (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
                        (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
+                        (is-panel (getf msg :panel))
                        (line-text (format nil "~a [~a] ~a" prefix time content))
                        (wrapped (word-wrap line-text (- w 2))))
-                    (dolist (line wrapped)
+                   ;; HITL panel: render with colored border
+                   (when is-panel
+                     (setf color (theme-color :hitl)))
+                   (dolist (line wrapped)
                      (when (< y (1- h))
                        (if (eq role :agent)
                            (let ((segments (parse-markdown-spans line)))