never executed always true always false

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