tui: implement /compact via generated-code summarization
ober
bce1a233b33d00561f60f7ad56af9c47d78d083f
--- a/src/jcode/core/session.ss +++ b/src/jcode/core/session.ss @@ -7,6 +7,7 @@ session-search session-add-message session-get-messages + session-replace-messages session-update-title session-delete session-id @@ -153,6 +154,35 @@ (sqlite-close db) messages)) +(def (session-replace-messages session-id msgs) + ;; Atomically replace ALL stored messages for SESSION-ID with MSGS. + ;; Used by /compact to swap older turns for an LLM-generated summary. + (let* ((db (open-db)) + (now (timestamp-now))) + (sqlite-exec db "BEGIN") + (sqlite-eval db "DELETE FROM messages WHERE session_id = ?" session-id) + (for-each + (lambda (msg) + (let ((tool-calls-json + (and (message-tool-calls msg) + (json-object->string + (map tool-call->stored-json (message-tool-calls msg)))))) + (sqlite-eval db + "INSERT INTO messages (session_id, role, content, tool_calls, tool_call_id, created_at) + VALUES (?, ?, ?, ?, ?, ?)" + session-id + (message-role msg) + (let ((c (message-content msg))) (if (eq? c (void)) #f c)) + tool-calls-json + (let ((id (message-tool-call-id msg))) (if (eq? id (void)) #f id)) + now))) + msgs) + (sqlite-eval db + "UPDATE sessions SET updated_at = ? WHERE id = ?" + now session-id) + (sqlite-exec db "COMMIT") + (sqlite-close db))) + (def (session-update-title session-id title) (let ((db (open-db))) (sqlite-eval db --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -26,6 +26,7 @@ :jcode/core/builtin-skills :jcode/provider/provider :jcode/core/session + :jcode/core/message :jcode/core/log :jcode/tool/registry :jcode/tool/file @@ -483,6 +484,7 @@ " /mode Show current mode" " /tools List available tools" " /clear Start new session" + " /compact Summarize older turns to free up context" " /sessions List sessions" " /search <term> Search session history" " /mcp Toggle MCP tools on/off (for local models)" @@ -550,6 +552,8 @@ ((equal? cmd "sidebar") (app-state-sidebar-visible?-set! state (not (app-state-sidebar-visible? state))) (reflow-all! state)) + ((equal? cmd "compact") + (handle-compact! state)) ((or (equal? cmd "ask-claude") (equal? cmd "ask-gemini") (equal? cmd "ask-codex") @@ -860,6 +864,16 @@ (app-state-agent-busy?-set! state #f) (app-state-scroll-offset-set! state 0) (app-state-dirty?-set! state #t)) + ((list 'compact-result summary kept-blocks dropped-count) + (tui-log "apply-agent-event: compact-result kept=~a dropped=~a" + (length kept-blocks) dropped-count) + (apply-compact-result! state summary kept-blocks dropped-count)) + ((list 'compact-error msg) + (tui-log "apply-agent-event: compact-error ~a" msg) + (add-message! state + (msg-block-error (format "Compaction failed: ~a" msg))) + (app-state-agent-busy?-set! state #f) + (app-state-dirty?-set! state #t)) (_ (tui-log "apply-agent-event: unknown event ~s" ev)))) ;; ---- Agent integration ---- @@ -1006,6 +1020,139 @@ (send-worker-event! gen (list 'ask-result provider result)))))))) +;; ---- /compact ---- +;; Summarize older user/assistant turns via the current LLM, then replace +;; both app-state-messages and the session DB with [summary + last K turns]. +;; Tool call/result blocks are dropped from the kept tail; the summary covers +;; them in prose. + +(def *compact-keep-pairs* 3) ;; user/assistant pairs to keep verbatim +(def *compact-min-pairs* 5) ;; only worth running once we exceed this + +(def (handle-compact! state) + (cond + ((app-state-agent-busy? state) + (add-message! state + (msg-block-system + "Wait for the current response to finish, then re-run /compact."))) + (else + (let* ((qa (filter + (lambda (m) + (and (memq (msg-block-role m) '(user assistant)) + (not (string-empty? (msg-block-content m))))) + (app-state-messages state))) + (n (length qa)) + (keep (* 2 *compact-keep-pairs*)) + (drop (- n keep))) + (cond + ((<= n (* 2 *compact-min-pairs*)) + (add-message! state + (msg-block-system + (format + "Nothing to compact yet — only ~a user/assistant turns. Try after ~a+." + n (* 2 *compact-min-pairs*))))) + (else + (let* ((older (list-head qa drop)) + (kept (list-tail qa drop)) + (prompt (build-compact-prompt older))) + (add-message! state + (msg-block-system + (format "Compacting ~a earlier turns (keeping last ~a)..." + drop keep))) + (app-state-agent-busy?-set! state #t) + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t) + (run-compact-worker! state prompt kept drop)))))))) + +(def (build-compact-prompt older) + ;; OLDER is a list of msg-blocks (user/assistant only). Produces the + ;; conversation text we hand to the model for summarization. + (let ((lines (map + (lambda (m) + (format "[~a]\n~a" + (if (eq? (msg-block-role m) 'user) "USER" "ASSISTANT") + (msg-block-content m))) + older))) + (string-append + "Summarize the following conversation faithfully and concisely. " + "Preserve: decisions made and the reasoning, file paths and " + "function names mentioned, outstanding tasks, and the user's stated " + "preferences. Skip pleasantries. Aim for 200-400 words. Output ONLY " + "the summary, no preamble.\n\n" + "--- Conversation to summarize ---\n" + (string-join lines "\n\n")))) + +(def (run-compact-worker! state prompt kept-blocks dropped-count) + ;; Spawn a worker that calls provider-stream-chat directly (bypassing the + ;; agent loop, so the summary request doesn't pollute the session DB). + (let ((gen (begin (bump-tui-run-gen!) (tui-run-gen))) + (err-port (current-error-port)) + (log-lvl (current-log-level)) + (p-override (current-provider-override)) + (m-override (current-model-override))) + (spawn + (lambda () + (parameterize ((current-error-port err-port) + (current-log-level log-lvl) + (current-provider-override p-override) + (current-model-override m-override)) + (try + (let* ((provider (get-current-provider)) + (msgs (list + (make-system-message + "You are a careful summarizer. Output only the requested summary.") + (make-user-message prompt)))) + (let-values (((content _tcs _usage) + (provider-stream-chat provider msgs '() (lambda (_t) #f)))) + (let ((summary (or content ""))) + (send-worker-event! gen + (list 'compact-result summary kept-blocks dropped-count))))) + (catch (e) + (send-worker-event! gen + (list 'compact-error (err->string e)))))))))) + +(def (apply-compact-result! state summary kept-blocks dropped-count) + ;; Main thread: rebuild app-state-messages and the session DB with + ;; [welcome banner + summary system block + kept user/assistant blocks]. + (let* ((s-id (app-state-session-id state)) + (banner (msg-block-system + (format "[Compacted ~a earlier turns]" dropped-count))) + (summary-block (msg-block-system summary)) + (new-blocks (cons banner (cons summary-block kept-blocks)))) + (app-state-messages-set! state new-blocks) + ;; Rewrite DB so the next agent-run sees the truncated history. Anchor + ;; the summary into the conversation as a user/assistant exchange so + ;; refresh-system-prompt (which replaces the leading system message) + ;; can't strip it. + (when s-id + (let* ((tail (map block->message kept-blocks)) + (anchor-user + (make-user-message + (string-append + "[Summary of " + (number->string dropped-count) + " earlier turns in this conversation]\n\n" + summary))) + (anchor-asst + (make-assistant-message + "Got it. I'll continue with that context in mind."))) + (try + (session-replace-messages s-id + (cons anchor-user (cons anchor-asst tail))) + (catch (e) + (tui-log "compact: session-replace-messages failed: ~a" + (err->string e)))))) + (app-state-agent-busy?-set! state #f) + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t))) + +(def (block->message blk) + ;; Convert a TUI msg-block (user/assistant text only) into a core message. + (case (msg-block-role blk) + ((user) (make-user-message (msg-block-content blk))) + ((assistant) (make-assistant-message (msg-block-content blk))) + (else (make-system-message (msg-block-content blk))))) + (def (tui-stream-token! state token) "Handle a streaming token from the LLM — called from agent thread." (let ((buf (app-state-stream-buf state)))