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 (Value)
   31 import Data.ByteString (ByteString)
   32 import Data.Text (Text)
   33 import Data.Text qualified as T
   34 
   35 import PureClaw.Core.Types
   36 
   37 -- | Role in a conversation. System prompts are handled separately
   38 -- via 'CompletionRequest._cr_systemPrompt' rather than as messages,
   39 -- since providers differ on how they handle system content.
   40 data Role = User | Assistant
   41   deriving stock (Show, Eq, Ord)
   42 
   43 -- | A single content block within a message. Messages contain one or
   44 -- more content blocks, allowing mixed text and tool interactions.
   45 data ContentBlock
   46   = TextBlock Text
   47   | ImageBlock
   48       { _ib_mediaType :: Text       -- ^ MIME type (e.g. "image/png")
   49       , _ib_data      :: ByteString -- ^ base64-encoded image data
   50       }
   51   | ToolUseBlock
   52       { _tub_id    :: ToolCallId
   53       , _tub_name  :: Text
   54       , _tub_input :: Value
   55       }
   56   | ToolResultBlock
   57       { _trb_toolUseId :: ToolCallId
   58       , _trb_content   :: [ToolResultPart]
   59       , _trb_isError   :: Bool
   60       }
   61   deriving stock (Show, Eq)
   62 
   63 -- | Content within a tool result. Supports text and images so that
   64 -- vision tools can return image data alongside descriptions.
   65 data ToolResultPart
   66   = TRPText Text
   67   | TRPImage Text ByteString  -- ^ (mediaType, base64Data)
   68   deriving stock (Show, Eq)
   69 
   70 -- | A single message in a conversation. Content is a list of blocks
   71 -- to support tool use/result interleaving with text.
   72 data Message = Message
   73   { _msg_role    :: Role
   74   , _msg_content :: [ContentBlock]
   75   }
   76   deriving stock (Show, Eq)
   77 
   78 -- | Convert a role to its API text representation.
   79 roleToText :: Role -> Text
   80 roleToText User      = "user"
   81 roleToText Assistant  = "assistant"
   82 
   83 -- | Create a simple text message (the common case).
   84 textMessage :: Role -> Text -> Message
   85 textMessage role txt = Message role [TextBlock txt]
   86 
   87 -- | Create a tool result message (user role with tool results).
   88 toolResultMessage :: [(ToolCallId, [ToolResultPart], Bool)] -> Message
   89 toolResultMessage results = Message User
   90   [ ToolResultBlock callId content isErr
   91   | (callId, content, isErr) <- results
   92   ]
   93 
   94 -- | Extract concatenated text from a response's content blocks.
   95 responseText :: CompletionResponse -> Text
   96 responseText resp =
   97   let texts = [t | TextBlock t <- _crsp_content resp]
   98   in T.intercalate "\n" texts
   99 
  100 -- | Extract tool use calls from a response's content blocks.
  101 toolUseCalls :: CompletionResponse -> [(ToolCallId, Text, Value)]
  102 toolUseCalls resp =
  103   [ (_tub_id b, _tub_name b, _tub_input b)
  104   | b@ToolUseBlock {} <- _crsp_content resp
  105   ]
  106 
  107 -- | Tool definition for offering tools to the provider.
  108 data ToolDefinition = ToolDefinition
  109   { _td_name        :: Text
  110   , _td_description :: Text
  111   , _td_inputSchema :: Value
  112   }
  113   deriving stock (Show, Eq)
  114 
  115 -- | Tool choice constraint for the provider.
  116 data ToolChoice
  117   = AutoTool
  118   | AnyTool
  119   | SpecificTool Text
  120   deriving stock (Show, Eq)
  121 
  122 -- | Request to an LLM provider.
  123 data CompletionRequest = CompletionRequest
  124   { _cr_model        :: ModelId
  125   , _cr_messages     :: [Message]
  126   , _cr_systemPrompt :: Maybe Text
  127   , _cr_maxTokens    :: Maybe Int
  128   , _cr_tools        :: [ToolDefinition]
  129   , _cr_toolChoice   :: Maybe ToolChoice
  130   }
  131   deriving stock (Show, Eq)
  132 
  133 -- | Token usage information.
  134 data Usage = Usage
  135   { _usage_inputTokens  :: Int
  136   , _usage_outputTokens :: Int
  137   }
  138   deriving stock (Show, Eq)
  139 
  140 -- | Response from an LLM provider.
  141 data CompletionResponse = CompletionResponse
  142   { _crsp_content :: [ContentBlock]
  143   , _crsp_model   :: ModelId
  144   , _crsp_usage   :: Maybe Usage
  145   }
  146   deriving stock (Show, Eq)
  147 
  148 -- | Events emitted during streaming completion.
  149 data StreamEvent
  150   = StreamText Text                -- ^ Partial text content
  151   | StreamToolUse ToolCallId Text  -- ^ Tool call started (id, name)
  152   | StreamToolInput Text           -- ^ Partial tool input JSON
  153   | StreamDone CompletionResponse  -- ^ Stream finished with full response
  154   deriving stock (Show, Eq)
  155 
  156 -- | LLM provider interface. Each provider (Anthropic, OpenAI, etc.)
  157 -- implements this typeclass.
  158 class Provider p where
  159   complete :: p -> CompletionRequest -> IO CompletionResponse
  160   -- | Stream a completion, calling the callback for each event.
  161   -- Default falls back to non-streaming 'complete'.
  162   completeStream :: p -> CompletionRequest -> (StreamEvent -> IO ()) -> IO ()
  163   completeStream p req callback = do
  164     resp <- complete p req
  165     callback (StreamDone resp)
  166 
  167 -- | Existential wrapper for runtime provider selection (e.g. from config).
  168 data SomeProvider where
  169   MkProvider :: Provider p => p -> SomeProvider
  170 
  171 instance Provider SomeProvider where
  172   complete (MkProvider p) = complete p
  173   completeStream (MkProvider p) = completeStream p