cost: track $ spent per session, cache provider pricing live

ober

0cbdc31f19f72fc6e6957cd0882ddb9929d77f89

diff --git a/src/jcode/core/models.ss b/src/jcode/core/models.ss
index f13a3d2..6a1a997 100644
--- a/src/jcode/core/models.ss
+++ b/src/jcode/core/models.ss
@@ -8,10 +8,16 @@
         provider-default-model
         models-cache-path
         load-models-cache!
-        write-models-cache!)
+        write-models-cache!
+        model-pricing
+        compute-cost
+        pricing-cache-path
+        load-pricing-cache!
+        write-pricing-cache!)
 
 (import :std/text/json
-        :std/os/path)
+        :std/os/path
+        :std/misc/string)
 
 ;; ---- Provider metadata ----
 
@@ -238,3 +244,160 @@
     ("sonar"              . "Sonar")
     ("sonar-reasoning-pro" . "Sonar Reasoning Pro")
     ("sonar-reasoning"     . "Sonar Reasoning")))
+
+;; ---- Pricing ($/M-tokens) ----
+;; Tuple shape: (input output cache-read cache-write). Any field may be #f.
+;; cache-read defaults to input rate when unknown; cache-write defaults to
+;; input rate (Anthropic charges 1.25x for 5min cache writes — only set
+;; cache-write when a provider charges differently).
+;;
+;; Source: provider docs as of 2026-04. Update this table when prices change;
+;; live OpenRouter pricing overrides via the on-disk cache.
+
+(def (default-model-prices)
+  '(;; Anthropic
+    ("claude-sonnet-4-20250514"          .  (3.0   15.0   0.30  3.75))
+    ("claude-sonnet-4-5-20251022"        .  (3.0   15.0   0.30  3.75))
+    ("claude-opus-4-20250514"            . (15.0   75.0   1.50 18.75))
+    ("claude-opus-4-7"                   . (15.0   75.0   1.50 18.75))
+    ("claude-haiku-35-20241022"          .  (0.80   4.0   0.08  1.00))
+    ("claude-haiku-4-5-20251001"         .  (1.0    5.0   0.10  1.25))
+    ;; OpenAI
+    ("gpt-4o"                            .  (2.50  10.0   1.25  #f))
+    ("gpt-4o-mini"                       .  (0.15   0.60  0.075 #f))
+    ("gpt-4-turbo"                       . (10.0   30.0   #f    #f))
+    ("o3"                                .  (2.0    8.0   0.50  #f))
+    ("o3-mini"                           .  (1.10   4.40  0.55  #f))
+    ("o4-mini"                           .  (1.10   4.40  0.275 #f))
+    ;; DeepSeek
+    ("deepseek-chat"                     .  (0.27   1.10  0.07  #f))
+    ("deepseek-reasoner"                 .  (0.55   2.19  0.14  #f))
+    ;; Google
+    ("gemini-2.5-pro"                    .  (1.25  10.0   0.31  #f))
+    ("gemini-2.5-flash"                  .  (0.075  0.30  0.0188 #f))
+    ("gemini-2.0-flash"                  .  (0.10   0.40  0.025 #f))
+    ;; xAI
+    ("grok-3"                            .  (3.0   15.0   #f    #f))
+    ("grok-3-mini"                       .  (0.30   0.50  #f    #f))
+    ;; Groq (best-effort; very cheap)
+    ("llama-3.3-70b-versatile"           .  (0.59   0.79  #f    #f))
+    ("llama-3.1-8b-instant"              .  (0.05   0.08  #f    #f))
+    ;; Mistral
+    ("mistral-large-latest"              .  (2.0    6.0   #f    #f))
+    ("codestral-latest"                  .  (0.30   0.90  #f    #f))))
+
+;; ---- Pricing cache (live, populated by /refresh-models) ----
+;; { "<model-id>": [in, out, cache-read, cache-write], ... }
+
+(def *pricing-cache* (make-parameter #f))
+
+(def (pricing-cache-path)
+  (path-join (or (getenv "HOME") ".") ".jcode" "pricing-cache.json"))
+
+(def (load-pricing-cache!)
+  (let ((path (pricing-cache-path)))
+    (if (file-exists? path)
+      (try
+        (let ((data (call-with-input-file path read-json)))
+          (*pricing-cache* (if (hash-table? data) data (make-hash-table)))
+          (*pricing-cache*))
+        (catch (e)
+          (*pricing-cache* (make-hash-table))
+          (*pricing-cache*)))
+      (begin
+        (*pricing-cache* (make-hash-table))
+        (*pricing-cache*)))))
+
+(def (write-pricing-cache! data)
+  "Persist {model-id -> (in out cache-read cache-write)} to
+   ~/.jcode/pricing-cache.json. Refreshes the in-memory cache."
+  (let* ((path (pricing-cache-path))
+         (dir  (path-directory path))
+         (json-data (make-hash-table)))
+    (hash-for-each
+      (lambda (id prices)
+        (hash-put! json-data id
+          (map (lambda (v) (or v 0)) prices)))
+      data)
+    (unless (file-exists? dir) (mkdir dir))
+    (when (file-exists? path) (delete-file path))
+    (let ((port (open-output-file path)))
+      (dynamic-wind
+        (lambda () (void))
+        (lambda () (write-json json-data port))
+        (lambda () (close-output-port port))))
+    (*pricing-cache* data)
+    path))
+
+(def (model-pricing model-id)
+  "Return (input output cache-read cache-write) per 1M tokens, or #f.
+   Cache wins over hardcoded defaults. Strips provider/ prefix as a
+   fallback (so 'anthropic/claude-sonnet-4' falls through to
+   'claude-sonnet-4' if no exact match)."
+  (unless (*pricing-cache*) (load-pricing-cache!))
+  (let ((normalize
+          (lambda (entry)
+            (cond
+              ((not entry) #f)
+              ((pair? entry) entry)         ;; alist value
+              ((list? entry)                ;; JSON list
+               (let* ((len (length entry))
+                      (a (and (> len 0) (list-ref entry 0)))
+                      (b (and (> len 1) (list-ref entry 1)))
+                      (c (and (> len 2) (list-ref entry 2)))
+                      (d (and (> len 3) (list-ref entry 3))))
+                 (list (and (number? a) a)
+                       (and (number? b) b)
+                       (and (number? c) (> c 0) c)
+                       (and (number? d) (> d 0) d))))
+              (else #f)))))
+    (or (let ((cache (*pricing-cache*)))
+          (and cache
+               (let ((hit (hash-get cache model-id)))
+                 (and hit (normalize hit)))))
+        (let ((p (assoc model-id (default-model-prices))))
+          (and p (cdr p)))
+        ;; Fallback: try after stripping "<provider>/" prefix
+        (let ((slash (string-index model-id #\/)))
+          (and slash
+               (let* ((stripped (substring model-id (+ slash 1)
+                                  (string-length model-id)))
+                      (p (assoc stripped (default-model-prices))))
+                 (and p (cdr p))))))))
+
+(def (compute-cost model-id usage)
+  "Compute cost in $ from a usage hash-table. Handles both OpenAI-style
+   ('prompt_tokens', 'completion_tokens', 'prompt_tokens_details.cached_tokens')
+   and Anthropic-style ('input_tokens', 'output_tokens',
+   'cache_creation_input_tokens', 'cache_read_input_tokens'). Returns 0
+   when pricing is unknown."
+  (let ((prices (model-pricing model-id)))
+    (if (not prices)
+      0
+      (let* ((in-rate     (or (list-ref prices 0) 0))
+             (out-rate    (or (list-ref prices 1) 0))
+             (cread-rate  (or (list-ref prices 2) in-rate))
+             (cwrite-rate (or (list-ref prices 3) in-rate))
+             ;; Anthropic-style fields
+             (a-in     (or (hash-get usage "input_tokens") 0))
+             (a-out    (or (hash-get usage "output_tokens") 0))
+             (a-cwrite (or (hash-get usage "cache_creation_input_tokens") 0))
+             (a-cread  (or (hash-get usage "cache_read_input_tokens") 0))
+             ;; OpenAI-style fields
+             (o-in       (or (hash-get usage "prompt_tokens") 0))
+             (o-out      (or (hash-get usage "completion_tokens") 0))
+             (o-details  (hash-get usage "prompt_tokens_details"))
+             (o-cread    (if (and o-details (hash-table? o-details))
+                           (or (hash-get o-details "cached_tokens") 0)
+                           0))
+             ;; Pick whichever style has data
+             (anthropic? (or (> a-in 0) (> a-cwrite 0) (> a-cread 0)))
+             (in-tokens     (if anthropic? a-in    (max 0 (- o-in o-cread))))
+             (out-tokens    (if anthropic? a-out   o-out))
+             (cread-tokens  (if anthropic? a-cread o-cread))
+             (cwrite-tokens (if anthropic? a-cwrite 0)))
+        (/ (+ (* in-tokens     in-rate)
+              (* out-tokens    out-rate)
+              (* cread-tokens  cread-rate)
+              (* cwrite-tokens cwrite-rate))
+           1000000.0)))))
diff --git a/src/jcode/provider/provider.ss b/src/jcode/provider/provider.ss
index 4dfcd0c..8ffa48e 100644
--- a/src/jcode/provider/provider.ss
+++ b/src/jcode/provider/provider.ss
@@ -5,6 +5,7 @@
         provider-stream
         provider-stream-chat
         provider-list-models
+        provider-list-pricing
         provider-name
         provider-model)
 
@@ -16,6 +17,7 @@
         :std/misc/retry
         :jcode/core/log
         :jcode/core/message
+        :jcode/core/models
         :jerboa/core
         :jerboa/runtime)
 
@@ -871,23 +873,25 @@
                         (or (hash-get acc "name") "unknown")
                         (or (hash-get acc "args") "{}"))))
                   indices)))
-      (log-info logger "stream-result"
-        `((content-len . ,(string-length content))
-          (tool-calls  . ,(length tool-calls))
-          (tokens-in . ,(or (hash-get usage-acc "prompt_tokens") 0))
-          (tokens-out . ,(or (hash-get usage-acc "completion_tokens") 0))
-          (cost . ,(or (hash-get usage-acc "cost") 0))))
-      (when (tracing?)
-        (log-trace logger "openai-stream-result"
-          `((content . ,content)
-            (tool-calls . ,(map (lambda (tc)
-                                  (cons (tool-call-name tc)
-                                        (tool-call-arguments tc)))
-                                tool-calls)))))
-      (values content tool-calls
-              (list (cons 'tokens-in (or (hash-get usage-acc "prompt_tokens") 0))
-                    (cons 'tokens-out (or (hash-get usage-acc "completion_tokens") 0))
-                    (cons 'cost (or (hash-get usage-acc "cost") 0)))))))
+      (let ((cost (or (hash-get usage-acc "cost")
+                      (compute-cost (provider-model provider) usage-acc))))
+        (log-info logger "stream-result"
+          `((content-len . ,(string-length content))
+            (tool-calls  . ,(length tool-calls))
+            (tokens-in . ,(or (hash-get usage-acc "prompt_tokens") 0))
+            (tokens-out . ,(or (hash-get usage-acc "completion_tokens") 0))
+            (cost . ,cost)))
+        (when (tracing?)
+          (log-trace logger "openai-stream-result"
+            `((content . ,content)
+              (tool-calls . ,(map (lambda (tc)
+                                    (cons (tool-call-name tc)
+                                          (tool-call-arguments tc)))
+                                  tool-calls)))))
+        (values content tool-calls
+                (list (cons 'tokens-in (or (hash-get usage-acc "prompt_tokens") 0))
+                      (cons 'tokens-out (or (hash-get usage-acc "completion_tokens") 0))
+                      (cons 'cost cost)))))))
 
 ;;; Anthropic Streaming ;;;
 
@@ -1011,7 +1015,8 @@
       (values content tool-calls
               (list (cons 'tokens-in (or (hash-get usage-acc "input_tokens") 0))
                     (cons 'tokens-out (or (hash-get usage-acc "output_tokens") 0))
-                    (cons 'cost 0))))))
+                    (cons 'cost (compute-cost (provider-model provider)
+                                              usage-acc)))))))
 
 ;; provider-stream-chat: stream text tokens to token-cb, accumulate tool calls.
 ;; Returns (values content-str tool-call-list usage-alist).
@@ -1273,3 +1278,50 @@
     (else
      (error 'provider-list-models
        (format "Unknown provider '~a'" (provider-name provider))))))
+
+;; OpenRouter exposes per-token prices in /models. Returns a hash-table
+;; { model-id -> (in-per-M out-per-M cache-read-per-M cache-write-per-M) }
+;; for every model with non-zero pricing. Empty hash if the provider does
+;; not expose pricing.
+(def (provider-list-pricing provider)
+  (case (string->symbol (provider-name provider))
+    ((openrouter) (openrouter-list-pricing provider))
+    (else (make-hash-table))))
+
+(def (openrouter-list-pricing provider)
+  (let* ((url (string-append (provider-base-url provider) "/models"))
+         (headers (openai-headers provider))
+         (out (make-hash-table)))
+    (let-values (((status text) (http-get-json url headers)))
+      (when (= status 200)
+        (let* ((json (string->json-object text))
+               (data (or (hash-get json "data") '())))
+          (for-each
+            (lambda (entry)
+              (let* ((id (hash-get entry "id"))
+                     (pricing (hash-get entry "pricing")))
+                (when (and id pricing (hash-table? pricing))
+                  (let ((in   (per-token->per-million (hash-get pricing "prompt")))
+                        (out- (per-token->per-million (hash-get pricing "completion")))
+                        (cr   (per-token->per-million
+                               (or (hash-get pricing "input_cache_read")
+                                   (hash-get pricing "cache_read"))))
+                        (cw   (per-token->per-million
+                               (or (hash-get pricing "input_cache_write")
+                                   (hash-get pricing "cache_write")))))
+                    (when (and in out- (or (> in 0) (> out- 0)))
+                      (hash-put! out id (list in out- cr cw)))))))
+            data))))
+    out))
+
+(def (per-token->per-million v)
+  ;; OpenRouter prices are strings in $/token. Convert to $/M-token.
+  ;; Returns #f when missing or zero (so callers can distinguish unknown
+  ;; from "free" — both render identically downstream).
+  (cond
+    ((not v) #f)
+    ((string? v)
+     (let ((n (string->number v)))
+       (and n (> n 0) (* n 1000000.0))))
+    ((number? v) (and (> v 0) (* v 1000000.0)))
+    (else #f)))
diff --git a/src/jcode/ui/tui.ss b/src/jcode/ui/tui.ss
index e67bc95..796e559 100644
--- a/src/jcode/ui/tui.ss
+++ b/src/jcode/ui/tui.ss
@@ -600,6 +600,7 @@
     (msg-block-system "Refreshing models from providers…"))
   (draw-all! state)
   (let ((results (make-hash-table))
+        (pricing (make-hash-table))
         (lines  '()))
     (for-each
       (lambda (p-name)
@@ -610,12 +611,21 @@
                (let* ((prov (make-provider p-name
                               (or key "")
                               (provider-default-model p-name)))
-                      (models (provider-list-models prov)))
+                      (models (provider-list-models prov))
+                      (prices (try (provider-list-pricing prov)
+                                   (catch (e) (make-hash-table)))))
                  (hash-put! results p-name models)
+                 (hash-for-each
+                   (lambda (k v) (hash-put! pricing k v))
+                   prices)
                  (set! lines
-                   (cons (format "  ✓ ~a: ~a models"
+                   (cons (format "  ✓ ~a: ~a models~a"
                            (provider-display-name p-name)
-                           (length models))
+                           (length models)
+                           (let ((n (length (hash-keys prices))))
+                             (if (> n 0)
+                               (format ", ~a prices" n)
+                               "")))
                          lines)))
                (catch (e)
                  (let ((msg (string-trim
@@ -631,6 +641,9 @@
                        (provider-display-name p-name))
                      lines))))))
       (all-providers))
+    (when (> (length (hash-keys pricing)) 0)
+      (try (write-pricing-cache! pricing)
+           (catch (e) #f)))
     (cond
       ((> (length (hash-keys results)) 0)
        (let ((path (write-models-cache! results)))