Files
passepartout/org/cost-tracker.org
Amr Gharbeia b9a4318ef8 reorg: tangle to XDG, remove stale lisp files, fix tui input
- Changed all 50 org file :tangle targets from ../lisp/ to
  ~/.local/share/passepartout/lisp/ (XDG data dir)
- Removed 49 generated .lisp files from project lisp/ directory
- Removed tests/system-integration-tests.lisp (generated)
- Removed lisp/*.fasl (compiled, stale)
- Updated core-manifest.org to tangle .asd to XDG root
- Remapped quicklisp symlink: local-projects/passepartout → XDG

TUI fixes in channel-tui-main.org:
- Removed with-raw-terminal (stty raw breaks fd 0 reads in this SBCL)
- Use cat subprocess + pipe for keyboard input (via :input :interactive)
- Blocking read-char on pipe with with-timeout 0.1s for daemon processing
- Key events queued via drain-queue alongside daemon messages
- Full dialog key routing (Escape, Up/Down, Enter, filters, Backspace)
- SIGWINCH resize handling
- Post-handshake backend-size re-query
- Daemon version in status bar (was v0.5.0 hardcoded)
- Handshake version stored in state, no add-msg
- :daemon-version and :size-queried in state plist
- view-status uses draw-rect for background
- Test section gated with #+passepartout-tests
2026-05-14 12:34:06 -04:00

11 KiB

Cost Tracker — per-session token cost accounting

Architectural Intent

Cost tracking gives the user visibility into what the agent spends on their behalf. No competitor provides this — Claude Code and Copilot obscure cost behind flat-rate subscriptions. Passepartout tracks every LLM call, logs cumulative cost, and exposes it via a /cost TUI command.

The tracking is minimal and accurate to within ~10-15% (using the token heuristic from tokenizer.lisp). It persists across daemon restarts via *session-cost* in the memory store.

v0.8.0 — Session Summary for Sidebar

The sidebar's Cost panel needs an at-a-glance cost summary: total spent, call count, per-provider breakdown. cost-session-summary packages the three existing accessors (cost-session-total, cost-session-calls, cost-by-provider) into a single plist (:total <float> :calls <int> :by-provider <alist>). This is a thin wrapper (~5 lines) — the data already exists; the function exposes it in the shape the TUI expects.

Called from core-act.org's :tui actuator via fboundp guard. Degrades gracefully to nil when cost-tracker is not loaded.

Contract

  1. (cost-track-call provider prompt-text response-text): compute and accumulate the cost of a single LLM call. Returns the cost in USD.
  2. (cost-session-total): returns the current session's total cost.
  3. (cost-session-reset): zeroes the session cost accumulator.
  4. (cost-format-budget-status total budget): returns a human-readable budget status string for the TUI status bar.
  5. (cost-session-summary): returns plist (:total <float> :calls <int> :by-provider <alist>) aggregating all three session cost accessors. Consumed by the TUI actuator for the sidebar Cost panel (v0.8.0).
  6. (budget-remaining-usd): returns the remaining budget in USD, or most-positive-double-float when no budget is set.
  7. (budget-exhausted-p): returns T when a budget is set and fully consumed. fboundp-guarded at call sites so the checker is a no-op when cost-tracker is not loaded.
  8. (budget-estimate-call prompt-text): estimates the dollar cost of a pending LLM call from the prompt text. Returns 0.0 when the tokenizer skill is not loaded (allows the call through).
  9. (budget-exhaustion-message): returns a :REQUEST plist with a human-readable message explaining the budget cap. Injected as the LLM response when the budget is exhausted.

Implementation

Package Context

(in-package :passepartout)

Session cost state

(defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil)
  "Session cost accumulator: (:total <float> :calls <int> :by-provider <alist>)")

(defvar *session-cost-lock* (bordeaux-threads:make-lock "session-cost-lock")
  "Lock protecting *session-cost* from concurrent updates.")

Per-call cost tracking

(defun cost-track-call (provider prompt-text &optional response-text)
  "Compute and accumulate the cost of a single LLM call.
Returns the cost of this call in USD."
  (let* ((input-tokens (if (fboundp 'count-tokens)
                         (funcall (symbol-function 'count-tokens) (or prompt-text ""))
                         (ceiling (length (or prompt-text "")) 4)))
         (output-tokens (if (and response-text (fboundp 'count-tokens))
                          (funcall (symbol-function 'count-tokens) response-text)
                          0))
         (total-tokens (+ input-tokens output-tokens))
         (cost (provider-token-cost provider total-tokens)))
    (bordeaux-threads:with-lock-held (*session-cost-lock*)
      (incf (getf *session-cost* :total) cost)
      (incf (getf *session-cost* :calls))
      (let ((by-prov (getf *session-cost* :by-provider)))
        (let ((entry (assoc provider by-prov)))
          (if entry
              (incf (cdr entry) cost)
              (setf (getf *session-cost* :by-provider)
                    (acons provider cost by-prov))))))
    (log-message "COST TRACKER: ~a call: ~,4f USD (session total: ~,4f USD)"
                 provider cost (getf *session-cost* :total))
    cost))

Session total

(defun cost-session-total ()
  "Returns the current session's total cost in USD."
  (bordeaux-threads:with-lock-held (*session-cost-lock*)
    (getf *session-cost* :total)))

(defun cost-session-calls ()
  "Returns the total number of LLM calls in this session."
  (bordeaux-threads:with-lock-held (*session-cost-lock*)
    (getf *session-cost* :calls)))

(defun cost-by-provider ()
  "Returns an alist of (provider . total-cost) for this session."
  (bordeaux-threads:with-lock-held (*session-cost-lock*)
    (getf *session-cost* :by-provider)))

Session summary (v0.8.0)

(defun cost-session-summary ()
  "Returns plist (:total <float> :calls <int> :by-provider <alist>)."
  (bordeaux-threads:with-lock-held (*session-cost-lock*)
    (list :total (getf *session-cost* :total)
          :calls (getf *session-cost* :calls)
          :by-provider (getf *session-cost* :by-provider))))

Session reset

(defun cost-session-reset ()
  "Zeroes the session cost accumulator."
  (bordeaux-threads:with-lock-held (*session-cost-lock*)
    (setf (getf *session-cost* :total) 0.0)
    (setf (getf *session-cost* :calls) 0)
    (setf (getf *session-cost* :by-provider) nil)))

Budget status formatting

(defun cost-format-budget-status (&optional (daily-budget nil))
  "Returns a string for the TUI status bar showing session cost.
If DAILY-BUDGET is provided, includes percentage of budget used."
  (let* ((total (cost-session-total))
         (calls (cost-session-calls))
         (budget (or daily-budget
                     (ignore-errors
                       (parse-integer (uiop:getenv "COST_BUDGET_DAILY")))
                     0))
         (pct (if (> budget 0) (* 100.0 (/ total budget)) 0.0))
         (status (cond
                   ((= calls 0) "—")
                   ((< pct 50) "OK")
                   ((< pct 90) "WARN")
                   (t "HIGH"))))
    (if (> budget 0)
        (format nil "[Cost: $~,2f (~,0f%) ~a]" total pct status)
        (format nil "[Cost: $~,2f | ~d calls]" total calls))))

Hook into cascade

This function is called from backend-cascade-call after each successful LLM invocation to record the cost.

(defun cost-track-backend-call (backend prompt-text &optional response-text)
  "Track cost of a backend cascade call."
  (cost-track-call backend prompt-text response-text))

Budget enforcement (v0.5.0 deferred)

Session-wide cost caps that refuse LLM calls when the budget is exhausted. The budget is set via SESSION_BUDGET_USD env var (default: no limit). When exceeded, the agent falls back to deterministic-only mode — pure Lisp operations still work, but no cascade calls are made until the cap is raised or the session is reset.

(defvar *session-budget*
  (ignore-errors (read-from-string (uiop:getenv "SESSION_BUDGET_USD")))
  "Maximum USD to spend in this session. NIL means no limit.")

(defun budget-remaining-usd ()
  "Returns remaining budget in USD, or a large sentinel if unlimited."
  (if *session-budget*
      (let ((remaining (- *session-budget* (cost-session-total))))
        (if (< remaining 0) 0.0 remaining))
      most-positive-double-float))

(defun budget-exhausted-p ()
  "T if the session budget is set and fully consumed."
  (and *session-budget* (<= (budget-remaining-usd) 0.0)))

(defun budget-estimate-call (prompt-text)
  "Estimate the dollar cost of a pending LLM call from its prompt text.
Returns 0.0 if the tokenizer is not loaded (allows call through)."
  (if (fboundp 'count-tokens)
      (let* ((tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
             (cost (provider-token-cost (first *provider-cascade*) tokens)))
        cost)
      0.0))

(defun budget-exhaustion-message ()
  "Returns a user-facing plist explaining that the budget is spent."
  (let ((total (cost-session-total))
        (cap *session-budget*))
    (list :TYPE :REQUEST
          :PAYLOAD (list :ACTION :MESSAGE
                         :TEXT (format nil "Session budget exhausted: $~,4f of $~,2f spent. Raise SESSION_BUDGET_USD or reset with /cost-reset to continue."
                                       total cap)
                         :EXPLANATION "Budget cap reached. No LLM calls will be made until the limit is raised."))))

Test Suite

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-cost-tests
  (:use :cl :fiveam :passepartout)
  (:export #:cost-suite))

(in-package :passepartout-cost-tests)

(def-suite cost-suite :description "Cost tracking and budget management")
(in-suite cost-suite)

(test test-cost-track-call
  "Contract 1: cost-track-call returns a positive number."
  (cost-session-reset)
  (let ((cost (cost-track-call :deepseek "hello world")))
    (is (numberp cost))
    (is (> cost 0.0))))

(test test-cost-session-total-accumulates
  "Contract 2: session total grows with multiple calls."
  (cost-session-reset)
  (cost-track-call :deepseek "hello")
  (cost-track-call :deepseek "world")
  (let ((total (cost-session-total)))
    (is (> total 0.0))
    (is (= 2 (cost-session-calls)))))

(test test-cost-session-reset
  "Contract 3: cost-session-reset zeroes the accumulator."
  (cost-session-reset)
  (cost-track-call :deepseek "hello")
  (is (> (cost-session-total) 0.0))
  (cost-session-reset)
  (is (= 0.0 (cost-session-total)))
  (is (= 0 (cost-session-calls))))

(test test-cost-format-budget-status
  "Contract 4: format-budget-status returns a string."
  (cost-session-reset)
  (cost-track-call :deepseek "hello world")
  (let ((status (cost-format-budget-status 100)))
    (is (stringp status))
    (is (search "$" status))))

(test test-cost-by-provider
  "Contract: cost-by-provider returns per-provider breakdown."
  (cost-session-reset)
  (cost-track-call :deepseek "a")
  (cost-track-call :groq "b")
  (let ((by (cost-by-provider)))
    (is (listp by))
    (is (assoc :deepseek by))
    (is (assoc :groq by))))

(test test-cost-track-no-response
  "Contract 1: cost-track-call works without response-text."
  (cost-session-reset)
  (let ((cost (cost-track-call :deepseek "test")))
    (is (> cost 0.0))))

(test test-cost-session-summary
  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
  (cost-session-reset)
  (cost-track-call :deepseek "hello")
  (cost-track-call :groq "world")
  (let ((s (cost-session-summary)))
    (is (> (getf s :total) 0.0))
    (is (= 2 (getf s :calls)))
    (let ((by (getf s :by-provider)))
      (is (assoc :deepseek by))
      (is (assoc :groq by)))))