passepartout/lisp/cost-tracker.lisp

(in-package :passepartout)

(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.")

(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 (count-tokens (or prompt-text "")))
         (output-tokens (if response-text (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))

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

(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)
    (log-message "COST TRACKER: Session cost reset.")))

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

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

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