never executed always true always false

    1 module PureClaw.Providers.Ollama
    2   ( -- * Provider type
    3     OllamaProvider
    4   , mkOllamaProvider
    5     -- * Errors
    6   , OllamaError (..)
    7     -- * Request/response encoding (exported for testing)
    8   , encodeRequest
    9   , decodeResponse
   10   ) where
   11 
   12 import Control.Exception
   13 import Data.Aeson
   14 import Data.Aeson.Types
   15 import Data.ByteString (ByteString)
   16 import Data.ByteString.Lazy qualified as BL
   17 import Data.Text (Text)
   18 import Data.Text qualified as T
   19 import Network.HTTP.Client qualified as HTTP
   20 import Network.HTTP.Types.Status qualified as Status
   21 
   22 import PureClaw.Core.Errors
   23 import PureClaw.Core.Types
   24 import PureClaw.Providers.Class
   25 
   26 -- | Ollama provider for local model inference.
   27 data OllamaProvider = OllamaProvider
   28   { _ol_manager :: HTTP.Manager
   29   , _ol_baseUrl :: String
   30   }
   31 
   32 -- | Create an Ollama provider. Defaults to localhost:11434.
   33 mkOllamaProvider :: HTTP.Manager -> OllamaProvider
   34 mkOllamaProvider mgr = OllamaProvider mgr "http://localhost:11434/api/chat"
   35 
   36 instance Provider OllamaProvider where
   37   complete = ollamaComplete
   38 
   39 -- | Errors from the Ollama API.
   40 data OllamaError
   41   = OllamaAPIError Int ByteString
   42   | OllamaParseError Text
   43   deriving stock (Show)
   44 
   45 instance Exception OllamaError
   46 
   47 instance ToPublicError OllamaError where
   48   toPublicError _ = TemporaryError "Provider error"
   49 
   50 ollamaComplete :: OllamaProvider -> CompletionRequest -> IO CompletionResponse
   51 ollamaComplete provider req = do
   52   initReq <- HTTP.parseRequest (_ol_baseUrl provider)
   53   let httpReq = initReq
   54         { HTTP.method = "POST"
   55         , HTTP.requestBody = HTTP.RequestBodyLBS (encodeRequest req)
   56         , HTTP.requestHeaders = [("content-type", "application/json")]
   57         }
   58   resp <- HTTP.httpLbs httpReq (_ol_manager provider)
   59   let status = Status.statusCode (HTTP.responseStatus resp)
   60   if status /= 200
   61     then throwIO (OllamaAPIError status (BL.toStrict (HTTP.responseBody resp)))
   62     else case decodeResponse (HTTP.responseBody resp) of
   63       Left err -> throwIO (OllamaParseError (T.pack err))
   64       Right response -> pure response
   65 
   66 -- | Encode a request for the Ollama /api/chat endpoint.
   67 -- Ollama uses system messages in the messages array and a simpler
   68 -- tool format than OpenAI.
   69 encodeRequest :: CompletionRequest -> BL.ByteString
   70 encodeRequest req = encode $ object $
   71   [ "model"    .= unModelId (_cr_model req)
   72   , "messages" .= encodeMessages req
   73   , "stream"   .= False
   74   ]
   75   ++ ["tools" .= map encodeTool (_cr_tools req) | not (null (_cr_tools req))]
   76 
   77 encodeMessages :: CompletionRequest -> [Value]
   78 encodeMessages req =
   79   maybe [] (\s -> [object ["role" .= ("system" :: Text), "content" .= s]]) (_cr_systemPrompt req)
   80   ++ map encodeMsg (_cr_messages req)
   81 
   82 encodeMsg :: Message -> Value
   83 encodeMsg msg = case _msg_content msg of
   84   [TextBlock t] ->
   85     object ["role" .= roleToText (_msg_role msg), "content" .= t]
   86   blocks ->
   87     -- Ollama supports content as string only; concatenate text blocks
   88     let textParts = [t | TextBlock t <- blocks]
   89     in object ["role" .= roleToText (_msg_role msg), "content" .= T.intercalate "\n" textParts]
   90 
   91 encodeTool :: ToolDefinition -> Value
   92 encodeTool td = object
   93   [ "type" .= ("function" :: Text)
   94   , "function" .= object
   95       [ "name"        .= _td_name td
   96       , "description" .= _td_description td
   97       , "parameters"  .= _td_inputSchema td
   98       ]
   99   ]
  100 
  101 -- | Decode an Ollama /api/chat response.
  102 decodeResponse :: BL.ByteString -> Either String CompletionResponse
  103 decodeResponse bs = eitherDecode bs >>= parseEither parseResp
  104   where
  105     parseResp :: Value -> Parser CompletionResponse
  106     parseResp = withObject "OllamaResponse" $ \o -> do
  107       msg <- o .: "message"
  108       content <- msg .: "content"
  109       modelText <- o .: "model"
  110       -- Ollama tool calls come as tool_calls array in the message
  111       toolCalls <- msg .:? "tool_calls" .!= ([] :: [Value])
  112       toolBlocks <- mapM parseToolCall toolCalls
  113       let textBlocks = [TextBlock content | not (T.null content)]
  114       pure CompletionResponse
  115         { _crsp_content = textBlocks ++ toolBlocks
  116         , _crsp_model   = ModelId modelText
  117         , _crsp_usage   = Nothing  -- Ollama doesn't report usage in chat endpoint
  118         }
  119 
  120     parseToolCall :: Value -> Parser ContentBlock
  121     parseToolCall = withObject "ToolCall" $ \tc -> do
  122       fn <- tc .: "function"
  123       name <- fn .: "name"
  124       args <- fn .: "arguments"
  125       -- Ollama doesn't return a call ID, so generate a placeholder
  126       pure (ToolUseBlock (ToolCallId ("ollama-" <> name)) name args)