Fix TUI spinner bleed-through; add streaming diagnostics
ober
a0aacd3186770e6be4f4371c5424f8a7a0cf021f
--- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -9,10 +9,10 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std text json) (std net request) (std net tls-rustls) - (std net tcp) (std misc string) (std misc retry) - (jcode core log) (jcode core message) (jerboa core) - (jerboa runtime)) + (std text json) (except (std net request) http-post-stream) + (std net tls-rustls) (std net tcp) (std misc string) + (std misc retry) (jcode core log) (jcode core message) + (jerboa core) (jerboa runtime)) (def logger (make-logger "provider")) (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) (def (retryable-error? e) --- a/lib/jcode/ui/tui.sls +++ b/lib/jcode/ui/tui.sls @@ -516,16 +516,28 @@ (app-state-dirty?-set! state #t))))) (def (tui-stream-token! state token) "Handle a streaming token from the LLM — called from agent thread." - (let ([buf (string-append - (app-state-stream-buf state) - token)]) - (app-state-stream-buf-set! state buf) - (update-last-assistant! state buf) - (app-state-scroll-offset-set! state 0) - (app-state-dirty?-set! state #t))) + (let ([buf (app-state-stream-buf state)]) + (tui-log + "tui-stream-token: buf-len=~a token-len=~a" + (string-length buf) + (string-length token)) + (when (and (string-empty? buf) + (let ([msgs (app-state-messages state)]) + (or (null? msgs) + (not (eq? (msg-block-role (car (reverse msgs))) + 'assistant))))) + (tui-log + "tui-stream-token: adding new assistant block (last msg is not assistant)") + (add-message! state (msg-block-assistant ""))) + (let ([new-buf (string-append buf token)]) + (app-state-stream-buf-set! state new-buf) + (update-last-assistant! state new-buf) + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t)))) (def (tui-tool-event! state event name args) (case event [(start) + (app-state-stream-buf-set! state "") (let ([meta (tool-event-metadata name args)]) (add-message! state (msg-block-tool name 'running "" meta))) (let ([tc (app-state-tool-counts state)]) @@ -581,12 +593,22 @@ [#t '()])) (def (update-last-assistant! state content) "Update the last assistant message block with new content." - (let ([msgs (app-state-messages state)]) - (when (pair? msgs) - (let ([last-msg (car (reverse msgs))]) - (when (eq? (msg-block-role last-msg) 'assistant) - (msg-block-content-set! last-msg content) - (reflow-message! last-msg (msg-area-width state))))))) + (let loop ([msgs (reverse (app-state-messages state))] + [skipped 0]) + (if (pair? msgs) + (let ([m (car msgs)]) + (if (eq? (msg-block-role m) 'assistant) + (begin + (tui-log + "update-last-assistant: found at skip=~a content-len=~a" + skipped + (string-length content)) + (msg-block-content-set! m content) + (reflow-message! m (msg-area-width state))) + (loop (cdr msgs) (+ skipped 1)))) + (tui-log + "update-last-assistant: NO assistant block found! msgs=~a" + (length (app-state-messages state)))))) (def (add-message! state msg) (reflow-message! msg (msg-area-width state)) (tui-log "add-message: role=~a height=~a lines=~a width=~a" @@ -671,7 +693,12 @@ [fg (face-fg-attr 'spinner)] [bg (face-bg-attr 'default)] [y (max 0 (- (input-y state) 1))] + [w (msg-area-width state)] [text (string-append " " frame " thinking...")]) + (let clear ([col 0]) + (when (< col w) + (tb-change-cell! col y (char->integer #\space) bg bg) + (clear (+ col 1)))) (tb-print! 0 y fg bg text))) (def (make-prompt-text) (let ([model (or (current-model-override) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -8,7 +8,7 @@ provider-model) (import :std/text/json - :std/net/request + (except (std net request) http-post-stream) :std/net/tls-rustls :std/net/tcp :std/misc/string --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -568,15 +568,26 @@ (def (tui-stream-token! state token) "Handle a streaming token from the LLM — called from agent thread." - (let ((buf (string-append (app-state-stream-buf state) token))) - (app-state-stream-buf-set! state buf) - (update-last-assistant! state buf) - (app-state-scroll-offset-set! state 0) - (app-state-dirty?-set! state #t))) + (let ((buf (app-state-stream-buf state))) + (tui-log "tui-stream-token: buf-len=~a token-len=~a" (string-length buf) (string-length token)) + ;; If buf was reset (tools ran), add a new assistant block for this round + (when (and (string-empty? buf) + (let ((msgs (app-state-messages state))) + (or (null? msgs) + (not (eq? (msg-block-role (car (reverse msgs))) 'assistant))))) + (tui-log "tui-stream-token: adding new assistant block (last msg is not assistant)") + (add-message! state (msg-block-assistant ""))) + (let ((new-buf (string-append buf token))) + (app-state-stream-buf-set! state new-buf) + (update-last-assistant! state new-buf) + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t)))) (def (tui-tool-event! state event name args) (case event ((start) + ;; Reset stream buffer so next round creates a fresh assistant block + (app-state-stream-buf-set! state "") (let ((meta (tool-event-metadata name args))) (add-message! state (msg-block-tool name 'running "" meta))) ;; Update tool counts @@ -628,12 +639,16 @@ (def (update-last-assistant! state content) "Update the last assistant message block with new content." - (let ((msgs (app-state-messages state))) - (when (pair? msgs) - (let ((last-msg (car (reverse msgs)))) - (when (eq? (msg-block-role last-msg) 'assistant) - (msg-block-content-set! last-msg content) - (reflow-message! last-msg (msg-area-width state))))))) + (let loop ((msgs (reverse (app-state-messages state))) (skipped 0)) + (if (pair? msgs) + (let ((m (car msgs))) + (if (eq? (msg-block-role m) 'assistant) + (begin + (tui-log "update-last-assistant: found at skip=~a content-len=~a" skipped (string-length content)) + (msg-block-content-set! m content) + (reflow-message! m (msg-area-width state))) + (loop (cdr msgs) (+ skipped 1)))) + (tui-log "update-last-assistant: NO assistant block found! msgs=~a" (length (app-state-messages state)))))) ;; ---- Message management ---- @@ -747,7 +762,13 @@ (fg (face-fg-attr 'spinner)) (bg (face-bg-attr 'default)) (y (max 0 (- (input-y state) 1))) + (w (msg-area-width state)) (text (string-append " " frame " thinking..."))) + ;; Clear entire row first so message content doesn't bleed through + (let clear ((col 0)) + (when (< col w) + (tb-change-cell! col y (char->integer #\space) bg bg) + (clear (+ col 1)))) (tb-print! 0 y fg bg text))) (def (make-prompt-text)