Files
passepartout/lisp/cost-tracker.lisp
Amr Gharbeia 04c219468d passepartout: v0.6.0 — Time Awareness
Level 2: symbolic-time-memory skill
- memory-objects-since(timestamp) — hash-table walk, objects with version >= timestamp
- memory-objects-in-range(since until) — version between two timestamps
- context-query-with-time — extended query with :since :until
- 6 tests, 100% pass

Level 3: sensor-time skill
- format-time-for-llm — TIME: section for system prompt (iso/natural format)
- session-duration — session start tracking
- sensor-time-tick — deadline scanning, cron-registered, 0 LLM tokens
- TIME_AWARENESS / TIME_FORMAT / DEADLINE_WARNING_MINUTES env vars
- 13 tests, 100% pass

Level 1: TIME injection in think() (core-reason)
- fboundp-guarded call to format-time-for-llm
- session duration included when sensor-time skill loaded
- Injected at top of system prompt in both token-economics and fallback paths

Full suite: 135/135 (100%)
2026-05-08 09:42:22 -04:00

135 lines
5.0 KiB
Common 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 (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))))