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.IORef
9 import Data.Text (Text)
10 import Data.Text qualified as T
11
12 import PureClaw.Agent.Context
13 import PureClaw.Agent.Env
14 import PureClaw.Agent.SlashCommands
15 import PureClaw.Core.Errors
16 import PureClaw.Handles.Channel
17 import PureClaw.Handles.Log
18 import PureClaw.Providers.Class
19 import PureClaw.Tools.Registry
20
21 -- | Run the main agent loop. Reads messages from the channel, sends
22 -- them to the provider (with tool definitions), handles tool call/result
23 -- cycles, and writes responses back.
24 --
25 -- Slash commands (messages starting with '/') are intercepted and
26 -- handled before being sent to the provider.
27 --
28 -- Exits cleanly on 'IOException' from the channel (e.g. EOF / Ctrl-D).
29 -- Provider errors are logged and a 'PublicError' is sent to the channel.
30 runAgentLoop :: AgentEnv -> IO ()
31 runAgentLoop env = do
32 _lh_logInfo logger "Agent loop started"
33 go (emptyContext (_env_systemPrompt env))
34 where
35 provider = _env_provider env
36 model = _env_model env
37 channel = _env_channel env
38 logger = _env_logger env
39 registry = _env_registry env
40 tools = registryDefinitions registry
41
42 go ctx = do
43 receiveResult <- try @IOException (_ch_receive channel)
44 case receiveResult of
45 Left _ -> _lh_logInfo logger "Session ended"
46 Right msg
47 | T.null stripped -> go ctx
48 -- INVARIANT: any message beginning with '/' is handled locally and
49 -- NEVER forwarded to the provider. Unknown slash commands get an
50 -- error response rather than silently routing to the LLM.
51 | "/" `T.isPrefixOf` stripped ->
52 case parseSlashCommand stripped of
53 Just cmd -> do
54 _lh_logInfo logger $ "Slash command: " <> stripped
55 ctx' <- executeSlashCommand env cmd ctx
56 go ctx'
57 Nothing -> do
58 _lh_logWarn logger $ "Unrecognized slash command: " <> stripped
59 _ch_send channel
60 (OutgoingMessage ("Unknown command: " <> stripped
61 <> "\nType /status for session info, /help for available commands."))
62 go ctx
63 | otherwise -> do
64 let userMsg = textMessage User stripped
65 ctx' = addMessage userMsg ctx
66 _lh_logDebug logger $
67 "Sending " <> T.pack (show (length (contextMessages ctx'))) <> " messages"
68 handleCompletion ctx'
69 where stripped = T.strip (_im_content msg)
70
71 handleCompletion ctx = do
72 let req = CompletionRequest
73 { _cr_model = model
74 , _cr_messages = contextMessages ctx
75 , _cr_systemPrompt = contextSystemPrompt ctx
76 , _cr_maxTokens = Just 4096
77 , _cr_tools = tools
78 , _cr_toolChoice = Nothing
79 }
80 responseRef <- newIORef (Nothing :: Maybe CompletionResponse)
81 streamedRef <- newIORef False
82 providerResult <- try @SomeException $
83 completeStream provider req $ \case
84 StreamText t -> do
85 _ch_sendChunk channel (ChunkText t)
86 writeIORef streamedRef True
87 StreamDone resp ->
88 writeIORef responseRef (Just resp)
89 _ -> pure ()
90 case providerResult of
91 Left e -> do
92 _lh_logError logger $ "Provider error: " <> T.pack (show e)
93 _ch_sendError channel (TemporaryError "Something went wrong. Please try again.")
94 go ctx
95 Right () -> do
96 wasStreaming <- readIORef streamedRef
97 when wasStreaming $ _ch_sendChunk channel ChunkDone
98 mResp <- readIORef responseRef
99 case mResp of
100 Nothing -> go ctx -- shouldn't happen
101 Just response -> do
102 let calls = toolUseCalls response
103 text = responseText response
104 ctx' = recordUsage (_crsp_usage response)
105 $ addMessage (Message Assistant (_crsp_content response)) ctx
106 -- If not streamed, send the full text
107 unless (wasStreaming || T.null (T.strip text)) $
108 _ch_send channel (OutgoingMessage text)
109 -- If there are tool calls, execute them and continue
110 if null calls
111 then go ctx'
112 else do
113 results <- mapM executeCall calls
114 let resultMsg = toolResultMessage results
115 ctx'' = addMessage resultMsg ctx'
116 _lh_logDebug logger $
117 "Executed " <> T.pack (show (length results)) <> " tool calls, continuing"
118 handleCompletion ctx''
119
120 executeCall (callId, name, input) = do
121 _lh_logInfo logger $ "Tool call: " <> name
122 result <- executeTool registry name input
123 case result of
124 Nothing -> do
125 _lh_logWarn logger $ "Unknown tool: " <> name
126 pure (callId, [TRPText ("Unknown tool: " <> name)], True)
127 Just (parts, isErr) -> do
128 when isErr $ _lh_logWarn logger $ "Tool error in " <> name <> ": " <> partsToText parts
129 pure (callId, parts, isErr)
130
131 partsToText :: [ToolResultPart] -> Text
132 partsToText parts = T.intercalate "\n" [t | TRPText t <- parts]