never executed always true always false

    1 module PureClaw.Agent.Context
    2   ( -- * Context type (constructor intentionally NOT exported)
    3     Context
    4     -- * Construction
    5   , emptyContext
    6     -- * Operations
    7   , addMessage
    8   , contextMessages
    9   , contextSystemPrompt
   10     -- * Token tracking
   11   , estimateTokens
   12   , estimateBlockTokens
   13   , estimateMessageTokens
   14   , contextTokenEstimate
   15     -- * Usage tracking
   16   , recordUsage
   17   , contextTotalInputTokens
   18   , contextTotalOutputTokens
   19     -- * Context management
   20   , contextMessageCount
   21   , replaceMessages
   22   , clearMessages
   23   ) where
   24 
   25 import Data.Aeson (encode)
   26 import Data.ByteString qualified as BS
   27 import Data.ByteString.Lazy qualified as BL
   28 import Data.Text (Text)
   29 import Data.Text qualified as T
   30 
   31 import PureClaw.Providers.Class
   32 
   33 -- | Conversation context. Maintains message history, an optional
   34 -- system prompt, and cumulative token usage. Constructor is not
   35 -- exported — use 'emptyContext'.
   36 data Context = Context
   37   { _ctx_systemPrompt     :: Maybe Text
   38   , _ctx_messages         :: [Message]  -- oldest first
   39   , _ctx_totalInputTokens :: !Int
   40   , _ctx_totalOutputTokens :: !Int
   41   }
   42   deriving stock (Show, Eq)
   43 
   44 -- | Create an empty context with an optional system prompt.
   45 emptyContext :: Maybe Text -> Context
   46 emptyContext sys = Context sys [] 0 0
   47 
   48 -- | Append a message to the conversation history.
   49 addMessage :: Message -> Context -> Context
   50 addMessage msg ctx = ctx { _ctx_messages = _ctx_messages ctx ++ [msg] }
   51 
   52 -- | Get all messages in chronological order.
   53 contextMessages :: Context -> [Message]
   54 contextMessages = _ctx_messages
   55 
   56 -- | Get the system prompt, if any.
   57 contextSystemPrompt :: Context -> Maybe Text
   58 contextSystemPrompt = _ctx_systemPrompt
   59 
   60 -- Token estimation (approximate: ~4 characters per token for mixed
   61 -- English text and code). Used for context window management — the
   62 -- provider returns actual usage after each completion.
   63 
   64 -- | Estimate token count for a text string.
   65 -- Uses the ~4 characters per token heuristic.
   66 estimateTokens :: Text -> Int
   67 estimateTokens t
   68   | T.null t  = 0
   69   | otherwise = max 1 (T.length t `div` 4)
   70 
   71 -- | Estimate token count for a content block.
   72 estimateBlockTokens :: ContentBlock -> Int
   73 estimateBlockTokens (TextBlock t) = estimateTokens t
   74 estimateBlockTokens (ToolUseBlock _ name input) =
   75   estimateTokens name + fromIntegral (BL.length (encode input) `div` 4)
   76 estimateBlockTokens (ImageBlock _ bs) = max 1 (BS.length bs `div` 4)
   77 estimateBlockTokens (ToolResultBlock _ parts _) = sum (map estimatePartTokens parts)
   78 
   79 -- | Estimate tokens for a tool result part.
   80 estimatePartTokens :: ToolResultPart -> Int
   81 estimatePartTokens (TRPText t) = estimateTokens t
   82 estimatePartTokens (TRPImage _ bs) = max 1 (BS.length bs `div` 4)
   83 
   84 -- | Estimate token count for a message.
   85 estimateMessageTokens :: Message -> Int
   86 estimateMessageTokens msg =
   87   4 + sum (map estimateBlockTokens (_msg_content msg))
   88   -- 4 tokens overhead per message for role, delimiters
   89 
   90 -- | Estimate total token count of the current context window.
   91 -- Includes system prompt and all messages.
   92 contextTokenEstimate :: Context -> Int
   93 contextTokenEstimate ctx =
   94   let sysTokens = maybe 0 estimateTokens (_ctx_systemPrompt ctx)
   95       msgTokens = sum (map estimateMessageTokens (_ctx_messages ctx))
   96   in sysTokens + msgTokens
   97 
   98 -- Usage tracking — records actual provider-reported token usage.
   99 
  100 -- | Record usage from a provider response.
  101 recordUsage :: Maybe Usage -> Context -> Context
  102 recordUsage Nothing ctx = ctx
  103 recordUsage (Just usage) ctx = ctx
  104   { _ctx_totalInputTokens = _ctx_totalInputTokens ctx + _usage_inputTokens usage
  105   , _ctx_totalOutputTokens = _ctx_totalOutputTokens ctx + _usage_outputTokens usage
  106   }
  107 
  108 -- | Get total input tokens consumed (from provider reports).
  109 contextTotalInputTokens :: Context -> Int
  110 contextTotalInputTokens = _ctx_totalInputTokens
  111 
  112 -- | Get total output tokens consumed (from provider reports).
  113 contextTotalOutputTokens :: Context -> Int
  114 contextTotalOutputTokens = _ctx_totalOutputTokens
  115 
  116 -- Context management — for compaction and session reset.
  117 
  118 -- | Get the number of messages in the context.
  119 contextMessageCount :: Context -> Int
  120 contextMessageCount = length . _ctx_messages
  121 
  122 -- | Replace all messages with a new list. Used by compaction to
  123 -- swap old messages for a summary.
  124 replaceMessages :: [Message] -> Context -> Context
  125 replaceMessages msgs ctx = ctx { _ctx_messages = msgs }
  126 
  127 -- | Clear all messages (keep system prompt and usage counters).
  128 -- Used by @/new@ to start a fresh session.
  129 clearMessages :: Context -> Context
  130 clearMessages ctx = ctx { _ctx_messages = [] }