never executed always true always false

    1 module PureClaw.Agent.Loop
    2   ( -- * Agent loop
    3     runAgentLoop
    4   ) where
    5 
    6 import Control.Exception
    7 import Control.Monad
    8 import Data.Text (Text)
    9 import Data.Text qualified as T
   10 
   11 import PureClaw.Agent.Context
   12 import PureClaw.Core.Errors
   13 import PureClaw.Core.Types
   14 import PureClaw.Handles.Channel
   15 import PureClaw.Handles.Log
   16 import PureClaw.Providers.Class
   17 import PureClaw.Tools.Registry
   18 
   19 -- | Run the main agent loop. Reads messages from the channel, sends
   20 -- them to the provider (with tool definitions), handles tool call/result
   21 -- cycles, and writes responses back.
   22 --
   23 -- Exits cleanly on 'IOException' from the channel (e.g. EOF / Ctrl-D).
   24 -- Provider errors are logged and a 'PublicError' is sent to the channel.
   25 runAgentLoop :: Provider p => p -> ModelId -> ChannelHandle -> LogHandle -> Maybe Text -> ToolRegistry -> IO ()
   26 runAgentLoop provider model channel logger systemPrompt registry = do
   27   _lh_logInfo logger "Agent loop started"
   28   go (emptyContext systemPrompt)
   29   where
   30     tools = registryDefinitions registry
   31 
   32     go ctx = do
   33       receiveResult <- try @IOException (_ch_receive channel)
   34       case receiveResult of
   35         Left _ -> _lh_logInfo logger "Session ended"
   36         Right msg
   37           | T.null (T.strip (_im_content msg)) -> go ctx
   38           | otherwise -> do
   39               let userMsg = textMessage User (_im_content msg)
   40                   ctx' = addMessage userMsg ctx
   41               _lh_logDebug logger $
   42                 "Sending " <> T.pack (show (length (contextMessages ctx'))) <> " messages"
   43               handleCompletion ctx'
   44 
   45     handleCompletion ctx = do
   46       let req = CompletionRequest
   47             { _cr_model        = model
   48             , _cr_messages     = contextMessages ctx
   49             , _cr_systemPrompt = contextSystemPrompt ctx
   50             , _cr_maxTokens    = Just 4096
   51             , _cr_tools        = tools
   52             , _cr_toolChoice   = Nothing
   53             }
   54       providerResult <- try @SomeException (complete provider req)
   55       case providerResult of
   56         Left e -> do
   57           _lh_logError logger $ "Provider error: " <> T.pack (show e)
   58           _ch_sendError channel (TemporaryError "Something went wrong. Please try again.")
   59           go ctx
   60         Right response -> do
   61           let calls = toolUseCalls response
   62               text = responseText response
   63               ctx' = addMessage (Message Assistant (_crsp_content response)) ctx
   64           -- Send any text to the channel
   65           unless (T.null (T.strip text)) $
   66             _ch_send channel (OutgoingMessage text)
   67           -- If there are tool calls, execute them and continue
   68           if null calls
   69             then go ctx'
   70             else do
   71               results <- mapM executeCall calls
   72               let resultMsg = toolResultMessage results
   73                   ctx'' = addMessage resultMsg ctx'
   74               _lh_logDebug logger $
   75                 "Executed " <> T.pack (show (length results)) <> " tool calls, continuing"
   76               handleCompletion ctx''
   77 
   78     executeCall (callId, name, input) = do
   79       _lh_logInfo logger $ "Tool call: " <> name
   80       result <- executeTool registry name input
   81       case result of
   82         Nothing -> do
   83           _lh_logWarn logger $ "Unknown tool: " <> name
   84           pure (callId, "Unknown tool: " <> name, True)
   85         Just (output, isErr) -> do
   86           when isErr $ _lh_logWarn logger $ "Tool error in " <> name <> ": " <> output
   87           pure (callId, output, isErr)