never executed always true always false

    1 module PureClaw.Agent.ContextTracker
    2   ( -- * Context status snapshot
    3     ContextStatus (..)
    4   , contextStatus
    5     -- * Model context windows
    6   , contextWindowForModel
    7   , defaultContextWindow
    8     -- * Utilization queries
    9   , isContextHigh
   10   , highUtilizationThreshold
   11     -- * Formatting
   12   , formatContextStatus
   13   ) where
   14 
   15 import Data.Text (Text)
   16 import Data.Text qualified as T
   17 
   18 import PureClaw.Agent.Context
   19 import PureClaw.Core.Types
   20 
   21 -- | Snapshot of current context tracking state. Produced from a
   22 -- 'Context' and a 'ModelId' — purely computed, no IO.
   23 data ContextStatus = ContextStatus
   24   { _cs_estimatedTokens  :: !Int
   25     -- ^ Heuristic estimate of tokens in the current context window.
   26   , _cs_contextWindow    :: !Int
   27     -- ^ Maximum context window size for the active model.
   28   , _cs_messageCount     :: !Int
   29     -- ^ Number of messages in the conversation.
   30   , _cs_utilizationPct   :: !Double
   31     -- ^ Estimated tokens / context window, as a fraction (0.0–1.0).
   32   , _cs_totalInputTokens :: !Int
   33     -- ^ Cumulative input tokens reported by the provider.
   34   , _cs_totalOutputTokens :: !Int
   35     -- ^ Cumulative output tokens reported by the provider.
   36   }
   37   deriving stock (Show, Eq)
   38 
   39 -- | Compute a context status snapshot from the current model and context.
   40 contextStatus :: ModelId -> Context -> ContextStatus
   41 contextStatus model ctx =
   42   let window    = contextWindowForModel model
   43       estimated = contextTokenEstimate ctx
   44       pct       = if window > 0
   45                   then fromIntegral estimated / fromIntegral window
   46                   else 0.0
   47   in ContextStatus
   48     { _cs_estimatedTokens   = estimated
   49     , _cs_contextWindow     = window
   50     , _cs_messageCount      = contextMessageCount ctx
   51     , _cs_utilizationPct    = pct
   52     , _cs_totalInputTokens  = contextTotalInputTokens ctx
   53     , _cs_totalOutputTokens = contextTotalOutputTokens ctx
   54     }
   55 
   56 -- | Look up the context window size for a model. Uses prefix matching
   57 -- against known model families, falling back to 'defaultContextWindow'.
   58 contextWindowForModel :: ModelId -> Int
   59 contextWindowForModel (ModelId mid) = go knownModels
   60   where
   61     go [] = defaultContextWindow
   62     go ((prefix, window):rest)
   63       | prefix `T.isPrefixOf` mid = window
   64       | otherwise = go rest
   65 
   66 -- | Default context window for unknown models (128k — conservative).
   67 defaultContextWindow :: Int
   68 defaultContextWindow = 128000
   69 
   70 -- | Known model families and their context window sizes.
   71 knownModels :: [(Text, Int)]
   72 knownModels =
   73   -- Anthropic Claude
   74   [ ("claude-opus-4",          200000)
   75   , ("claude-sonnet-4",        200000)
   76   , ("claude-3-7-sonnet",      200000)
   77   , ("claude-3-5-sonnet",      200000)
   78   , ("claude-3-5-haiku",       200000)
   79   , ("claude-3-opus",          200000)
   80   , ("claude-3-sonnet",        200000)
   81   , ("claude-3-haiku",         200000)
   82   -- OpenAI
   83   , ("gpt-4o",                 128000)
   84   , ("gpt-4-turbo",            128000)
   85   , ("gpt-4-0125",             128000)
   86   , ("gpt-4-1106",             128000)
   87   , ("gpt-4",                    8192)
   88   , ("gpt-3.5-turbo",          16385)
   89   , ("o1",                     200000)
   90   , ("o3",                     200000)
   91   -- Ollama common defaults
   92   , ("llama3",                   8192)
   93   , ("mistral",                 32768)
   94   , ("mixtral",                 32768)
   95   , ("deepseek",               128000)
   96   ]
   97 
   98 -- | Threshold above which context utilization is considered high (80%).
   99 highUtilizationThreshold :: Double
  100 highUtilizationThreshold = 0.80
  101 
  102 -- | Check whether context utilization exceeds the high threshold.
  103 isContextHigh :: ModelId -> Context -> Bool
  104 isContextHigh model ctx =
  105   let status = contextStatus model ctx
  106   in _cs_utilizationPct status >= highUtilizationThreshold
  107 
  108 -- | Format a context status snapshot as human-readable text for display.
  109 formatContextStatus :: ContextStatus -> Text
  110 formatContextStatus status = T.intercalate "\n"
  111   [ "Context window: " <> T.pack (show (_cs_estimatedTokens status))
  112       <> " / " <> T.pack (show (_cs_contextWindow status))
  113       <> " tokens (" <> T.pack (show (round (100 * _cs_utilizationPct status) :: Int)) <> "%)"
  114   , "Messages:       " <> T.pack (show (_cs_messageCount status))
  115   , "Total usage:    " <> T.pack (show (_cs_totalInputTokens status)) <> " in / "
  116       <> T.pack (show (_cs_totalOutputTokens status)) <> " out"
  117   ]