(in-package :passepartout) (defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil) "Session cost accumulator: (:total :calls :by-provider )") (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 (funcall (symbol-function 'count-tokens) (or prompt-text ""))) (output-tokens (if response-text (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)) (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))))