never executed always true always false
1 module PureClaw.Providers.Class
2 ( -- * Message types
3 Role (..)
4 , ContentBlock (..)
5 , Message (..)
6 , roleToText
7 -- * Tool result content
8 , ToolResultPart (..)
9 -- * Convenience constructors
10 , textMessage
11 , toolResultMessage
12 -- * Content block queries
13 , responseText
14 , toolUseCalls
15 -- * Tool definitions
16 , ToolDefinition (..)
17 , ToolChoice (..)
18 -- * Request and response
19 , CompletionRequest (..)
20 , CompletionResponse (..)
21 , Usage (..)
22 -- * Streaming
23 , StreamEvent (..)
24 -- * Provider typeclass
25 , Provider (..)
26 -- * Existential wrapper
27 , SomeProvider (..)
28 ) where
29
30 import Data.Aeson (FromJSON (..), ToJSON (..), Value, (.:), (.:?), (.=))
31 import Data.Aeson qualified as Aeson
32 import Data.Aeson.Types qualified as Aeson
33 import Data.ByteString (ByteString)
34 import Data.ByteString.Base64 qualified as B64
35 import Data.Maybe qualified
36 import Data.Text (Text)
37 import Data.Text qualified as T
38 import Data.Text.Encoding qualified as TE
39
40 import PureClaw.Core.Types
41
42 -- | Role in a conversation. System prompts are handled separately
43 -- via 'CompletionRequest._cr_systemPrompt' rather than as messages,
44 -- since providers differ on how they handle system content.
45 data Role = User | Assistant
46 deriving stock (Show, Eq, Ord)
47
48 -- | A single content block within a message. Messages contain one or
49 -- more content blocks, allowing mixed text and tool interactions.
50 data ContentBlock
51 = TextBlock Text
52 | ImageBlock
53 { _ib_mediaType :: Text -- ^ MIME type (e.g. "image/png")
54 , _ib_data :: ByteString -- ^ base64-encoded image data
55 }
56 | ToolUseBlock
57 { _tub_id :: ToolCallId
58 , _tub_name :: Text
59 , _tub_input :: Value
60 }
61 | ToolResultBlock
62 { _trb_toolUseId :: ToolCallId
63 , _trb_content :: [ToolResultPart]
64 , _trb_isError :: Bool
65 }
66 deriving stock (Show, Eq)
67
68 -- | Content within a tool result. Supports text and images so that
69 -- vision tools can return image data alongside descriptions.
70 data ToolResultPart
71 = TRPText Text
72 | TRPImage Text ByteString -- ^ (mediaType, base64Data)
73 deriving stock (Show, Eq)
74
75 -- | A single message in a conversation. Content is a list of blocks
76 -- to support tool use/result interleaving with text.
77 data Message = Message
78 { _msg_role :: Role
79 , _msg_content :: [ContentBlock]
80 }
81 deriving stock (Show, Eq)
82
83 -- | Convert a role to its API text representation.
84 roleToText :: Role -> Text
85 roleToText User = "user"
86 roleToText Assistant = "assistant"
87
88 -- | Create a simple text message (the common case).
89 textMessage :: Role -> Text -> Message
90 textMessage role txt = Message role [TextBlock txt]
91
92 -- | Create a tool result message (user role with tool results).
93 toolResultMessage :: [(ToolCallId, [ToolResultPart], Bool)] -> Message
94 toolResultMessage results = Message User
95 [ ToolResultBlock callId content isErr
96 | (callId, content, isErr) <- results
97 ]
98
99 -- | Extract concatenated text from a response's content blocks.
100 responseText :: CompletionResponse -> Text
101 responseText resp =
102 let texts = [t | TextBlock t <- _crsp_content resp]
103 in T.intercalate "\n" texts
104
105 -- | Extract tool use calls from a response's content blocks.
106 toolUseCalls :: CompletionResponse -> [(ToolCallId, Text, Value)]
107 toolUseCalls resp =
108 [ (_tub_id b, _tub_name b, _tub_input b)
109 | b@ToolUseBlock {} <- _crsp_content resp
110 ]
111
112 -- | Tool definition for offering tools to the provider.
113 data ToolDefinition = ToolDefinition
114 { _td_name :: Text
115 , _td_description :: Text
116 , _td_inputSchema :: Value
117 }
118 deriving stock (Show, Eq)
119
120 -- | Tool choice constraint for the provider.
121 data ToolChoice
122 = AutoTool
123 | AnyTool
124 | SpecificTool Text
125 deriving stock (Show, Eq)
126
127 -- | Request to an LLM provider.
128 data CompletionRequest = CompletionRequest
129 { _cr_model :: ModelId
130 , _cr_messages :: [Message]
131 , _cr_systemPrompt :: Maybe Text
132 , _cr_maxTokens :: Maybe Int
133 , _cr_tools :: [ToolDefinition]
134 , _cr_toolChoice :: Maybe ToolChoice
135 }
136 deriving stock (Show, Eq)
137
138 -- | Token usage information.
139 data Usage = Usage
140 { _usage_inputTokens :: Int
141 , _usage_outputTokens :: Int
142 }
143 deriving stock (Show, Eq)
144
145 -- | Response from an LLM provider.
146 data CompletionResponse = CompletionResponse
147 { _crsp_content :: [ContentBlock]
148 , _crsp_model :: ModelId
149 , _crsp_usage :: Maybe Usage
150 }
151 deriving stock (Show, Eq)
152
153 -- | Events emitted during streaming completion.
154 data StreamEvent
155 = StreamText Text -- ^ Partial text content
156 | StreamToolUse ToolCallId Text -- ^ Tool call started (id, name)
157 | StreamToolInput Text -- ^ Partial tool input JSON
158 | StreamDone CompletionResponse -- ^ Stream finished with full response
159 deriving stock (Show, Eq)
160
161 ---------------------------------------------------------------------------
162 -- JSON instances
163 ---------------------------------------------------------------------------
164
165 instance ToJSON Role where
166 toJSON User = Aeson.String "user"
167 toJSON Assistant = Aeson.String "assistant"
168
169 instance FromJSON Role where
170 parseJSON = Aeson.withText "Role" $ \case
171 "user" -> pure User
172 "assistant" -> pure Assistant
173 other -> fail ("unknown Role: " <> T.unpack other)
174
175 -- | Encode a ByteString as base64 text for JSON.
176 bsToJSON :: ByteString -> Value
177 bsToJSON = Aeson.String . TE.decodeUtf8 . B64.encode
178
179 -- | Decode base64 text from JSON to a ByteString.
180 bsFromJSON :: Value -> Aeson.Parser ByteString
181 bsFromJSON = Aeson.withText "Base64ByteString" $ \t ->
182 case B64.decode (TE.encodeUtf8 t) of
183 Right bs -> pure bs
184 Left err -> fail ("invalid base64: " <> err)
185
186 instance ToJSON ToolResultPart where
187 toJSON (TRPText t) = Aeson.object
188 [ "type" .= ("text" :: Text), "text" .= t ]
189 toJSON (TRPImage mt bs) = Aeson.object
190 [ "type" .= ("image" :: Text), "media_type" .= mt, "data" .= bsToJSON bs ]
191
192 instance FromJSON ToolResultPart where
193 parseJSON = Aeson.withObject "ToolResultPart" $ \o -> do
194 tag <- o .: "type" :: Aeson.Parser Text
195 case tag of
196 "text" -> TRPText <$> o .: "text"
197 "image" -> TRPImage <$> o .: "media_type" <*> (o .: "data" >>= bsFromJSON)
198 _ -> fail ("unknown ToolResultPart type: " <> T.unpack tag)
199
200 instance ToJSON ContentBlock where
201 toJSON (TextBlock t) = Aeson.object
202 [ "type" .= ("text" :: Text), "text" .= t ]
203 toJSON (ImageBlock mt bs) = Aeson.object
204 [ "type" .= ("image" :: Text), "media_type" .= mt, "data" .= bsToJSON bs ]
205 toJSON (ToolUseBlock callId name input) = Aeson.object
206 [ "type" .= ("tool_use" :: Text)
207 , "id" .= unToolCallId callId
208 , "name" .= name
209 , "input" .= input
210 ]
211 toJSON (ToolResultBlock callId content isErr) = Aeson.object
212 [ "type" .= ("tool_result" :: Text)
213 , "tool_use_id" .= unToolCallId callId
214 , "content" .= content
215 , "is_error" .= isErr
216 ]
217
218 instance FromJSON ContentBlock where
219 parseJSON = Aeson.withObject "ContentBlock" $ \o -> do
220 tag <- o .: "type" :: Aeson.Parser Text
221 case tag of
222 "text" -> TextBlock <$> o .: "text"
223 "image" -> ImageBlock <$> o .: "media_type" <*> (o .: "data" >>= bsFromJSON)
224 "tool_use" -> (ToolUseBlock . ToolCallId
225 <$> (o .: "id"))
226 <*> o .: "name"
227 <*> o .: "input"
228 "tool_result" -> (ToolResultBlock . ToolCallId
229 <$> (o .: "tool_use_id"))
230 <*> o .: "content"
231 <*> o .: "is_error"
232 _ -> fail ("unknown ContentBlock type: " <> T.unpack tag)
233
234 instance ToJSON Message where
235 toJSON (Message role content) = Aeson.object
236 [ "role" .= role, "content" .= content ]
237
238 instance FromJSON Message where
239 parseJSON = Aeson.withObject "Message" $ \o ->
240 Message <$> o .: "role" <*> o .: "content"
241
242 instance ToJSON ToolDefinition where
243 toJSON (ToolDefinition name desc schema) = Aeson.object
244 [ "name" .= name, "description" .= desc, "input_schema" .= schema ]
245
246 instance FromJSON ToolDefinition where
247 parseJSON = Aeson.withObject "ToolDefinition" $ \o ->
248 ToolDefinition <$> o .: "name" <*> o .: "description" <*> o .: "input_schema"
249
250 instance ToJSON ToolChoice where
251 toJSON AutoTool = Aeson.object [ "type" .= ("auto" :: Text) ]
252 toJSON AnyTool = Aeson.object [ "type" .= ("any" :: Text) ]
253 toJSON (SpecificTool t) = Aeson.object [ "type" .= ("tool" :: Text), "name" .= t ]
254
255 instance FromJSON ToolChoice where
256 parseJSON = Aeson.withObject "ToolChoice" $ \o -> do
257 tag <- o .: "type" :: Aeson.Parser Text
258 case tag of
259 "auto" -> pure AutoTool
260 "any" -> pure AnyTool
261 "tool" -> SpecificTool <$> o .: "name"
262 _ -> fail ("unknown ToolChoice type: " <> T.unpack tag)
263
264 instance ToJSON Usage where
265 toJSON (Usage inp outp) = Aeson.object
266 [ "input_tokens" .= inp, "output_tokens" .= outp ]
267
268 instance FromJSON Usage where
269 parseJSON = Aeson.withObject "Usage" $ \o ->
270 Usage <$> o .: "input_tokens" <*> o .: "output_tokens"
271
272 instance ToJSON CompletionRequest where
273 toJSON req = Aeson.object
274 [ "model" .= unModelId (_cr_model req)
275 , "messages" .= _cr_messages req
276 , "system_prompt" .= _cr_systemPrompt req
277 , "max_tokens" .= _cr_maxTokens req
278 , "tools" .= _cr_tools req
279 , "tool_choice" .= _cr_toolChoice req
280 ]
281
282 instance FromJSON CompletionRequest where
283 parseJSON = Aeson.withObject "CompletionRequest" $ \o ->
284 (CompletionRequest . ModelId
285 <$> (o .: "model"))
286 <*> o .: "messages"
287 <*> o .:? "system_prompt"
288 <*> o .:? "max_tokens"
289 <*> (Data.Maybe.fromMaybe [] <$> o .:? "tools")
290 <*> o .:? "tool_choice"
291
292 instance ToJSON CompletionResponse where
293 toJSON resp = Aeson.object
294 [ "content" .= _crsp_content resp
295 , "model" .= unModelId (_crsp_model resp)
296 , "usage" .= _crsp_usage resp
297 ]
298
299 instance FromJSON CompletionResponse where
300 parseJSON = Aeson.withObject "CompletionResponse" $ \o ->
301 CompletionResponse
302 <$> o .: "content"
303 <*> (ModelId <$> o .: "model")
304 <*> o .:? "usage"
305
306 instance ToJSON StreamEvent where
307 toJSON (StreamText t) = Aeson.object
308 [ "type" .= ("text" :: Text), "text" .= t ]
309 toJSON (StreamToolUse cid name) = Aeson.object
310 [ "type" .= ("tool_use" :: Text), "id" .= unToolCallId cid, "name" .= name ]
311 toJSON (StreamToolInput t) = Aeson.object
312 [ "type" .= ("tool_input" :: Text), "input" .= t ]
313 toJSON (StreamDone resp) = Aeson.object
314 [ "type" .= ("done" :: Text), "response" .= resp ]
315
316 instance FromJSON StreamEvent where
317 parseJSON = Aeson.withObject "StreamEvent" $ \o -> do
318 tag <- o .: "type" :: Aeson.Parser Text
319 case tag of
320 "text" -> StreamText <$> o .: "text"
321 "tool_use" -> (StreamToolUse . ToolCallId <$> (o .: "id")) <*> o .: "name"
322 "tool_input" -> StreamToolInput <$> o .: "input"
323 "done" -> StreamDone <$> o .: "response"
324 _ -> fail ("unknown StreamEvent type: " <> T.unpack tag)
325
326 -- | LLM provider interface. Each provider (Anthropic, OpenAI, etc.)
327 -- implements this typeclass.
328 class Provider p where
329 complete :: p -> CompletionRequest -> IO CompletionResponse
330 -- | Stream a completion, calling the callback for each event.
331 -- Default falls back to non-streaming 'complete'.
332 completeStream :: p -> CompletionRequest -> (StreamEvent -> IO ()) -> IO ()
333 completeStream p req callback = do
334 resp <- complete p req
335 callback (StreamDone resp)
336 -- | List available models from the provider.
337 -- Default returns @[]@ (no model listing support).
338 listModels :: p -> IO [ModelId]
339 listModels _ = pure []
340
341 -- | Existential wrapper for runtime provider selection (e.g. from config).
342 data SomeProvider where
343 MkProvider :: Provider p => p -> SomeProvider
344
345 instance Provider SomeProvider where
346 complete (MkProvider p) = complete p
347 completeStream (MkProvider p) = completeStream p
348 listModels (MkProvider p) = listModels p