never executed always true always false
1 module PureClaw.Agent.Loop
2 ( -- * Agent loop
3 runAgentLoop
4 -- * Re-exports from Handles.Harness (for backward compatibility)
5 , sanitizeHarnessOutput
6 ) where
7
8 import Control.Exception
9 import Control.Monad
10 import Data.IORef
11 import Data.Text (Text)
12 import Data.Text qualified as T
13
14 import Data.Map.Strict qualified as Map
15 import Data.Text.Encoding qualified as TE
16
17 import PureClaw.Agent.Context
18 import PureClaw.Core.Types
19 import PureClaw.Agent.Env
20 import PureClaw.Agent.SlashCommands
21 import PureClaw.Core.Errors
22 import PureClaw.Handles.Channel
23 import PureClaw.Handles.Harness
24 import PureClaw.Handles.Log
25 import PureClaw.Providers.Class
26 import PureClaw.Tools.Registry
27 import PureClaw.Transcript.Provider
28
29 -- | Run the main agent loop. Reads messages from the channel, sends
30 -- them to the provider (with tool definitions), handles tool call/result
31 -- cycles, and writes responses back.
32 --
33 -- Slash commands (messages starting with '/') are intercepted and
34 -- handled before being sent to the provider.
35 --
36 -- If no provider is configured ('Nothing' in the IORef), chat messages
37 -- produce a helpful error directing the user to configure credentials.
38 -- Slash commands always work regardless of provider state.
39 --
40 -- Exits cleanly on 'IOException' from the channel (e.g. EOF / Ctrl-D).
41 -- Provider errors are logged and a 'PublicError' is sent to the channel.
42 runAgentLoop :: AgentEnv -> IO ()
43 runAgentLoop env = do
44 _lh_logInfo logger "Agent loop started"
45 go (emptyContext (_env_systemPrompt env))
46 where
47 channel = _env_channel env
48 logger = _env_logger env
49 registry = _env_registry env
50 tools = registryDefinitions registry
51
52 go ctx = do
53 receiveResult <- try @IOException (_ch_receive channel)
54 case receiveResult of
55 Left _ -> _lh_logInfo logger "Session ended"
56 Right msg
57 | T.null stripped -> go ctx
58 -- INVARIANT: any message beginning with '/' is handled locally and
59 -- NEVER forwarded to the provider. Unknown slash commands get an
60 -- error response rather than silently routing to the LLM.
61 | "/" `T.isPrefixOf` stripped ->
62 case parseSlashCommand stripped of
63 Just cmd -> do
64 _lh_logInfo logger $ "Slash command: " <> stripped
65 ctx' <- executeSlashCommand env cmd ctx
66 go ctx'
67 Nothing -> do
68 _lh_logWarn logger $ "Unrecognized slash command: " <> stripped
69 _ch_send channel
70 (OutgoingMessage ("Unknown command: " <> stripped
71 <> "\nType /status for session info, /help for available commands."))
72 go ctx
73 | otherwise -> do
74 target <- readIORef (_env_target env)
75 case target of
76 TargetHarness name -> do
77 harnesses <- readIORef (_env_harnesses env)
78 case Map.lookup name harnesses of
79 Nothing -> do
80 _ch_send channel (OutgoingMessage
81 ("Harness \"" <> name <> "\" is not running. Use /harness start "
82 <> name <> " or /target to switch targets."))
83 go ctx
84 Just hh -> do
85 _lh_logInfo logger $ "Routing to harness: " <> name
86 _hh_send hh (TE.encodeUtf8 stripped)
87 output <- _hh_receive hh
88 let response = sanitizeHarnessOutput (TE.decodeUtf8 output)
89 unless (T.null (T.strip response)) $
90 _ch_send channel (OutgoingMessage (prefixHarnessOutput name response))
91 go ctx
92 TargetProvider -> do
93 mProvider <- readIORef (_env_provider env)
94 case mProvider of
95 Nothing -> do
96 _ch_send channel (OutgoingMessage noProviderMessage)
97 go ctx
98 Just provider -> do
99 let userMsg = textMessage User stripped
100 ctx' = addMessage userMsg ctx
101 _lh_logDebug logger $
102 "Sending " <> T.pack (show (length (contextMessages ctx'))) <> " messages"
103 -- Wrap provider with transcript logging if configured
104 mTranscript <- readIORef (_env_transcript env)
105 model <- readIORef (_env_model env)
106 let provider' = case mTranscript of
107 Just th -> mkTranscriptProvider th (unModelId model) provider
108 Nothing -> provider
109 handleCompletion provider' ctx'
110 where stripped = T.strip (_im_content msg)
111
112 handleCompletion provider ctx = do
113 model <- readIORef (_env_model env)
114 let modelName = unModelId model
115 req = CompletionRequest
116 { _cr_model = model
117 , _cr_messages = contextMessages ctx
118 , _cr_systemPrompt = contextSystemPrompt ctx
119 , _cr_maxTokens = Just 4096
120 , _cr_tools = tools
121 , _cr_toolChoice = Nothing
122 }
123 responseRef <- newIORef (Nothing :: Maybe CompletionResponse)
124 streamedRef <- newIORef False
125 prefixSentRef <- newIORef False
126 providerResult <- try @SomeException $
127 completeStream provider req $ \case
128 StreamText t -> do
129 -- Emit origin prefix before the first streamed chunk
130 prefixSent <- readIORef prefixSentRef
131 unless prefixSent $ do
132 _ch_sendChunk channel (ChunkText (modelName <> "> "))
133 writeIORef prefixSentRef True
134 _ch_sendChunk channel (ChunkText t)
135 writeIORef streamedRef True
136 StreamDone resp ->
137 writeIORef responseRef (Just resp)
138 _ -> pure ()
139 case providerResult of
140 Left e -> do
141 _lh_logError logger $ "Provider error: " <> T.pack (show e)
142 _ch_sendError channel (TemporaryError "Something went wrong. Please try again.")
143 go ctx
144 Right () -> do
145 wasStreaming <- readIORef streamedRef
146 when wasStreaming $ _ch_sendChunk channel ChunkDone
147 mResp <- readIORef responseRef
148 case mResp of
149 Nothing -> go ctx -- shouldn't happen
150 Just response -> do
151 let calls = toolUseCalls response
152 text = responseText response
153 ctx' = recordUsage (_crsp_usage response)
154 $ addMessage (Message Assistant (_crsp_content response)) ctx
155 -- Send the full text. For streaming channels, the text was already
156 -- displayed chunk-by-chunk so we skip the full send to avoid duplicates.
157 unless (wasStreaming && _ch_streaming channel || T.null (T.strip text)) $
158 _ch_send channel (OutgoingMessage (prefixHarnessOutput modelName text))
159 -- If there are tool calls, execute them and continue
160 if null calls
161 then go ctx'
162 else do
163 results <- mapM executeCall calls
164 let resultMsg = toolResultMessage results
165 ctx'' = addMessage resultMsg ctx'
166 _lh_logDebug logger $
167 "Executed " <> T.pack (show (length results)) <> " tool calls, continuing"
168 handleCompletion provider ctx''
169
170 executeCall (callId, name, input) = do
171 _lh_logInfo logger $ "Tool call: " <> name
172 result <- executeTool registry name input
173 case result of
174 Nothing -> do
175 _lh_logWarn logger $ "Unknown tool: " <> name
176 pure (callId, [TRPText ("Unknown tool: " <> name)], True)
177 Just (parts, isErr) -> do
178 when isErr $ _lh_logWarn logger $ "Tool error in " <> name <> ": " <> partsToText parts
179 pure (callId, parts, isErr)
180
181 partsToText :: [ToolResultPart] -> Text
182 partsToText parts = T.intercalate "\n" [t | TRPText t <- parts]
183
184 -- | Message shown when user sends a chat message but no provider is configured.
185 noProviderMessage :: Text
186 noProviderMessage = T.intercalate "\n"
187 [ "No provider configured. To start chatting, configure your provider with:"
188 , ""
189 , " /provider <PROVIDER>"
190 , ""
191 ]