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 -- If no provider is configured ('Nothing' in the IORef), chat messages
29 -- produce a helpful error directing the user to configure credentials.
30 -- Slash commands always work regardless of provider state.
31 --
32 -- Exits cleanly on 'IOException' from the channel (e.g. EOF / Ctrl-D).
33 -- Provider errors are logged and a 'PublicError' is sent to the channel.
34 runAgentLoop :: AgentEnv -> IO ()
35 runAgentLoop env = do
36 _lh_logInfo logger "Agent loop started"
37 go (emptyContext (_env_systemPrompt env))
38 where
39 model = _env_model env
40 channel = _env_channel env
41 logger = _env_logger env
42 registry = _env_registry env
43 tools = registryDefinitions registry
44
45 go ctx = do
46 receiveResult <- try @IOException (_ch_receive channel)
47 case receiveResult of
48 Left _ -> _lh_logInfo logger "Session ended"
49 Right msg
50 | T.null stripped -> go ctx
51 -- INVARIANT: any message beginning with '/' is handled locally and
52 -- NEVER forwarded to the provider. Unknown slash commands get an
53 -- error response rather than silently routing to the LLM.
54 | "/" `T.isPrefixOf` stripped ->
55 case parseSlashCommand stripped of
56 Just cmd -> do
57 _lh_logInfo logger $ "Slash command: " <> stripped
58 ctx' <- executeSlashCommand env cmd ctx
59 go ctx'
60 Nothing -> do
61 _lh_logWarn logger $ "Unrecognized slash command: " <> stripped
62 _ch_send channel
63 (OutgoingMessage ("Unknown command: " <> stripped
64 <> "\nType /status for session info, /help for available commands."))
65 go ctx
66 | otherwise -> do
67 mProvider <- readIORef (_env_provider env)
68 case mProvider of
69 Nothing -> do
70 _ch_send channel (OutgoingMessage noProviderMessage)
71 go ctx
72 Just provider -> do
73 let userMsg = textMessage User stripped
74 ctx' = addMessage userMsg ctx
75 _lh_logDebug logger $
76 "Sending " <> T.pack (show (length (contextMessages ctx'))) <> " messages"
77 handleCompletion provider ctx'
78 where stripped = T.strip (_im_content msg)
79
80 handleCompletion provider ctx = do
81 let req = CompletionRequest
82 { _cr_model = model
83 , _cr_messages = contextMessages ctx
84 , _cr_systemPrompt = contextSystemPrompt ctx
85 , _cr_maxTokens = Just 4096
86 , _cr_tools = tools
87 , _cr_toolChoice = Nothing
88 }
89 responseRef <- newIORef (Nothing :: Maybe CompletionResponse)
90 streamedRef <- newIORef False
91 providerResult <- try @SomeException $
92 completeStream provider req $ \case
93 StreamText t -> do
94 _ch_sendChunk channel (ChunkText t)
95 writeIORef streamedRef True
96 StreamDone resp ->
97 writeIORef responseRef (Just resp)
98 _ -> pure ()
99 case providerResult of
100 Left e -> do
101 _lh_logError logger $ "Provider error: " <> T.pack (show e)
102 _ch_sendError channel (TemporaryError "Something went wrong. Please try again.")
103 go ctx
104 Right () -> do
105 wasStreaming <- readIORef streamedRef
106 when wasStreaming $ _ch_sendChunk channel ChunkDone
107 mResp <- readIORef responseRef
108 case mResp of
109 Nothing -> go ctx -- shouldn't happen
110 Just response -> do
111 let calls = toolUseCalls response
112 text = responseText response
113 ctx' = recordUsage (_crsp_usage response)
114 $ addMessage (Message Assistant (_crsp_content response)) ctx
115 -- Send the full text. For streaming channels, the text was already
116 -- displayed chunk-by-chunk so we skip the full send to avoid duplicates.
117 unless (wasStreaming && _ch_streaming channel || T.null (T.strip text)) $
118 _ch_send channel (OutgoingMessage text)
119 -- If there are tool calls, execute them and continue
120 if null calls
121 then go ctx'
122 else do
123 results <- mapM executeCall calls
124 let resultMsg = toolResultMessage results
125 ctx'' = addMessage resultMsg ctx'
126 _lh_logDebug logger $
127 "Executed " <> T.pack (show (length results)) <> " tool calls, continuing"
128 handleCompletion provider ctx''
129
130 executeCall (callId, name, input) = do
131 _lh_logInfo logger $ "Tool call: " <> name
132 result <- executeTool registry name input
133 case result of
134 Nothing -> do
135 _lh_logWarn logger $ "Unknown tool: " <> name
136 pure (callId, [TRPText ("Unknown tool: " <> name)], True)
137 Just (parts, isErr) -> do
138 when isErr $ _lh_logWarn logger $ "Tool error in " <> name <> ": " <> partsToText parts
139 pure (callId, parts, isErr)
140
141 partsToText :: [ToolResultPart] -> Text
142 partsToText parts = T.intercalate "\n" [t | TRPText t <- parts]
143
144 -- | Message shown when user sends a chat message but no provider is configured.
145 noProviderMessage :: Text
146 noProviderMessage = T.intercalate "\n"
147 [ "No provider configured. To start chatting, configure your provider with:"
148 , ""
149 , " /provider <PROVIDER>"
150 , ""
151 ]