packages feed

ollama-haskell 0.1.3.0 → 0.2.1.0

raw patch · 35 files changed

Files

CHANGELOG.md view
@@ -1,5 +1,38 @@ # Revision history for ollama-haskell +## Unreleased++## 0.2.1.0 -- 2025-09-24++* Added blob module for managing binary large objects (GGUF files/safetensors).+* Breaking: Added `dimensions` option in embeddings for specifying embedding dimensions.+* Breaking: Added `doneReason` field in chat and generate responses.+* Improved test suite with more comprehensive test cases.+* Added `onComplete` callback function in stream handlers for better streaming control.+* Breaking: Standardized field names across the library for consistency.+* Applied fourmolu code formatting and added hlint for better code quality.++## 0.2.0.0 -- 2025-06-05++* Added stack matrix to ensure lib is buildable from lts-19.33+* Made parameters & template fields optional in `ShowModelResponse`.+* Added extra parameters fields in `ModelInfo`.+* Added strict annotations for all fields.+* Fixed ToJSON instance for delete model request body.+* Removed duplicate code by using unified `withOllamaRequest` function for all API calls.+* Added unified config type `OllamaConfig` to hold common configuration options.+* Added validation for generate and chat functions to ensure required fields are present.+* Added convience functions for generating Message and ToolCall types.+* Added thinking field for chat and generate function.+* Added ModelOptions type to encapsulate model options.+* Added get ollama version function.+* Added Common Manager, Callback functions and retry option in OllamaConfig.+* Fixed tool_calls.+* Added MonadIO versions of api functions.+* Added more comprehensive error handling for API calls.+* Added more comprehensive test cases for all functions.+* Added schema builder for passing json format for structured output.+ ## 0.1.3.0 -- 2025-03-25  * Added options, tools and tool_calls fields in chat and generate.
README.md view
@@ -1,74 +1,102 @@-# Ollama-haskell+# 🦙 Ollama Haskell -**ollama-haskell** is an unofficial Haskell binding for [Ollama](https://ollama.com), similar to [`ollama-python`](https://github.com/ollama/ollama-python). +<div style="text-align: center;">+<img src="./examples/ollama_haskell.png" alt="logo image" height="200"/>+</div> -This library allows you to interact with Ollama, a tool that lets you run large language models (LLMs) locally, from within your Haskell projects. +**`ollama-haskell`** is an unofficial Haskell client for [Ollama](https://ollama.com), inspired by [`ollama-python`](https://github.com/ollama/ollama-python). It enables interaction with locally running LLMs through the Ollama HTTP API — directly from Haskell. -## Examples+--- +## ✨ Features++* 💬 Chat with models+* ✍️ Text generation (with streaming)+* ✅ Chat with structured messages and tools+* 🧠 Embeddings+* 🧰 Model management (list, pull, push, show, delete)+* 🗃️ In-memory conversation history+* ⚙️ Configurable timeouts, retries, streaming handlers++---++## ⚡ Quick Example+ ```haskell {-# LANGUAGE OverloadedStrings #-}-module Lib where+module Main where -import Ollama (GenerateOps(..), defaultGenerateOps, generate)+import Data.Ollama.Generate+import qualified Data.Text.IO as T  main :: IO () main = do-    void $-      generate+  let ops =         defaultGenerateOps-          { modelName = "llama3.2"-          , prompt = "what is functional programming?"-          , stream = Just (T.putStr . Ollama.response_, pure ())+          { modelName = "gemma3"+          , prompt = "What is the meaning of life?"           }+  eRes <- generate ops Nothing+  case eRes of+    Left err -> putStrLn $ "Something went wrong: " ++ show err+    Right r -> do+      putStr "LLM response: "+      T.putStrLn (genResponse r) ``` -### Output--```bash-ghci> import Lib-ghci> main+--- -Whether Haskell is a "good" language depends on what you're looking for in a programming language and your personal preferences. Here are some points to consider:+## 📦 Installation -**Pros:**+Add to your `.cabal` file: -1. **Strongly typed**: Haskell's type system ensures that you catch errors early, which leads to fewer bugs and easier maintenance.-2. **Functional programming paradigm**: Haskell encourages declarative coding, making it easier to reason about code and write correct programs.-3. **Garbage collection**: Haskell handles memory management automatically, freeing you from worries about manual memory deallocation.+```cabal+build-depends:+  base >=4.7 && <5,+  ollama-haskell ``` -You can find practical examples demonstrating how to use the library in the `examples/OllamaExamples.hs` file. +Or use with `stack`/`nix-shell`. -## Prerequisite+--- -Make sure you have [Ollama](https://ollama.com) installed and running on your local machine. You can download it from [here](https://ollama.com/download).+## 📚 More Examples -## How to Use It+See [`examples/OllamaExamples.hs`](examples/OllamaExamples.hs) for: -1. Include the `ollama-haskell` package in your `.cabal` file:-   ```cabal-   build-depends:-       base >= 4.7 && < 5,-       ollama-haskell-   ```+* Chat with conversation memory+* Structured JSON output+* Embeddings+* Tool/function calling+* Multimodal input+* Streaming and non-streaming variants -3. Import the `Ollama` module and start integrating with your local LLM.+--- -## Future Updates+## 🛠 Prerequisite -- [x] Improve documentation-- [x] Add tests.-- [x] Add examples.-- [x] Add CI/CD pipeline.-- [ ] `options` parameter in `generate`.+Make sure you have [Ollama installed and running locally](https://ollama.com/download). Run `ollama pull llama3` to download a model. -Stay tuned for future updates and improvements!+--- -## Author+## 🧪 Dev & Nix Support -This library is developed and maintained by [Tushar](https://github.com/tusharad). Feel free to reach out for any questions or suggestions!+Use Nix: -## Contributions+```bash+nix-shell+``` -Contributions are welcome! If you'd like to improve the library, please submit a pull request or open an issue. Whether it's fixing bugs, adding new features, or improving documentation, all contributions are greatly appreciated.+This will install `stack` and Ollama.++---++## 👨‍💻 Author++Created and maintained by [@tusharad](https://github.com/tusharad). PRs and feedback are welcome!++---++## 🤝 Contributing++Have ideas or improvements? Feel free to [open an issue](https://github.com/tusharad/ollama-haskell/issues) or submit a PR!
ollama-haskell.cabal view
@@ -1,12 +1,12 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           ollama-haskell-version:        0.1.3.0-synopsis:       Haskell bindings for ollama.+version:        0.2.1.0+synopsis:       Haskell client for ollama. description:    Ollama client for Haskell category:       Web homepage:       https://github.com/tusharad/ollama-haskell#readme@@ -27,15 +27,21 @@  library   exposed-modules:+      Data.Ollama.Blob       Data.Ollama.Chat+      Data.Ollama.Common.Config+      Data.Ollama.Common.Error+      Data.Ollama.Common.SchemaBuilder       Data.Ollama.Common.Types       Data.Ollama.Common.Utils+      Data.Ollama.Conversation       Data.Ollama.Copy       Data.Ollama.Create       Data.Ollama.Delete       Data.Ollama.Embeddings       Data.Ollama.Generate       Data.Ollama.List+      Data.Ollama.Load       Data.Ollama.Ps       Data.Ollama.Pull       Data.Ollama.Push@@ -49,23 +55,37 @@       ImportQualifiedPost   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:-      aeson+      aeson ==2.*     , base >=4.7 && <5-    , base64-bytestring-    , bytestring-    , containers-    , directory-    , filepath-    , http-client-    , http-types-    , text-    , time+    , base64-bytestring ==1.*+    , bytestring >=0.10 && <0.13+    , containers >=0.6 && <0.9+    , directory >=1 && <1.4+    , filepath >=1 && <1.6+    , http-client >=0.6 && <0.8+    , http-client-tls >=0.2 && <0.4+    , http-types >=0.7 && <0.13+    , mtl ==2.*+    , stm ==2.*+    , text >=1 && <3+    , time ==1.*   default-language: Haskell2010  test-suite ollama-haskell-test   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      Test.Ollama.Blob+      Test.Ollama.Chat+      Test.Ollama.Common+      Test.Ollama.Copy+      Test.Ollama.Create+      Test.Ollama.Delete+      Test.Ollama.Embedding+      Test.Ollama.Generate+      Test.Ollama.List+      Test.Ollama.Load+      Test.Ollama.Show       Paths_ollama_haskell   hs-source-dirs:       test@@ -75,17 +95,21 @@   build-depends:       aeson     , base >=4.7 && <5-    , base64-bytestring-    , bytestring-    , containers-    , directory-    , filepath-    , http-client-    , http-types+    , base64-bytestring ==1.*+    , bytestring >=0.10 && <0.13+    , containers >=0.6 && <0.9+    , directory >=1 && <1.4+    , filepath >=1 && <1.6+    , http-client >=0.6 && <0.8+    , http-client-tls >=0.2 && <0.4+    , http-types >=0.7 && <0.13+    , mtl ==2.*     , ollama-haskell+    , scientific     , silently-    , tasty+    , stm ==2.*+    , tasty >=1.5     , tasty-hunit     , text-    , time+    , time ==1.*   default-language: Haskell2010
+ src/Data/Ollama/Blob.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Data.Ollama.Blob+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functions for managing binary large objects (blobs) in the Ollama API.++This module provides functionality for checking the existence of blobs and uploading+files as blobs to the Ollama server. Blobs are used when creating models from+GGUF files or safetensors directories.++The blob operations interact with the @\/api\/blobs@ endpoints:++- 'checkBlobExists' sends a HEAD request to check if a blob exists+- 'createBlob' uploads a file as a blob using streaming POST++Example usage:++>>> let digest = "sha256:29fdb92e57cf0827ded04ae6461b5931d01fa595843f55d36f5b275a52087dd2"+>>> exists <- checkBlobExists digest Nothing+>>> case exists of+>>>   Right True -> putStrLn "Blob exists"+>>>   Right False -> putStrLn "Blob not found"+>>>   Left err -> putStrLn $ "Error: " ++ show err++>>> result <- createBlob "model.gguf" digest Nothing+>>> case result of+>>>   Right () -> putStrLn "Blob uploaded successfully"+>>>   Left err -> putStrLn $ "Upload failed: " ++ show err+-}+module Data.Ollama.Blob+  ( -- * Blob Operations+    checkBlobExists+  , createBlob+  ) where++import Control.Exception (try)+import Data.ByteString qualified as BS+import Data.Maybe (fromMaybe)+import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Data.Ollama.Common.Error+import Data.Ollama.Common.Error qualified as Error+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types (Status (statusCode))+import System.Directory (doesFileExist)++{- | Check if a blob exists on the Ollama server.++Sends a HEAD request to @\/api\/blobs\/sha256:\<digest\>@ to check if a blob+with the given SHA256 digest exists on the server.++Returns:+- 'Right' 'True' if the blob exists (HTTP 200 OK)+- 'Right' 'False' if the blob does not exist (HTTP 404 Not Found)+- 'Left' 'OllamaError' for other errors (network issues, invalid digest, etc.)++The digest should be a SHA256 hash string without the "sha256:" prefix.+-}+checkBlobExists ::+  -- | SHA256 digest of the blob (without "sha256:" prefix)+  Text ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError Bool)+checkBlobExists digest mbOllamaConfig = do+  let OllamaConfig {..} = fromMaybe defaultOllamaConfig mbOllamaConfig+      endpoint = "/api/blobs/sha256:" <> digest+      fullUrl = T.unpack $ hostUrl <> endpoint+      timeoutMicros = timeout * 1000000++  manager <- case commonManager of+    Nothing ->+      newTlsManagerWith+        tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro timeoutMicros}+    Just m -> pure m++  eRequest <- try $ parseRequest fullUrl+  case eRequest of+    Left ex -> return $ Left $ Error.HttpError ex+    Right req -> do+      let request = req {method = "HEAD"}+      eResponse <- try $ httpNoBody request manager+      case eResponse of+        Left ex -> return $ Left $ Error.HttpError ex+        Right response -> do+          let status = statusCode $ responseStatus response+          case status of+            200 -> return $ Right True+            404 -> return $ Right False+            _ ->+              return $+                Left $+                  Error.ApiError $+                    "Unexpected status code: " <> T.pack (show status)++{- | Upload a file as a blob to the Ollama server.++Streams the contents of the file at the given 'FilePath' to the Ollama server+via a POST request to @\/api\/blobs\/sha256:\<digest\>@. The server will verify+that the uploaded file matches the expected SHA256 digest.++Returns:+- 'Right' @()@ if the blob was uploaded successfully (HTTP 201 Created)+- 'Left' 'OllamaError' if the upload failed++The digest should be the expected SHA256 hash of the file without the "sha256:" prefix.+If the file content doesn't match the digest, the server will return an error.++Note: This function streams the file content, so it can handle large files efficiently+without loading them entirely into memory.+-}+createBlob ::+  -- | Path to the file to upload+  FilePath ->+  -- | Expected SHA256 digest of the file (without "sha256:" prefix)+  Text ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError ())+createBlob filePath digest mbOllamaConfig = do+  let OllamaConfig {..} = fromMaybe defaultOllamaConfig mbOllamaConfig+      endpoint = "/api/blobs/sha256:" <> digest+      fullUrl = T.unpack $ hostUrl <> endpoint+      timeoutMicros = timeout * 1000000++  manager <- case commonManager of+    Nothing ->+      newTlsManagerWith+        tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro timeoutMicros}+    Just m -> pure m++  eRequest <- try $ parseRequest fullUrl+  case eRequest of+    Left ex -> return $ Left $ Error.HttpError ex+    Right req -> do+      -- check if file exists+      fileExists <- doesFileExist filePath+      if not fileExists+        then return $ Left $ Error.ApiError "File does not exist"+        else do+          -- Create a request body from the file+          fileContent <- BS.readFile filePath+          let request =+                req+                  { method = "POST"+                  , requestBody = RequestBodyBS fileContent+                  }++          eResponse <- try $ withResponse request manager $ \response -> do+            let status = statusCode $ responseStatus response+            case status of+              201 -> return $ Right ()+              400 -> do+                bodyReader <- brRead $ responseBody response+                return $+                  Left $+                    Error.ApiError $+                      "Bad request - digest mismatch: " <> TE.decodeUtf8 bodyReader+              _ -> do+                bodyReader <- brRead $ responseBody response+                return $+                  Left $+                    Error.ApiError $+                      "Unexpected status code " <> T.pack (show status) <> ": " <> TE.decodeUtf8 bodyReader++          case eResponse of+            Left ex -> return $ Left $ Error.HttpError ex+            Right result -> return result
src/Data/Ollama/Chat.hs view
@@ -1,145 +1,230 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Chat+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Chat functionality for interacting with the Ollama API.++This module provides functions and types for initiating and managing chat interactions with an Ollama model.+It includes APIs for sending chat requests, constructing messages with different roles, and configuring chat+operations. The module supports both streaming and non-streaming responses, as well as optional tools and+structured output formats.++The primary functions are 'chat' and 'chatM' for sending chat requests, and helper functions like+'systemMessage', 'userMessage', 'assistantMessage', and 'toolMessage' for constructing messages.+The 'ChatOps' type allows customization of chat parameters, and 'defaultChatOps' provides a convenient+starting point for configuration.++Example:++>>> let ops = defaultChatOps { chatModelName = "customModel", messages = userMessage "Hello!" :| [] }+>>> chat ops Nothing+Either OllamaError ChatResponse+-} module Data.Ollama.Chat   ( -- * Chat APIs     chat-  , chatJson+  , chatM++    -- * Message Types   , Message (..)   , Role (..)+  , systemMessage+  , userMessage+  , assistantMessage+  , toolMessage+  , genMessage++    -- * Chat Configuration   , defaultChatOps   , ChatOps (..)++    -- * Response Types   , ChatResponse (..)   , Format (..)-  , schemaFromType ++    -- * Configuration and Error Types+  , OllamaConfig (..)+  , defaultOllamaConfig+  , OllamaError (..)+  , ModelOptions (..)+  , defaultModelOptions++    -- * Tool and Function Types+  , InputTool (..)+  , FunctionDef (..)+  , FunctionParameters (..)+  , OutputFunction (..)+  , ToolCall (..)   ) where -import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL import Data.List.NonEmpty as NonEmpty-import Data.Maybe (fromMaybe, isNothing)+import Data.Maybe (isNothing)+import Data.Ollama.Common.Config+import Data.Ollama.Common.Error (OllamaError (..))+import Data.Ollama.Common.Types+  ( ChatResponse (..)+  , Format (..)+  , FunctionDef (..)+  , FunctionParameters (..)+  , InputTool (..)+  , Message (..)+  , ModelOptions (..)+  , OutputFunction (..)+  , Role (..)+  , ToolCall (..)+  ) import Data.Ollama.Common.Utils as CU-import Data.Ollama.Common.Types (Format(..)) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Time (UTCTime)-import GHC.Generics-import GHC.Int (Int64)-import Network.HTTP.Client-import qualified Data.Aeson.KeyMap as HM+import Data.Text qualified as T --- | Enumerated roles that can participate in a chat.-data Role = System | User | Assistant | Tool-  deriving (Show, Eq)+{- | Constructs a 'Message' with the specified role and content. -instance ToJSON Role where-  toJSON System = String "system"-  toJSON User = String "user"-  toJSON Assistant = String "assistant"-  toJSON Tool = String "tool"+Creates a 'Message' with the given 'Role' and textual content, setting optional fields+('images', 'tool_calls', 'thinking') to 'Nothing'. -instance FromJSON Role where-  parseJSON (String "system") = pure System-  parseJSON (String "user") = pure User-  parseJSON (String "assistant") = pure Assistant-  parseJSON (String "tool") = pure Tool-  parseJSON _ = fail "Invalid Role value"+Example: --- TODO : Add tool_calls parameter+>>> genMessage User "What's the weather like?"+Message {role = User, content = "What's the weather like?", images = Nothing, tool_calls = Nothing, thinking = Nothing}+-}+genMessage :: Role -> Text -> Message+genMessage r c =+  Message+    { role = r+    , content = c+    , images = Nothing+    , tool_calls = Nothing+    , thinking = Nothing+    } --- | Represents a message within a chat, including its role and content.-data Message = Message-  { role :: Role-  -- ^ The role of the entity sending the message (e.g., 'User', 'Assistant').-  , content :: Text-  -- ^ The textual content of the message.-  , images :: Maybe [Text]-  -- ^ Optional list of base64 encoded images that accompany the message.-  , tool_calls :: Maybe [Value]-  -- ^ a list of tools in JSON that the model wants to use-  -- ^ Since 0.1.3.0-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)+{- | Creates a 'Message' with the 'System' role. --- TODO: Add Options parameter+Example:++>>> systemMessage "You are a helpful assistant."+Message {role = System, content = "You are a helpful assistant.", images = Nothing, tool_calls = Nothing, thinking = Nothing}+-}+systemMessage :: Text -> Message+systemMessage = genMessage System++{- | Creates a 'Message' with the 'User' role.++Example:++>>> userMessage "What's 2+2?"+Message {role = User, content = "What's 2+2?", images = Nothing, tool_calls = Nothing, thinking = Nothing}+-}+userMessage :: Text -> Message+userMessage = genMessage User++{- | Creates a 'Message' with the 'Assistant' role.++Example:++>>> assistantMessage "2+2 equals 4."+Message {role = Assistant, content = "2+2 equals 4.", images = Nothing, tool_calls = Nothing, thinking = Nothing}+-}+assistantMessage :: Text -> Message+assistantMessage = genMessage Assistant++{- | Creates a 'Message' with the 'Tool' role.++Example:++>>> toolMessage "Tool output: success"+Message {role = Tool, content = "Tool output: success", images = Nothing, tool_calls = Nothing, thinking = Nothing}+-}+toolMessage :: Text -> Message+toolMessage = genMessage Tool++{- | Validates 'ChatOps' to ensure required fields are non-empty.++Checks that the 'chatModelName' is not empty and that no 'Message' in 'messages' has empty content.+Returns 'Right' with the validated 'ChatOps' or 'Left' with an 'OllamaError' if validation fails.++@since 0.2.0.0+-}+validateChatOps :: ChatOps -> Either OllamaError ChatOps+validateChatOps ops+  | T.null (modelName ops) = Left $ InvalidRequest "Chat model name cannot be empty"+  | any (T.null . content) (messages ops) =+      Left $ InvalidRequest "Messages cannot have empty content"+  | otherwise = Right ops++{- | Configuration for initiating a chat with an Ollama model.++Defines the parameters for a chat request, including the model name, messages, and optional settings+for tools, response format, streaming, timeout, and model options.+-} data ChatOps = ChatOps-  { chatModelName :: Text-  -- ^ The name of the chat model to be used.-  , messages :: NonEmpty Message+  { modelName :: !Text+  -- ^ The name of the chat model to be used (e.g., "gemma3").+  , messages :: !(NonEmpty Message)   -- ^ A non-empty list of messages forming the conversation context.-  , tools :: Maybe [Value]+  , tools :: !(Maybe [InputTool])   -- ^ Optional tools that may be used in the chat.-  , format :: Maybe Format-  -- ^ An optional format for the chat response (json or JSON schema).-  -- ^ Since 0.1.3.0-  , stream :: Maybe (ChatResponse -> IO (), IO ())-  -- ^ Optional streaming functions where the first handles each chunk of the response, and the second flushes the stream.-  , keepAlive :: Maybe Text-  -- ^ Optional text to specify keep-alive behavior.-  , hostUrl :: Maybe Text-  -- ^ Override default Ollama host url. Default url = "http://127.0.0.1:11434"-  , responseTimeOut :: Maybe Int-  -- ^ Override default response timeout in minutes. Default = 15 minutes-  , options :: Maybe Value-  -- ^ additional model parameters listed in the documentation for the Modelfile such as temperature-  -- ^ Since 0.1.3.0+  , format :: !(Maybe Format)+  -- ^ Optional format for the chat response (e.g., JSON or JSON schema).+  --+  -- @since 0.1.3.0+  , stream :: !(Maybe (ChatResponse -> IO (), IO ()))+  -- ^ Optional callback function to be called with each incoming response.+  , keepAlive :: !(Maybe Int)+  -- ^ Optional override for the response timeout in minutes (default: 15 minutes).+  , options :: !(Maybe ModelOptions)+  -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile.+  --+  -- @since 0.1.3.0+  , think :: !(Maybe Bool)+  -- ^ Optional flag to enable thinking mode.+  --+  -- @since 0.2.0.0   }  instance Show ChatOps where-  show (ChatOps {chatModelName = m, messages = ms, tools = t, format = f, keepAlive = ka}) =-    let messagesStr = show (toList ms)-        toolsStr = show t-        formatStr = show f-        keepAliveStr = show ka-     in T.unpack m-          ++ "\nMessages:\n"-          ++ messagesStr-          ++ "\n"-          ++ toolsStr-          ++ "\n"-          ++ formatStr-          ++ "\n"-          ++ keepAliveStr+  show+    ( ChatOps+        { modelName = m+        , messages = ms+        , tools = t+        , format = f+        , keepAlive = ka+        , think = th+        }+      ) =+      let messagesStr = show (toList ms)+          toolsStr = show t+          formatStr = show f+          keepAliveStr = show ka+          thinkStr = show th+       in T.unpack m+            ++ "\nMessages:\n"+            ++ messagesStr+            ++ "\n"+            ++ toolsStr+            ++ "\n"+            ++ formatStr+            ++ "\n"+            ++ keepAliveStr+            ++ "\n"+            ++ thinkStr  instance Eq ChatOps where   (==) a b =-    chatModelName a == chatModelName b+    modelName a == modelName b       && messages a == messages b       && tools a == tools b       && format a == format b       && keepAlive a == keepAlive b -data ChatResponse = ChatResponse-  { model :: Text-  -- ^ The name of the model that generated this response.-  , createdAt :: UTCTime-  -- ^ The timestamp when the response was created.-  , message :: Maybe Message-  -- ^ The message content of the response, if any.-  , done :: Bool-  -- ^ Indicates whether the chat process has completed.-  , totalDuration :: Maybe Int64-  -- ^ Optional total duration in milliseconds for the chat process.-  , loadDuration :: Maybe Int64-  -- ^ Optional load duration in milliseconds for loading the model.-  , promptEvalCount :: Maybe Int64-  -- ^ Optional count of prompt evaluations during the chat process.-  , promptEvalDuration :: Maybe Int64-  -- ^ Optional duration in milliseconds for evaluating the prompt.-  , evalCount :: Maybe Int64-  -- ^ Optional count of evaluations during the chat process.-  , evalDuration :: Maybe Int64-  -- ^ Optional duration in milliseconds for evaluations during the chat process.-  }-  deriving (Show, Eq)- instance ToJSON ChatOps where-  toJSON (ChatOps model_ messages_ tools_ format_ stream_ keepAlive_ _ _ options) =+  toJSON (ChatOps model_ messages_ tools_ format_ stream_ keepAlive_ options_ think_) =     object       [ "model" .= model_       , "messages" .= messages_@@ -147,255 +232,64 @@       , "format" .= format_       , "stream" .= if isNothing stream_ then Just False else Just True       , "keep_alive" .= keepAlive_-      , "options" .= options+      , "options" .= options_+      , "think" .= think_       ] -instance FromJSON ChatResponse where-  parseJSON = withObject "ChatResponse" $ \v ->-    ChatResponse-      <$> v .: "model"-      <*> v .: "created_at"-      <*> v .: "message"-      <*> v .: "done"-      <*> v .:? "total_duration"-      <*> v .:? "load_duration"-      <*> v .:? "prompt_eval_count"-      <*> v .:? "prompt_eval_duration"-      <*> v .:? "eval_count"-      <*> v .:? "eval_duration"+{- | Default configuration for initiating a chat. -{- |-A default configuration for initiating a chat with a model.-This can be used as a starting point and modified as needed.+Provides a default 'ChatOps' with the "gemma3" model and a sample user message ("What is 2+2?").+Can be customized by modifying fields as needed.  Example: -> let ops = defaultChatOps { chatModelName = "customModel" }-> chat ops+>>> let ops = defaultChatOps { chatModelName = "customModel", messages = userMessage "Hello!" :| [] }+>>> chat ops Nothing+Either OllamaError ChatResponse -} defaultChatOps :: ChatOps defaultChatOps =   ChatOps-    { chatModelName = "llama3.2"-    , messages = Message User "What is 2+2?" Nothing Nothing :| []+    { modelName = "gemma3"+    , messages = userMessage "What is 2+2?" :| []     , tools = Nothing     , format = Nothing     , stream = Nothing     , keepAlive = Nothing-    , hostUrl = Nothing-    , responseTimeOut = Nothing     , options = Nothing+    , think = Nothing     } -{- |-Initiates a chat session with the specified 'ChatOps' configuration and returns either-a 'ChatResponse' or an error message.+{- | Sends a chat request to the Ollama API. -This function sends a request to the Ollama chat API with the given options.+Validates the 'ChatOps' configuration and sends a POST request to the @\/api\/chat@ endpoint.+Supports both streaming and non-streaming responses based on the 'stream' field in 'ChatOps'.+Returns an 'Either' containing an 'OllamaError' on failure or a 'ChatResponse' on success.  Example: -> let ops = defaultChatOps-> result <- chat ops-> case result of->   Left errorMsg -> putStrLn ("Error: " ++ errorMsg)->   Right response -> print response--To request a JSON format response:--> let ops = defaultChatOps { format = Just JsonFormat }-> result <- chat ops--To request a structured output with a JSON schema:--> import Data.Aeson (object, (.=))-> let ops = defaultChatOps { format = Just (SchemaFormat schema) }-> result <- chat ops--}-chat :: ChatOps -> IO (Either String ChatResponse)-chat cOps = do-  let url = fromMaybe defaultOllamaUrl (hostUrl cOps)-      responseTimeout = fromMaybe 15 (responseTimeOut cOps)-  manager <--    newManager-      defaultManagerSettings -- Setting response timeout to 5 minutes, since llm takes time-        { managerResponseTimeout = responseTimeoutMicro (responseTimeout * 60 * 1000000)-        }-  eInitialRequest <- try $ parseRequest $ T.unpack (url <> "/api/chat") :: IO (Either HttpException Request)-  case eInitialRequest of-    Left e -> return $ Left $ "Failed to parse host url: " <> show e-    Right initialRequest -> do-      let reqBody = cOps-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      eRes <--        try (withResponse request manager $ handleRequest cOps) ::-          IO (Either HttpException (Either String ChatResponse))-      case eRes of-        Left e -> return $ Left $ "HTTP error occured: " <> show e-        Right r -> do -            return r--handleRequest :: ChatOps -> Response BodyReader -> IO (Either String ChatResponse)-handleRequest cOps response = do-  let streamResponse sendChunk flush = do-        bs <- brRead $ responseBody response-        if BS.null bs-          then putStrLn "" >> pure (Left "")-          else do-            let eRes = eitherDecode (BSL.fromStrict bs) :: Either String ChatResponse-            case eRes of-              Left e -> pure (Left e)-              Right r -> do-                _ <- sendChunk r-                _ <- flush-                if done r then pure (Left "") else streamResponse sendChunk flush-  let genResponse op = do-        bs <- brRead $ responseBody response-        if BS.null bs-          then do-            let eRes = eitherDecode (BSL.fromStrict op) :: Either String ChatResponse-            case eRes of-              Left e -> pure (Left e)-              Right r -> pure (Right r)-          else genResponse (op <> bs)-  case stream cOps of-    Nothing -> genResponse ""-    Just (sendChunk, flush) -> streamResponse sendChunk flush--{- |- chatJson is a higher level function that takes ChatOps (similar to chat) and also takes- a Haskell type (that has To and From JSON instance) and returns the response in provided type.-- This function simply calls chat with extra prompt appended to it, telling LLM to return the- response in certain JSON format and serializes the response. This function will be helpful when you- want to use the LLM to do something programmatic.-- Note: This function predates the format parameter in the API. For new code, consider using- the `format` parameter with a SchemaFormat instead, which leverages the model's native- JSON output capabilities.-- For Example:-  > let expectedJsonStrucutre = Example {-  >   sortedList = ["sorted List here"]-  > , wasListAlreadSorted = False-  > }-  > let msg0 = Ollama.Message User "Sort given list: [4, 2 , 3, 67]. Also tell whether list was already sorted or not." Nothing-  > eRes3 <--  >  chatJson-  >   defaultChatOps-  >    { Chat.chatModelName = "llama3.2"-  >      , Chat.messages = msg0 :| []-  >   }-  >      expectedJsonStrucutre-  >      (Just 2)-  > print eRes3- Output:-  > Example {sortedList = ["1","2","3","4"], wasListAlreadSorted = False}--Note: While Passing the type, construct the type that will help LLM understand the field better.- For example, in the above example, the sortedList's value is written as "Sorted List here". This- will help LLM understand context better.-- You can also provide number of retries in case the LLM field to return the response in correct JSON- in first attempt.+>>> let ops = defaultChatOps { chatModelName = "gemma3", messages = userMessage "What's the capital of France?" :| [] }+>>> chat ops Nothing+Either OllamaError ChatResponse -}-chatJson ::-  (FromJSON jsonResult, ToJSON jsonResult) =>-  ChatOps ->-  -- | Haskell type that you want your result in-  jsonResult ->-  -- | Max retries-  Maybe Int ->-  IO (Either String jsonResult)-chatJson cOps@ChatOps {..} jsonStructure mMaxRetries = do-  -- For models that support the format parameter, use that directly-  --let jsonSchema = encode jsonStructure-  let useNativeFormat = False  -- Set to True to use the native format parameter when appropriate-  -  if useNativeFormat-    then do-      let formattedOps = cOps { format = Just (SchemaFormat (Object $ HM.fromList [("schema", Object $ HM.fromList [("type", String "object")])])) }-      chatResponse <- chat formattedOps-      case chatResponse of-        Left err -> return $ Left err-        Right r -> do-          let mMessage = message r-          case mMessage of-            Nothing -> return $ Left "Something went wrong"-            Just res -> case decode (BSL.fromStrict . T.encodeUtf8 $ content res) of-              Nothing -> return $ Left "Decoding Failed :("-              Just resultInType -> return $ Right resultInType-    else do-      -- Fall back to the original implementation using prompts-      let lastMessage = NonEmpty.last messages-          jsonHelperPrompt =-            "You are an AI that returns only JSON object. \n"-              <> "* Your output should be a JSON object that matches the following schema: \n"-              <> T.decodeUtf8 (BSL.toStrict $ encode jsonStructure)-              <> content lastMessage-              <> "\n"-              <> "# How to treat the task:\n"-              <> "* Stricly follow the schema for the output.\n"-              <> "* Never return anything other than a JSON object.\n"-              <> "* Do not talk to the user.\n"-      chatResponse <--        chat-          cOps-            { messages =-                NonEmpty.fromList $-                  lastMessage {content = jsonHelperPrompt} : NonEmpty.init messages-            }-      case chatResponse of-        Left err -> return $ Left err-        Right r -> do-          let mMessage = message r-          case mMessage of-            Nothing -> return $ Left "Something went wrong"-            Just res -> do-              case decode (BSL.fromStrict . T.encodeUtf8 $ content res) of-                Nothing -> do-                  case mMaxRetries of-                    Nothing -> return $ Left "Decoding Failed :("-                    Just n -> if n < 1 then return $ Left "Decoding Failed :(" else chatJson cOps jsonStructure (Just (n - 1))-                Just resultInType -> return $ Right resultInType+chat :: ChatOps -> Maybe OllamaConfig -> IO (Either OllamaError ChatResponse)+chat ops mbConfig =+  case validateChatOps ops of+    Left err -> return $ Left err+    Right _ -> withOllamaRequest "/api/chat" "POST" (Just ops) mbConfig handler+  where+    handler = maybe commonNonStreamingHandler commonStreamHandler (stream ops) --- | Helper function to create a JSON schema from a Haskell type-schemaFromType :: ToJSON a => a -> BSL.ByteString-schemaFromType = encode  -- This is a simplified version; a real implementation would generate a JSON Schema+{- | MonadIO version of 'chat' for use in monadic contexts. -{- |-   Example usage of 'Ollama.chat' with a JSON schema format and options field.+Lifts the 'chat' function into a 'MonadIO' context, allowing it to be used in monadic computations. -   The first example sends a message requesting a JSON response conforming to a given schema.-   The second example uses an alternative JSON format (here, @JsonFormat@).+Example: -   >>> import Data.Aeson (Value, object, (.=))-   >>> import Data.List.NonEmpty (NonEmpty(..))-   >>> import Ollama (defaultChatOps, Message(..), SchemaFormat, JsonFormat)-   >>> let x :: Value-   ...     x = object [ "type" .= ("object" :: String)-   ...                , "properties" .= object [ "age" .= object ["type" .= ("integer" :: String)] ]-   ...                ]-   >>> let msg = Message User "Ollama is 22 years old and is busy saving the world. Respond using JSON" Nothing-   >>> let opts = object ["option" .= ("some value" :: String)]-   >>> res <- chat defaultChatOps-   ...   { chatModelName = "llama3.2"-   ...   , messages = msg :| []-   ...   , format = Just (SchemaFormat x)-   ...   , options = opts-   ...   }-   >>> print (message res)-   Just (Message {role = Assistant, content = "{\n    \"age\": 22\n}", images = Nothing})-   >>> res2 <- chat defaultChatOps-   ...   { chatModelName = "llama3.2"-   ...   , messages = msg :| []-   ...   , format = Just JsonFormat-   ...   , options = object ["option" .= ("other value" :: String)]-   ...   }-   >>> print (message res2)-   Just (Message {role = Assistant, content = "{ \"Name\": \"Ollama\", \"Age\": 22, \"Occupation\": \"World Savior\", \"Goals\": [\"Save humanity from alien invasion\", \"Unite warring nations\", \"Protect the environment\"] }", images = Nothing})+>>> import Control.Monad.IO.Class+>>> let ops = defaultChatOps { chatModelName = "gemma3", messages = userMessage "Hello!" :| [] }+>>> runReaderT (chatM ops Nothing) someContext+Either OllamaError ChatResponse -}+chatM :: MonadIO m => ChatOps -> Maybe OllamaConfig -> m (Either OllamaError ChatResponse)+chatM ops mbCfg = liftIO $ chat ops mbCfg
+ src/Data/Ollama/Common/Config.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Data.Ollama.Common.Config+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : A unified configuration type for controlling Ollama client behavior.++== Overview++This module defines the core configuration record used throughout the Ollama Haskell client.++Use 'defaultOllamaConfig' as a starting point and customize it with helper functions+like 'withOnModelStart', 'withOnModelFinish', or 'withOnModelError'.++Includes settings for base URL, timeout, retry logic, and custom HTTP managers.+-}+module Data.Ollama.Common.Config+  ( -- * Configuration Type+    OllamaConfig (..)++    -- * Default Config+  , defaultOllamaConfig++    -- * Hook Helpers+  , withOnModelStart+  , withOnModelFinish+  , withOnModelError+  ) where++import Data.Text (Text)+import GHC.Generics+import Network.HTTP.Client++{- | Configuration for the Ollama client.+Used across all requests to customize behavior such as timeouts, retries,+custom HTTP manager, and lifecycle hooks.++@since 0.2.0.0+-}+data OllamaConfig = OllamaConfig+  { hostUrl :: Text+  -- ^ Base URL for the Ollama server (default: @http://127.0.0.1:11434@)+  , timeout :: Int+  -- ^ Timeout in seconds for API requests (ignored if 'commonManager' is set)+  , onModelStart :: Maybe (IO ())+  -- ^ Callback executed when a model starts+  , onModelError :: Maybe (IO ())+  -- ^ Callback executed if a model encounters an error+  , onModelFinish :: Maybe (IO ())+  -- ^ Callback executed when a model finishes (not called on error)+  , retryCount :: Maybe Int+  -- ^ Number of retries on failure (default: @0@ if 'Nothing')+  , retryDelay :: Maybe Int+  -- ^ Delay between retries in seconds (if applicable)+  , commonManager :: Maybe Manager+  -- ^ Shared HTTP manager; disables timeout and retry settings+  }+  deriving (Generic)++{- | A default configuration pointing to @localhost:11434@ with 90s timeout+and no hooks or retry logic.+-}+defaultOllamaConfig :: OllamaConfig+defaultOllamaConfig =+  OllamaConfig+    { hostUrl = "http://127.0.0.1:11434"+    , timeout = 90+    , onModelStart = Nothing+    , onModelError = Nothing+    , onModelFinish = Nothing+    , retryCount = Nothing+    , retryDelay = Nothing+    , commonManager = Nothing+    }++-- | Add a callback to be executed when a model starts.+withOnModelStart :: IO () -> OllamaConfig -> OllamaConfig+withOnModelStart f cfg = cfg {onModelStart = Just f}++-- | Add a callback to be executed when a model errors.+withOnModelError :: IO () -> OllamaConfig -> OllamaConfig+withOnModelError f cfg = cfg {onModelError = Just f}++-- | Add a callback to be executed when a model finishes successfully.+withOnModelFinish :: IO () -> OllamaConfig -> OllamaConfig+withOnModelFinish f cfg = cfg {onModelFinish = Just f}
+ src/Data/Ollama/Common/Error.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveGeneric #-}++{- |+Module      : Data.Ollama.Common.Error+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Unified error type for handling failures across the Ollama client.++== Overview++Defines the core 'OllamaError' type that wraps all potential errors+encountered while interacting with the Ollama API, including HTTP errors,+JSON decoding failures, API-specific errors, file I/O errors, and timeouts.+-}+module Data.Ollama.Common.Error+  ( -- * Error Types+    OllamaError (..)++    -- * Decoding Utilities+  , DecodingErrorMessage+  , DecodingFailedValue+  ) where++import Control.Exception (Exception, IOException)+import Data.Text (Text)+import GHC.Generics+import Network.HTTP.Client (HttpException)++-- | Type alias for a decoding error message string.+type DecodingErrorMessage = String++-- | Type alias for the value that failed to decode.+type DecodingFailedValue = String++{- | Represents all possible errors that may occur when using the Ollama client.++@since 0.2.0.0+-}+data OllamaError+  = -- | Low-level HTTP exception (connection failure, etc.)+    HttpError HttpException+  | -- | Failure to decode a JSON response, includes message and raw value+    DecodeError DecodingErrorMessage DecodingFailedValue+  | -- | Error returned from Ollama's HTTP API+    ApiError Text+  | -- | Error during file operations (e.g., loading an image)+    FileError IOException+  | -- | Mismatch in expected JSON schema or structure+    JsonSchemaError String+  | -- | Request timed out+    TimeoutError String+  | -- | Request is malformed or violates input constraints+    InvalidRequest String+  deriving (Show, Generic)++instance Eq OllamaError where+  (HttpError _) == (HttpError _) = True+  x == y = eqOllamaError x y+    where+      eqOllamaError :: OllamaError -> OllamaError -> Bool+      eqOllamaError = (==)++instance Exception OllamaError
+ src/Data/Ollama/Common/SchemaBuilder.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Data.Ollama.Common.SchemaBuilder+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : DSL for constructing structured JSON Schemas for Ollama's structured output API.++== Overview++This module defines a simple schema builder DSL for programmatically constructing+JSON Schemas compatible with the structured output features in the Ollama API.++It supports nested objects, arrays, required fields, and custom types, and+provides infix operators for a fluent and expressive syntax.++== Example++@+import Data.Ollama.Common.SchemaBuilder++let schema =+      emptyObject+        |+ ("name", JString)+        |+ ("age", JInteger)+        |++ ("address", buildSchema $+              emptyObject+                |+ ("city", JString)+                |+ ("zip", JInteger)+                |! "city"+            )+        |!! ["name", "age"]+        & buildSchema++printSchema schema+@+-}+module Data.Ollama.Common.SchemaBuilder+  ( -- * Core Types+    JsonType (..)+  , Property (..)+  , Schema (..)++    -- * Schema Construction+  , emptyObject+  , addProperty+  , addObjectProperty+  , requireField+  , requireFields+  , buildSchema++    -- * Schema Utilities+  , objectOf+  , arrayOf+  , toOllamaFormat+  , printSchema++    -- * Infix Schema DSL+  , (|+)+  , (|++)+  , (|!)+  , (|!!)+  ) where++import Data.Aeson+import Data.Map.Strict qualified as HM+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding qualified as T+import GHC.Generics++-- | Supported JSON types for schema generation.+data JsonType+  = JString+  | JNumber+  | JInteger+  | JBoolean+  | JNull+  | -- | Array of a specific type+    JArray JsonType+  | -- | Nested object schema+    JObject Schema+  deriving (Show, Eq, Generic)++instance ToJSON JsonType where+  toJSON JString = "string"+  toJSON JNumber = "number"+  toJSON JInteger = "integer"+  toJSON JBoolean = "boolean"+  toJSON JNull = "null"+  toJSON (JArray _) = "array"+  toJSON (JObject _) = "object"++-- | A named property with a given type (supports nested values).+newtype Property = Property JsonType+  deriving (Show, Eq, Generic)++instance ToJSON Property where+  toJSON (Property (JArray itemType)) =+    object ["type" .= ("array" :: Text), "items" .= Property itemType]+  toJSON (Property (JObject schema)) = toJSON schema+  toJSON (Property typ) = object ["type" .= typ]++{- | Complete schema representation.++@since 0.2.0.0+-}+data Schema = Schema+  { schemaProperties :: HM.Map Text Property+  , schemaRequired :: [Text]+  }+  deriving (Show, Eq, Generic)++instance ToJSON Schema where+  toJSON (Schema props req) =+    object+      [ "type" .= ("object" :: Text)+      , "properties" .= props+      , "required" .= req+      ]++-- | Internal builder for schema DSL.+newtype SchemaBuilder = SchemaBuilder Schema+  deriving (Show, Eq)++-- | Create an empty schema object.+emptyObject :: SchemaBuilder+emptyObject = SchemaBuilder $ Schema HM.empty []++-- | Add a simple field with a given name and type.+addProperty :: Text -> JsonType -> SchemaBuilder -> SchemaBuilder+addProperty name typ (SchemaBuilder s) =+  SchemaBuilder $ s {schemaProperties = HM.insert name (Property typ) (schemaProperties s)}++-- | Add a nested object field with its own schema.+addObjectProperty :: Text -> Schema -> SchemaBuilder -> SchemaBuilder+addObjectProperty name nestedSchema (SchemaBuilder s) =+  SchemaBuilder $+    s {schemaProperties = HM.insert name (Property (JObject nestedSchema)) (schemaProperties s)}++-- | Mark a field as required.+requireField :: Text -> SchemaBuilder -> SchemaBuilder+requireField name (SchemaBuilder s) =+  SchemaBuilder $ s {schemaRequired = name : schemaRequired s}++-- | Mark multiple fields as required.+requireFields :: [Text] -> SchemaBuilder -> SchemaBuilder+requireFields names builder = foldr requireField builder names++-- | Finalize the schema from a builder.+buildSchema :: SchemaBuilder -> Schema+buildSchema (SchemaBuilder s) = s++-- | Wrap a 'SchemaBuilder' as a nested object type.+objectOf :: SchemaBuilder -> JsonType+objectOf builder = JObject (buildSchema builder)++-- | Create an array of a given JSON type.+arrayOf :: JsonType -> JsonType+arrayOf = JArray++-- | Convert schema into a JSON 'Value' suitable for API submission.+toOllamaFormat :: Schema -> Value+toOllamaFormat = toJSON++-- | Pretty print a schema as formatted JSON.+printSchema :: Schema -> IO ()+printSchema = putStrLn . T.unpack . TL.toStrict . T.decodeUtf8 . encode++-- | Infix alias for 'addProperty'.+(|+) :: SchemaBuilder -> (Text, JsonType) -> SchemaBuilder+builder |+ (name, typ) = addProperty name typ builder++-- | Infix alias for 'addObjectProperty'.+(|++) :: SchemaBuilder -> (Text, Schema) -> SchemaBuilder+builder |++ (name, schema) = addObjectProperty name schema builder++-- | Infix alias for 'requireField'.+(|!) :: SchemaBuilder -> Text -> SchemaBuilder+builder |! name = requireField name builder++-- | Infix alias for 'requireFields'.+(|!!) :: SchemaBuilder -> [Text] -> SchemaBuilder+builder |!! names = requireFields names builder++infixl 7 |+, |+++infixl 6 |!, |!!
src/Data/Ollama/Common/Types.hs view
@@ -1,22 +1,82 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Common.Types+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Shared data types for request and response structures used throughout the Ollama client.++== 📋 Overview++This module defines common types for working with Ollama's API, including:++- Chat messages and roles+- Text generation responses+- Structured function/tool calling+- Model metadata+- Streaming handling+- Custom model parameters++These types are consumed and returned by higher-level modules+like `Data.Ollama.Chat`, `Data.Ollama.Generate`, and others.++== Includes++- Chat message structure and roles+- Generate and chat response records+- ModelOptions and advanced config+- Structured function/tool call interfaces+- JSON format hints and schema wrapping+- Helper class 'HasDone' for streaming termination++Most types implement `ToJSON`/`FromJSON` for direct API interaction.+-} module Data.Ollama.Common.Types   ( ModelDetails (..)-  , OllamaClient (..)   , Format (..)+  , GenerateResponse (..)+  , Message (..)+  , Role (..)+  , ChatResponse (..)+  , HasDone (..)+  , ModelOptions (..)+  , InputTool (..)+  , FunctionDef (..)+  , FunctionParameters (..)+  , ToolCall (..)+  , OutputFunction (..)+  , Version (..)   ) where  import Data.Aeson+import Data.Map qualified as HM+import Data.Maybe (catMaybes)+import Data.Ollama.Common.SchemaBuilder import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics+import GHC.Int (Int64) +-- | Metadata describing a specific model's identity and configuration. data ModelDetails = ModelDetails-  { parentModel :: Maybe Text-  , format :: Text-  , familiy :: Text-  , families :: [Text]-  , parameterSize :: Text+  { parentModel :: !(Maybe Text)+  -- ^ The parent model from which this model was derived, if any.+  , format :: !Text+  -- ^ The format used for the model (e.g., "gguf").+  , family :: !Text+  -- ^ The family name of the model (e.g., "llama", "mistral").+  , families :: ![Text]+  -- ^ Alternative or related family identifiers.+  , parameterSize :: !Text+  -- ^ The size of the model's parameters, typically expressed as a string (e.g., "7B").   , quantizationLevel :: Text+  -- ^ The quantization level used (e.g., "Q4", "Q8").   }   deriving (Eq, Show) @@ -30,35 +90,375 @@       <*> v .: "parameter_size"       <*> v .: "quantization_level" -newtype OllamaClient = OllamaClient-  { host :: Text+{- | Format specification for the chat output.++@since 0.1.3.0+-}+data Format = JsonFormat | SchemaFormat Schema+  deriving (Show, Eq)++instance ToJSON Format where+  toJSON JsonFormat = String "json"+  toJSON (SchemaFormat schema) = toJSON schema++{- |+Result type for 'generate' function containing the model's response and meta-information.+-}+data GenerateResponse = GenerateResponse+  { model :: !Text+  -- ^ The name of the model that generated the response.+  , createdAt :: !UTCTime+  -- ^ The timestamp when the response was created.+  , genResponse :: !Text+  -- ^ The generated response from the model.+  , done :: !Bool+  -- ^ A flag indicating whether the generation process is complete.+  , totalDuration :: !(Maybe Int64)+  -- ^ Optional total duration in milliseconds for the generation process.+  , loadDuration :: !(Maybe Int64)+  -- ^ Optional load duration in milliseconds for loading the model.+  , promptEvalCount :: !(Maybe Int64)+  -- ^ Optional count of prompt evaluations during the generation process.+  , promptEvalDuration :: !(Maybe Int64)+  -- ^ Optional duration in milliseconds for evaluating the prompt.+  , evalCount :: !(Maybe Int64)+  -- ^ Optional count of evaluations during the generation process.+  , evalDuration :: !(Maybe Int64)+  -- ^ Optional duration in milliseconds for evaluations during the generation process.+  , thinking :: !(Maybe Text)+  -- ^ Thinking of reasoning models; if think is set to true+  --+  -- @since 0.2.0.0+  , doneReason :: !(Maybe Text)+  -- ^ Reason why the generation process completed (e.g., "stop", "length", "cancel").+  -- Available when the Ollama server provides completion reason information.+  --+  -- @since 0.2.1.0   }+  deriving (Show, Eq)++instance FromJSON GenerateResponse where+  parseJSON = withObject "GenerateResponse" $ \v ->+    GenerateResponse+      <$> v .: "model"+      <*> v .: "created_at"+      <*> v .: "response"+      <*> v .: "done"+      <*> v .:? "total_duration"+      <*> v .:? "load_duration"+      <*> v .:? "prompt_eval_count"+      <*> v .:? "prompt_eval_duration"+      <*> v .:? "eval_count"+      <*> v .:? "eval_duration"+      <*> v .:? "thinking"+      <*> v .:? "done_reason"++-- | Enumerated roles that can participate in a chat.+data Role = System | User | Assistant | Tool+  deriving (Show, Eq)++instance ToJSON Role where+  toJSON System = String "system"+  toJSON User = String "user"+  toJSON Assistant = String "assistant"+  toJSON Tool = String "tool"++instance FromJSON Role where+  parseJSON = withText "Role" $ \t ->+    case t of+      "system" -> pure System+      "user" -> pure User+      "assistant" -> pure Assistant+      "tool" -> pure Tool+      _ -> fail $ "Invalid Role value: " <> show t++-- | Represents a message within a chat, including its role and content.+data Message = Message+  { role :: !Role+  -- ^ The role of the entity sending the message (e.g., 'User', 'Assistant').+  , content :: !Text+  -- ^ The textual content of the message.+  , images :: !(Maybe [Text])+  -- ^ Optional list of base64 encoded images that accompany the message.+  , tool_calls :: !(Maybe [ToolCall])+  -- ^ a list of tools in JSON that the model wants to use+  --+  -- @since 0.1.3.0+  , thinking :: !(Maybe Text)+  --+  -- @since 0.2.0.0+  }+  deriving (Show, Eq, Generic, ToJSON, FromJSON)++data ChatResponse = ChatResponse+  { model :: !Text+  -- ^ The name of the model that generated this response.+  , createdAt :: !UTCTime+  -- ^ The timestamp when the response was created.+  , message :: !(Maybe Message)+  -- ^ The message content of the response, if any.+  , done :: !Bool+  -- ^ Indicates whether the chat process has completed.+  , totalDuration :: !(Maybe Int64)+  -- ^ Optional total duration in milliseconds for the chat process.+  , loadDuration :: !(Maybe Int64)+  -- ^ Optional load duration in milliseconds for loading the model.+  , promptEvalCount :: !(Maybe Int64)+  -- ^ Optional count of prompt evaluations during the chat process.+  , promptEvalDuration :: !(Maybe Int64)+  -- ^ Optional duration in milliseconds for evaluating the prompt.+  , evalCount :: !(Maybe Int64)+  -- ^ Optional count of evaluations during the chat process.+  , evalDuration :: !(Maybe Int64)+  -- ^ Optional duration in milliseconds for evaluations during the chat process.+  , doneReason :: !(Maybe Text)+  -- ^ Reason why the chat process completed (e.g., "stop", "length", "cancel").+  -- Available when the Ollama server provides completion reason information.+  --+  -- @since 0.2.1.0+  }+  deriving (Show, Eq)++instance FromJSON ChatResponse where+  parseJSON = withObject "ChatResponse" $ \v ->+    ChatResponse+      <$> v .: "model"+      <*> v .: "created_at"+      <*> v .: "message"+      <*> v .: "done"+      <*> v .:? "total_duration"+      <*> v .:? "load_duration"+      <*> v .:? "prompt_eval_count"+      <*> v .:? "prompt_eval_duration"+      <*> v .:? "eval_count"+      <*> v .:? "eval_duration"+      <*> v .:? "done_reason"++-- | A workaround to use done field within commonStreamHandler+class HasDone a where+  getDone :: a -> Bool++instance HasDone GenerateResponse where+  getDone GenerateResponse {..} = done++instance HasDone ChatResponse where+  getDone ChatResponse {..} = done++{- | Optional model tuning parameters that influence generation behavior.++@since 0.2.0.0+-}+data ModelOptions = ModelOptions+  { numKeep :: Maybe Int+  -- ^ Number of tokens to keep from the previous context.+  , seed :: Maybe Int+  -- ^ Random seed for reproducibility.+  , numPredict :: Maybe Int+  -- ^ Maximum number of tokens to predict.+  , topK :: Maybe Int+  -- ^ Top-K sampling parameter.+  , topP :: Maybe Double+  -- ^ Top-P (nucleus) sampling parameter.+  , minP :: Maybe Double+  -- ^ Minimum probability for nucleus sampling.+  , typicalP :: Maybe Double+  -- ^ Typical sampling probability.+  , repeatLastN :: Maybe Int+  -- ^ Number of tokens to consider for repetition penalty.+  , temperature :: Maybe Double+  -- ^ Sampling temperature. Higher = more randomness.+  , repeatPenalty :: Maybe Double+  -- ^ Penalty for repeating the same tokens.+  , presencePenalty :: Maybe Double+  -- ^ Penalty for introducing new tokens.+  , frequencyPenalty :: Maybe Double+  -- ^ Penalty for frequent tokens.+  , penalizeNewline :: Maybe Bool+  -- ^ Whether to penalize newline tokens.+  , stop :: Maybe [Text]+  -- ^ List of stop sequences to end generation.+  , numa :: Maybe Bool+  -- ^ Whether to enable NUMA-aware optimizations.+  , numCtx :: Maybe Int+  -- ^ Number of context tokens.+  , numBatch :: Maybe Int+  -- ^ Batch size used during generation.+  , numGpu :: Maybe Int+  -- ^ Number of GPUs to use.+  , mainGpu :: Maybe Int+  -- ^ Index of the primary GPU to use.+  , useMmap :: Maybe Bool+  -- ^ Whether to memory-map the model.+  , numThread :: Maybe Int+  -- ^ Number of threads to use for inference.+  }+  deriving (Show, Eq)++-- | Custom ToJSON instance for Options+instance ToJSON ModelOptions where+  toJSON opts =+    object $+      catMaybes+        [ ("num_keep" .=) <$> numKeep opts+        , ("seed" .=) <$> seed opts+        , ("num_predict" .=) <$> numPredict opts+        , ("top_k" .=) <$> topK opts+        , ("top_p" .=) <$> topP opts+        , ("min_p" .=) <$> minP opts+        , ("typical_p" .=) <$> typicalP opts+        , ("repeat_last_n" .=) <$> repeatLastN opts+        , ("temperature" .=) <$> temperature opts+        , ("repeat_penalty" .=) <$> repeatPenalty opts+        , ("presence_penalty" .=) <$> presencePenalty opts+        , ("frequency_penalty" .=) <$> frequencyPenalty opts+        , ("penalize_newline" .=) <$> penalizeNewline opts+        , ("stop" .=) <$> stop opts+        , ("numa" .=) <$> numa opts+        , ("num_ctx" .=) <$> numCtx opts+        , ("num_batch" .=) <$> numBatch opts+        , ("num_gpu" .=) <$> numGpu opts+        , ("main_gpu" .=) <$> mainGpu opts+        , ("use_mmap" .=) <$> useMmap opts+        , ("num_thread" .=) <$> numThread opts+        ]++-- | A wrapper for the Ollama engine version string.+newtype Version = Version Text   deriving (Eq, Show) +instance FromJSON Version where+  parseJSON = withObject "version" $ \v -> do+    Version <$> v .: "version" -{-|-E.g SchemaFormat-{-    "type": "object",-    "properties": {-      "age": {-        "type": "integer"-      },-      "available": {-        "type": "boolean"-      }-    },-    "required": [-      "age",-      "available"-    ]+{- | Represents a tool that can be used in the conversation.++@since 0.2.0.0+-}+data InputTool = InputTool+  { toolType :: Text+  -- ^ The type of the tool+  , function :: FunctionDef+  -- ^ The function associated with the tool   }-|-}--- | Format specification for the chat output--- | Since 0.1.3.0-data Format = JsonFormat | SchemaFormat Value+  deriving (Show, Eq, Generic)++instance ToJSON InputTool where+  toJSON InputTool {..} =+    object+      [ "type" .= toolType+      , "function" .= function+      ]++instance FromJSON InputTool where+  parseJSON = withObject "Tool" $ \v ->+    InputTool+      <$> v .: "type"+      <*> v .: "function"++{- | Represents a function that can be called by the model.++@since 0.2.0.0+-}+data FunctionDef = FunctionDef+  { functionName :: Text+  -- ^ The name of the function+  , functionDescription :: Maybe Text+  -- ^ Optional description of the function+  , functionParameters :: Maybe FunctionParameters+  -- ^ Optional parameters for the function+  , functionStrict :: Maybe Bool+  -- ^ Optional strictness flag+  }+  deriving (Show, Eq, Generic)++instance ToJSON FunctionDef where+  toJSON FunctionDef {..} =+    object $+      [ "name" .= functionName+      ]+        ++ maybe [] (\d -> ["description" .= d]) functionDescription+        ++ maybe [] (\p -> ["parameters" .= p]) functionParameters+        ++ maybe [] (\s -> ["strict" .= s]) functionStrict++instance FromJSON FunctionDef where+  parseJSON = withObject "Function" $ \v ->+    FunctionDef+      <$> v .: "name"+      <*> v .:? "description"+      <*> v .:? "parameters"+      <*> v .:? "strict"++{- | Parameters definition for a function call used in structured output or tool calls.++@since 0.2.0.0+-}+data FunctionParameters = FunctionParameters+  { parameterType :: Text+  -- ^ Type of the parameter (usually "object").+  , parameterProperties :: Maybe (HM.Map Text FunctionParameters)+  -- ^ Optional nested parameters as a property map.+  , requiredParams :: Maybe [Text]+  -- ^ List of required parameter names.+  , additionalProperties :: Maybe Bool+  -- ^ Whether additional (unspecified) parameters are allowed.+  }   deriving (Show, Eq) -instance ToJSON Format where-  toJSON JsonFormat = String "json"-  toJSON (SchemaFormat schema) = schema+instance ToJSON FunctionParameters where+  toJSON FunctionParameters {..} =+    object+      [ "type" .= parameterType+      , "properties" .= parameterProperties+      , "required" .= requiredParams+      , "additionalProperties" .= additionalProperties+      ]++instance FromJSON FunctionParameters where+  parseJSON = withObject "parameters" $ \v ->+    FunctionParameters+      <$> v .: "type"+      <*> v .: "properties"+      <*> v .: "required"+      <*> v .: "additionalProperties"++{- | A single tool call returned from the model, containing the function to be invoked.++@since 0.2.0.0+-}+newtype ToolCall = ToolCall+  { outputFunction :: OutputFunction+  -- ^ The function the model intends to call, with arguments.+  }+  deriving (Show, Eq)++{- | Output representation of a function to be called, including its name and arguments.++@since 0.2.0.0+-}+data OutputFunction = OutputFunction+  { outputFunctionName :: Text+  -- ^ The name of the function to invoke.+  , arguments :: HM.Map Text Value+  -- ^ A key-value map of argument names to values (JSON values).+  }+  deriving (Eq, Show)++instance ToJSON OutputFunction where+  toJSON OutputFunction {..} =+    object+      [ "name" .= outputFunctionName+      , "arguments" .= arguments+      ]++instance FromJSON OutputFunction where+  parseJSON = withObject "function" $ \v ->+    OutputFunction+      <$> v .: "name"+      <*> v .: "arguments"++instance ToJSON ToolCall where+  toJSON ToolCall {..} = object ["function" .= outputFunction]++instance FromJSON ToolCall where+  parseJSON = withObject "tool_calls" $ \v ->+    ToolCall <$> v .: "function"
src/Data/Ollama/Common/Utils.hs view
@@ -1,26 +1,71 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} -module Data.Ollama.Common.Utils (defaultOllamaUrl, OllamaClient (..), encodeImage) where+{- |+Module      : Data.Ollama.Common.Utils+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Utility functions for interacting with the Ollama API, including image encoding, HTTP request handling, and retry logic. +This module provides helper functions for common tasks in the Ollama client, such as encoding images to Base64,+sending HTTP requests to the Ollama API, handling streaming and non-streaming responses, and managing retries for failed requests.+It also includes a default model options configuration and a function to retrieve the Ollama server version.++The functions in this module are used internally by other modules like 'Data.Ollama.Chat' and 'Data.Ollama.Generate' but can also be used directly for custom API interactions.+-}+module Data.Ollama.Common.Utils+  ( -- * Image Encoding+    encodeImage++    -- * HTTP Request Handling+  , withOllamaRequest+  , commonNonStreamingHandler+  , commonStreamHandler+  , nonJsonHandler++    -- * Model Options+  , defaultModelOptions++    -- * Retry Logic+  , withRetry++    -- * Version Retrieval+  , getVersion+  ) where++import Control.Concurrent (threadDelay) import Control.Exception (IOException, try)+import Data.Aeson import Data.ByteString qualified as BS import Data.ByteString.Base64 qualified as Base64+import Data.ByteString.Lazy qualified as BSL import Data.Char (toLower)+import Data.Maybe (fromMaybe)+import Data.Ollama.Common.Config+import Data.Ollama.Common.Error+import Data.Ollama.Common.Error qualified as Error import Data.Ollama.Common.Types import Data.Text (Text)+import Data.Text qualified as T import Data.Text.Encoding qualified as TE+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types (Status (statusCode)) import System.Directory import System.FilePath -defaultOllamaUrl :: Text-defaultOllamaUrl = "http://127.0.0.1:11434"-+-- | List of supported image file extensions for 'encodeImage'. supportedExtensions :: [String] supportedExtensions = [".jpg", ".jpeg", ".png"] +-- | Safely read a file, returning an 'Either' with an 'IOException' on failure. safeReadFile :: FilePath -> IO (Either IOException BS.ByteString) safeReadFile = try . BS.readFile +-- | Read a file if it exists, returning 'Nothing' if it does not. asPath :: FilePath -> IO (Maybe BS.ByteString) asPath filePath = do   exists <- doesFileExist filePath@@ -28,13 +73,15 @@     then either (const Nothing) Just <$> safeReadFile filePath     else return Nothing +-- | Check if a file has a supported image extension. isSupportedExtension :: FilePath -> Bool-isSupportedExtension path = map toLower (takeExtension path) `elem` supportedExtensions+isSupportedExtension p = map toLower (takeExtension p) `elem` supportedExtensions -{- |-  encodeImage is a utility function that takes an image file path (jpg, jpeg, png) and-  returns the image data in Base64 encoded format. Since GenerateOps' images field-  expects image data in base64. It is helper function that we are providing out of the box.+{- | Encodes an image file to Base64 format.++Takes a file path to an image (jpg, jpeg, or png) and returns its data encoded as a Base64 'Text'.+Returns 'Nothing' if the file extension is unsupported or the file cannot be read.+This is useful for including images in API requests that expect Base64-encoded data, such as 'GenerateOps' images field. -} encodeImage :: FilePath -> IO (Maybe Text) encodeImage filePath = do@@ -43,3 +90,214 @@     else do       maybeContent <- asPath filePath       return $ fmap (TE.decodeUtf8 . Base64.encode) maybeContent++{- | Executes an action with retry logic for recoverable errors.++Retries the given action up to the specified number of times with a delay (in seconds) between attempts.+Only retries on recoverable errors such as HTTP errors, timeouts, JSON schema errors, or decoding errors.+-}+withRetry ::+  -- | Number of retries+  Int ->+  -- | Delay between retries in seconds+  Int ->+  -- | Action to execute, returning 'Either' 'OllamaError' or a result+  IO (Either OllamaError a) ->+  IO (Either OllamaError a)+withRetry 0 _ action = action+withRetry retries delaySeconds action = do+  result <- action+  case result of+    Left err | isRetryableError err -> do+      threadDelay (delaySeconds * 1000000) -- Convert to microseconds+      withRetry (retries - 1) delaySeconds action+    _ -> return result+  where+    isRetryableError (HttpError _) = True+    isRetryableError (TimeoutError _) = True+    isRetryableError (JsonSchemaError _) = True+    isRetryableError (DecodeError _ _) = True+    isRetryableError _ = False++{- | Sends an HTTP request to the Ollama API.++A unified function for making API requests to the Ollama server. Supports both GET and POST methods,+customizable payloads, and optional configuration. The response is processed by the provided handler.+-}+withOllamaRequest ::+  forall payload response.+  (ToJSON payload) =>+  -- | API endpoint+  Text ->+  -- | HTTP method ("GET" or "POST")+  BS.ByteString ->+  -- | Optional request payload (must implement 'ToJSON')+  Maybe payload ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig')+  Maybe OllamaConfig ->+  -- | Response handler to process the HTTP response+  (Response BodyReader -> IO (Either OllamaError response)) ->+  IO (Either OllamaError response)+withOllamaRequest endpoint reqMethod mbPayload mbOllamaConfig handler = do+  let OllamaConfig {..} = fromMaybe defaultOllamaConfig mbOllamaConfig+      fullUrl = T.unpack $ hostUrl <> endpoint+      timeoutMicros = timeout * 1000000+  manager <- case commonManager of+    Nothing ->+      newTlsManagerWith+        tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro timeoutMicros}+    Just m -> pure m+  eRequest <- try $ parseRequest fullUrl+  case eRequest of+    Left ex -> return $ Left $ Error.HttpError ex+    Right req -> do+      let request =+            req+              { method = reqMethod+              , requestBody =+                  maybe mempty (RequestBodyLBS . encode) mbPayload+              }+          retryCnt = fromMaybe 0 retryCount+          retryDelay_ = fromMaybe 1 retryDelay+      withRetry retryCnt retryDelay_ $ do+        fromMaybe (pure ()) onModelStart+        eResponse <- try $ withResponse request manager handler+        case eResponse of+          Left ex -> do+            fromMaybe (pure ()) onModelError+            case ex of+              (HttpExceptionRequest _ ResponseTimeout) ->+                return $ Left $ Error.TimeoutError "No response from LLM yet"+              _ -> return $ Left $ Error.HttpError ex+          Right result -> do+            fromMaybe (pure ()) onModelFinish+            return result++{- | Handles non-streaming API responses.++Processes an HTTP response, accumulating all chunks until EOF and decoding the result as JSON.+Returns an 'Either' with an 'OllamaError' on failure or the decoded response on success.+Suitable for APIs that return a single JSON response.+-}+commonNonStreamingHandler ::+  FromJSON a =>+  Response BodyReader ->+  IO (Either OllamaError a)+commonNonStreamingHandler resp = do+  let bodyReader = responseBody resp+      respStatus = statusCode $ responseStatus resp+  if respStatus >= 200 && respStatus < 300+    then do+      finalBs <- readFullBuff BS.empty bodyReader+      case eitherDecode (BSL.fromStrict finalBs) of+        Left err -> pure . Left $ Error.DecodeError err (show finalBs)+        Right decoded -> pure . Right $ decoded+    else Left . ApiError . TE.decodeUtf8 <$> brRead bodyReader++{- | Accumulates response chunks into a single ByteString.++Internal helper function to read all chunks from a 'BodyReader' until EOF.+-}+readFullBuff :: BS.ByteString -> BodyReader -> IO BS.ByteString+readFullBuff acc reader = do+  chunk <- brRead reader+  if BS.null chunk+    then pure acc+    else readFullBuff (acc `BS.append` chunk) reader++{- | Handles streaming API responses.++Processes a streaming HTTP response, decoding each chunk as JSON and passing it to the provided+'sendChunk' function. The 'flush' function is called after each chunk. Stops when the response+indicates completion (via 'HasDone'). Returns the final decoded response or an error.+-}+commonStreamHandler ::+  (HasDone a, FromJSON a) =>+  -- | Function to handle each decoded chunk+  (a -> IO (), IO ()) ->+  Response BodyReader ->+  IO (Either OllamaError a)+commonStreamHandler (sendChunk, onComplete) resp = go mempty+  where+    go acc = do+      bs <- brRead $ responseBody resp+      if BS.null bs+        then do+          case eitherDecode (BSL.fromStrict acc) of+            Left err -> pure $ Left $ Error.DecodeError err (show acc)+            Right decoded -> pure $ Right decoded+        else do+          let chunk = BSL.fromStrict bs+          case eitherDecode chunk of+            Left err -> return $ Left $ Error.DecodeError err (show acc)+            Right res -> do+              sendChunk res+              if getDone res then onComplete >> return (Right res) else go (acc <> bs)++{- | Handles non-JSON API responses.++Processes an HTTP response, accumulating all chunks into a 'ByteString'. Returns the accumulated+data on success (HTTP status 2xx) or an 'ApiError' on failure.+-}+nonJsonHandler :: Response BodyReader -> IO (Either OllamaError BS.ByteString)+nonJsonHandler resp = do+  let bodyReader = responseBody resp+      respStatus = statusCode $ responseStatus resp+  if respStatus >= 200 && respStatus < 300+    then Right <$> readFullBuff BS.empty bodyReader+    else Left . ApiError . TE.decodeUtf8 <$> brRead bodyReader++{- | Default model options for API requests.++Provides a default 'ModelOptions' configuration with all fields set to 'Nothing',+suitable as a starting point for customizing model parameters like temperature or token limits.++Example:++>>> let opts = defaultModelOptions { temperature = Just 0.7 }+-}+defaultModelOptions :: ModelOptions+defaultModelOptions =+  ModelOptions+    { numKeep = Nothing+    , seed = Nothing+    , numPredict = Nothing+    , topK = Nothing+    , topP = Nothing+    , minP = Nothing+    , typicalP = Nothing+    , repeatLastN = Nothing+    , temperature = Nothing+    , repeatPenalty = Nothing+    , presencePenalty = Nothing+    , frequencyPenalty = Nothing+    , penalizeNewline = Nothing+    , stop = Nothing+    , numa = Nothing+    , numCtx = Nothing+    , numBatch = Nothing+    , numGpu = Nothing+    , mainGpu = Nothing+    , useMmap = Nothing+    , numThread = Nothing+    }++{- | Retrieves the Ollama server version.++Sends a GET request to the @\/api\/version@ endpoint and returns the server version+as a 'Version' wrapped in an 'Either' 'OllamaError'.++Example:++>>> getVersion++@since 0.2.0.0+-}+getVersion :: IO (Either OllamaError Version)+getVersion = do+  withOllamaRequest+    "/api/version"+    "GET"+    (Nothing :: Maybe Value)+    Nothing+    commonNonStreamingHandler
+ src/Data/Ollama/Conversation.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Data.Ollama.Conversation+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Conversation management for the Ollama client, including storage and retrieval of chat sessions.++This module provides types and functions for managing conversations in the Ollama client. It defines+a 'Conversation' type to represent a chat session, a 'ConversationStore' typeclass for storage operations,+and an in-memory implementation using 'InMemoryStore' and 'ConvoM'. The module supports saving, loading,+listing, and deleting conversations, with thread-safe operations using STM (Software Transactional Memory).++The 'Conversation' type includes metadata such as a unique ID, messages, model name, and timestamps.+The 'ConversationStore' typeclass defines a generic interface for conversation storage, while 'InMemoryStore'+provides a concrete in-memory implementation. The 'ConvoM' monad integrates with 'InMemoryStore' for+monadic operations.++Example:++>>> store <- initInMemoryStore+>>> let conv = Conversation "conv1" [userMessage "Hello!"] "gemma3" <$> getCurrentTime <*> getCurrentTime+>>> runInMemoryConvo store $ saveConversation conv+>>> runInMemoryConvo store $ loadConversation "conv1"+Just (Conversation ...)+-}+module Data.Ollama.Conversation+  ( -- * Conversation Types+    Conversation (..)+  , ConversationStore (..)++    -- * In-Memory Store+  , InMemoryStore (..)+  , ConvoM (..)+  , initInMemoryStore+  , runInMemoryConvo++    -- * Validation+  , validateConversation+  ) where++import Control.Concurrent.STM+import Control.Monad.Reader+import Data.Aeson (FromJSON, ToJSON)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Ollama.Common.Types+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, getCurrentTime)+import GHC.Generics (Generic)++{- | Represents a chat session with metadata and messages.++Stores a conversation's unique identifier, list of messages, model name, creation time, and last updated time.+-}+data Conversation = Conversation+  { conversationId :: !Text+  -- ^ Unique identifier for the conversation.+  , messages :: ![Message]+  -- ^ List of messages in the conversation.+  , model :: !Text+  -- ^ Name of the model used in the conversation (e.g., "gemma3").+  , createdAt :: !UTCTime+  -- ^ Timestamp when the conversation was created.+  , lastUpdated :: !UTCTime+  -- ^ Timestamp when the conversation was last updated.+  }+  deriving (Show, Eq, Generic)++instance ToJSON Conversation+instance FromJSON Conversation++{- | Typeclass defining operations for storing and managing conversations.++Provides methods for saving, loading, listing, and deleting conversations in a monadic context.++@since 0.2.0.0+-}+class Monad m => ConversationStore m where+  -- | Saves a conversation to the store.+  --+  -- Validates the conversation and updates its 'lastUpdated' timestamp before saving.+  saveConversation :: Conversation -> m ()++  -- | Loads a conversation by its ID.+  --+  -- Returns 'Just' the conversation if found, or 'Nothing' if not.+  loadConversation :: Text -> m (Maybe Conversation)++  -- | Lists all conversations in the store.+  listConversations :: m [Conversation]++  -- | Deletes a conversation by its ID.+  --+  -- Returns 'True' if the conversation was found and deleted, 'False' otherwise.+  deleteConversation :: Text -> m Bool++{- | In-memory conversation store using a 'TVar' for thread-safe operations.++Stores conversations in a 'Map' keyed by conversation IDs, wrapped in a 'TVar' for concurrent access.+-}+newtype InMemoryStore = InMemoryStore (TVar (Map Text Conversation))++{- | Monad for operations with 'InMemoryStore'.++A wrapper around 'ReaderT' that provides access to an 'InMemoryStore' in a monadic context.+-}+newtype ConvoM a = ConvoM {runConvoM :: ReaderT InMemoryStore IO a}+  deriving (Functor, Applicative, Monad, MonadIO, MonadReader InMemoryStore)++{- | Runs a 'ConvoM' action with the given 'InMemoryStore'.++Executes a monadic computation in the context of an in-memory store.++Example:++>>> store <- initInMemoryStore+>>> runInMemoryConvo store $ saveConversation conv+-}+runInMemoryConvo :: InMemoryStore -> ConvoM a -> IO a+runInMemoryConvo store = flip runReaderT store . runConvoM++instance ConversationStore ConvoM where+  saveConversation conv = do+    case validateConversation conv of+      Left err -> liftIO $ putStrLn ("Validation error: " <> T.unpack err)+      Right validConv -> do+        now <- liftIO getCurrentTime+        let updatedConv = validConv {lastUpdated = now}+        InMemoryStore ref <- ask+        liftIO . atomically $ modifyTVar' ref (Map.insert (conversationId updatedConv) updatedConv)++  loadConversation cid = do+    InMemoryStore ref <- ask+    convs <- liftIO $ readTVarIO ref+    return $ Map.lookup cid convs++  listConversations = do+    InMemoryStore ref <- ask+    convs <- liftIO $ readTVarIO ref+    return $ Map.elems convs++  deleteConversation cid = do+    InMemoryStore ref <- ask+    liftIO . atomically $ do+      convs <- readTVar ref+      if Map.member cid convs+        then do+          writeTVar ref (Map.delete cid convs)+          return True+        else return False++{- | Validates a 'Conversation' to ensure required fields are non-empty.++Checks that the 'conversationId' is not empty and that the 'messages' list contains at least one message.+Returns 'Right' with the validated conversation or 'Left' with an error message.++Example:++>>> let conv = Conversation "" [] "gemma3" time time+>>> validateConversation conv+Left "Conversation ID cannot be empty"+-}+validateConversation :: Conversation -> Either Text Conversation+validateConversation conv+  | T.null (conversationId conv) = Left "Conversation ID cannot be empty"+  | null (messages conv) = Left "Conversation must have at least one message"+  | otherwise = Right conv++{- | Creates a new empty in-memory conversation store.++Initializes an 'InMemoryStore' with an empty 'Map' wrapped in a 'TVar' for thread-safe operations.++Example:++>>> store <- initInMemoryStore+>>> runInMemoryConvo store $ listConversations+[]+-}+initInMemoryStore :: IO InMemoryStore+initInMemoryStore = InMemoryStore <$> newTVarIO Map.empty
src/Data/Ollama/Copy.hs view
@@ -3,53 +3,84 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.Copy+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for copying models in the Ollama client.++This module provides functions to copy a model from a source name to a destination name using the Ollama API.+It includes both an IO-based function ('copyModel') and a monadic version ('copyModelM') for use in+'MonadIO' contexts. The copy operation is performed via a POST request to the @\/api\/copy@ endpoint.++Example:++>>> copyModel "gemma3" "gemma3-copy" Nothing+Right ()+-} module Data.Ollama.Copy   ( -- * Copy Model API     copyModel+  , copyModelM   ) where -import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.Ollama.Common.Utils qualified as CU+import Data.Ollama.Common.Config (OllamaConfig (..))+import Data.Ollama.Common.Error (OllamaError)+import Data.Ollama.Common.Utils (nonJsonHandler, withOllamaRequest) import Data.Text (Text)-import Data.Text qualified as T import GHC.Generics-import Network.HTTP.Client-import Network.HTTP.Types.Status (status404) --- TODO: Add Options parameter--- TODO: Add Context parameter+-- | Configuration for copying a model. data CopyModelOps = CopyModelOps-  { source :: Text-  , destination :: Text+  { source :: !Text+  -- ^ The name of the source model to copy.+  , destination :: !Text+  -- ^ The name of the destination model.   }   deriving (Show, Eq, Generic, ToJSON) --- | Copy model from source to destination+{- | Copies a model from a source name to a destination name.++Sends a POST request to the @\/api\/copy@ endpoint with the source and destination model names.+Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure.+Example:++>>> copyModel "gemma3" "gemma3-copy" Nothing+Right ()+-} copyModel ::-  -- | Source model+  -- | Source model name   Text ->-  -- | Destination model+  -- | Destination model name   Text ->-  IO ()+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError ()) copyModel   source_-  destination_ =-    do-      let url = CU.defaultOllamaUrl-      manager <- newManager defaultManagerSettings-      initialRequest <- parseRequest $ T.unpack (url <> "/api/copy")-      let reqBody =-            CopyModelOps-              { source = source_-              , destination = destination_-              }-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      response <- httpLbs request manager-      when-        (responseStatus response == status404)-        (putStrLn "Source Model does not exist")+  destination_+  mbConfig = do+    let reqBody = CopyModelOps {source = source_, destination = destination_}+    withOllamaRequest+      "/api/copy"+      "POST"+      (Just reqBody)+      mbConfig+      (fmap (const () <$>) . nonJsonHandler)++{- | MonadIO version of 'copyModel' for use in monadic contexts.++Lifts the 'copyModel' function into a 'MonadIO' context, allowing it to be used in monadic computations.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (copyModelM "gemma3" "gemma3-copy" Nothing) someContext+Right ()+-}+copyModelM :: MonadIO m => Text -> Text -> Maybe OllamaConfig -> m (Either OllamaError ())+copyModelM s d mbCfg = liftIO $ copyModel s d mbCfg
src/Data/Ollama/Create.hs view
@@ -1,120 +1,214 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Create+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for creating new models in the Ollama client.++This module provides functions to create new models in the Ollama API. Models can be created from:++- Another existing model (using 'from' parameter)+- A safetensors directory (using 'files' parameter)+- A GGUF file (using 'files' parameter)++The create operation is performed via a POST request to the @\/api\/create@ endpoint, with streaming+support for progress updates. The module supports model quantization, custom templates, system prompts,+parameters, and LORA adapters.++Example creating from existing model:++>>> let ops = defaultCreateOps { modelName = "mario", fromModel = Just "llama3.2", systemPrompt = Just "You are Mario from Super Mario Bros." }+>>> createModel ops Nothing+Creating model...+Success++Example quantizing a model:++>>> let ops = defaultCreateOps { modelName = "llama3.2:quantized", fromModel = Just "llama3.2:3b-instruct-fp16", quantizeType = Just Q4_K_M }+>>> createModel ops Nothing+Quantizing model...+Success+-} module Data.Ollama.Create   ( -- * Create Model API     createModel-  , createModelOps+  , createModelM++    -- * Configuration Types+  , CreateOps (..)+  , defaultCreateOps++    -- * Response Types+  , CreateResp (..)++    -- * Quantization Types+  , QuantizationType (..)   ) where -import Control.Monad (unless)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL+import Data.Map.Strict (Map)+import Data.Maybe (catMaybes)+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Types (HasDone (getDone), Message, ModelOptions) import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.IO qualified as T-import Network.HTTP.Client+import GHC.Generics (Generic)+import GHC.Int (Int64) --- TODO: Add Options parameter--- TODO: Add Context parameter-data CreateModelOps = CreateModelOps-  { name :: Text-  , modelFile :: Maybe Text-  , stream :: Maybe Bool-  , path :: Maybe FilePath+-- | Quantization types supported by Ollama.+data QuantizationType+  = -- | Recommended quantization type+    Q4_K_M+  | -- | Alternative quantization type+    Q4_K_S+  | -- | Recommended quantization type+    Q8_0+  deriving (Show, Eq, Generic)++instance ToJSON QuantizationType where+  toJSON Q4_K_M = String "q4_K_M"+  toJSON Q4_K_S = String "q4_K_S"+  toJSON Q8_0 = String "q8_0"++instance FromJSON QuantizationType where+  parseJSON = withText "QuantizationType" $ \t ->+    case t of+      "q4_K_M" -> pure Q4_K_M+      "q4_K_S" -> pure Q4_K_S+      "q8_0" -> pure Q8_0+      _ -> fail $ "Invalid QuantizationType: " <> show t++-- | Configuration for creating a new model.+data CreateOps = CreateOps+  { modelName :: !Text+  -- ^ The name of the model to create.+  , fromModel :: !(Maybe Text)+  -- ^ Optional name of an existing model to create the new model from.+  , files :: !(Maybe (Map Text Text))+  -- ^ Optional dictionary of file names to SHA256 digests of blobs to create the model from.+  , adapters :: !(Maybe (Map Text Text))+  -- ^ Optional dictionary of file names to SHA256 digests of blobs for LORA adapters.+  , template :: !(Maybe Text)+  -- ^ Optional prompt template for the model.+  , license :: !(Maybe [Text])+  -- ^ Optional list of strings containing the license(s) for the model.+  , systemPrompt :: !(Maybe Text)+  -- ^ Optional system prompt for the model.+  , parameters :: !(Maybe ModelOptions)+  -- ^ Optional parameters for the model.+  , messages :: !(Maybe [Message])+  -- ^ Optional list of message objects used to create a conversation.+  , stream :: !(Maybe Bool)+  -- ^ Optional flag to enable streaming progress updates.+  , quantizeType :: !(Maybe QuantizationType)+  -- ^ Optional quantization type for quantizing a non-quantized model.   }-  deriving (Show, Eq)+  deriving (Show, Eq, Generic) --- TODO: Add Context Param-newtype CreateModelResp = CreateModelResp {status :: Text}-  deriving (Show, Eq)+-- | Default configuration for creating a model.+defaultCreateOps :: Text -> CreateOps+defaultCreateOps name =+  CreateOps+    { modelName = name+    , fromModel = Nothing+    , files = Nothing+    , adapters = Nothing+    , template = Nothing+    , license = Nothing+    , systemPrompt = Nothing+    , parameters = Nothing+    , messages = Nothing+    , stream = Nothing+    , quantizeType = Nothing+    } -instance ToJSON CreateModelOps where-  toJSON-    ( CreateModelOps-        name_-        modelFile_-        stream_-        path_-      ) =-      object-        [ "name" .= name_-        , "modelfile" .= modelFile_-        , "stream" .= stream_-        , "path" .= path_+-- | Response type for model creation operations.+data CreateResp = CreateResp+  { status :: !Text+  -- ^ The status of the create operation (e.g., "success", "reading model metadata").+  , digest :: !(Maybe Text)+  -- ^ Optional digest (hash) of the model layer being processed.+  , total :: !(Maybe Int64)+  -- ^ Optional total size in bytes for quantization operations.+  , completed :: !(Maybe Int64)+  -- ^ Optional number of bytes completed for quantization operations.+  }+  deriving (Show, Eq, Generic)++instance HasDone CreateResp where+  getDone CreateResp {..} = status == "success"++instance ToJSON CreateOps where+  toJSON CreateOps {..} =+    object $+      catMaybes+        [ Just ("model" .= modelName)+        , ("from" .=) <$> fromModel+        , ("files" .=) <$> files+        , ("adapters" .=) <$> adapters+        , ("template" .=) <$> template+        , ("license" .=) <$> license+        , ("system" .=) <$> systemPrompt+        , ("parameters" .=) <$> parameters+        , ("messages" .=) <$> messages+        , ("stream" .=) <$> stream+        , ("quantize" .=) <$> quantizeType         ] -instance FromJSON CreateModelResp where-  parseJSON = withObject "CreateModelResp" $ \v ->-    CreateModelResp+instance FromJSON CreateResp where+  parseJSON = withObject "CreateResp" $ \v ->+    CreateResp       <$> v .: "status"+      <*> v .:? "digest"+      <*> v .:? "total"+      <*> v .:? "completed" -{- | Create a new model either from ModelFile or Path-Please note, if you specify both ModelFile and Path, ModelFile will be used.--}-createModelOps ::-  -- | Model Name-  Text ->-  -- | Model File-  Maybe Text ->-  -- | Stream-  Maybe Bool ->-  -- | Path-  Maybe FilePath ->-  IO ()-createModelOps-  modelName-  modelFile_-  stream_-  path_ =-    do-      let url = defaultOllamaUrl-      manager <- newManager defaultManagerSettings-      initialRequest <- parseRequest $ T.unpack (url <> "/api/create")-      let reqBody =-            CreateModelOps-              { name = modelName-              , modelFile = modelFile_-              , stream = stream_-              , path = path_-              }-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      withResponse request manager $ \response -> do-        let go = do-              bs <- brRead $ responseBody response-              let eRes =-                    eitherDecode (BSL.fromStrict bs) ::-                      Either String CreateModelResp-              case eRes of-                Left err -> do-                  putStrLn $ "Error: " <> err-                Right res -> do-                  unless-                    (status res /= "success")-                    ( do-                        T.putStr $ status res-                        go-                    )-        go+{- | Creates a new model according to the provided configuration. -{- | Create a new model-| Please note, if you specify both ModelFile and Path, ModelFile will be used.+Sends a POST request to the @\/api\/create@ endpoint to create a model. The model can be created from:++- Another existing model (specify 'fromModel')+- A safetensors directory (specify 'files' with file name to SHA256 digest mappings)+- A GGUF file (specify 'files' with file name to SHA256 digest mapping)++Supports quantization, custom templates, system prompts, parameters, and LORA adapters.+Prints progress messages to the console during creation. -} createModel ::-  -- | Model Name-  Text ->-  -- | Model File-  Maybe Text ->-  -- | Path-  Maybe FilePath ->+  -- | Model creation configuration+  CreateOps ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->   IO ()-createModel modelName modelFile_ =-  createModelOps-    modelName-    modelFile_-    Nothing+createModel createOps mbConfig =+  void $+    withOllamaRequest+      "/api/create"+      "POST"+      (Just createOps)+      mbConfig+      (commonStreamHandler (onToken, pure ()))+  where+    onToken :: CreateResp -> IO ()+    onToken CreateResp {..} = case (total, completed) of+      (Just t, Just c) -> putStrLn $ "Progress: " <> show c <> "/" <> show t <> " bytes"+      _ -> putStrLn $ "Status: " <> show status++{- | MonadIO version of 'createModel' for use in monadic contexts.++Lifts the 'createModel' function into a 'MonadIO' context, allowing it to be used in monadic computations.+-}+createModelM ::+  MonadIO m =>+  CreateOps ->+  Maybe OllamaConfig ->+  m ()+createModelM createOps mbCfg = liftIO $ createModel createOps mbCfg
src/Data/Ollama/Delete.hs view
@@ -3,42 +3,69 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.Delete+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for deleting models in the Ollama client.++This module provides functions to delete a model from the Ollama server using its name. It includes+both an IO-based function ('deleteModel') and a monadic version ('deleteModelM') for use in+'MonadIO' contexts. The delete operation is performed via a DELETE request to the @\/api\/delete@ endpoint.++Example:++>>> deleteModel "gemma3" Nothing+Right ()+-} module Data.Ollama.Delete-  ( -- * Delete downloaded Models+  ( -- * Delete Model API     deleteModel+  , deleteModelM   ) where -import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.Ollama.Common.Utils qualified as CU+import Data.Ollama.Common.Config (OllamaConfig (..))+import Data.Ollama.Common.Error (OllamaError)+import Data.Ollama.Common.Utils (nonJsonHandler, withOllamaRequest) import Data.Text (Text)-import Data.Text qualified as T-import Network.HTTP.Client-import Network.HTTP.Types.Status (status404) --- TODO: Add Options parameter--- TODO: Add Context parameter-newtype DeleteModelReq = DeleteModelReq {name :: Text}-  deriving newtype (Show, Eq, ToJSON)+-- | Request payload for deleting a model.+newtype DeleteModelReq+  = -- | The name of the model to delete.+    DeleteModelReq {name :: Text}+  deriving newtype (Show, Eq) --- | Delete a model+instance ToJSON DeleteModelReq where+  toJSON (DeleteModelReq name_) = object ["name" .= name_]++{- | Deletes a model from the Ollama server.++Sends a DELETE request to the "/api/delete" endpoint with the specified model name.+Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure.+-} deleteModel ::-  -- | Model name+  -- | Model name to delete   Text ->-  IO ()-deleteModel modelName =-  do-    let url = CU.defaultOllamaUrl-    manager <- newManager defaultManagerSettings-    initialRequest <- parseRequest $ T.unpack (url <> "/api/delete")-    let reqBody =-          DeleteModelReq {name = modelName}-        request =-          initialRequest-            { method = "DELETE"-            , requestBody = RequestBodyLBS $ encode reqBody-            }-    response <- httpLbs request manager-    when-      (responseStatus response == status404)-      (putStrLn "Model does not exist")+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError ())+deleteModel modelName mbConfig = do+  let reqBody = DeleteModelReq {name = modelName}+  withOllamaRequest+    "/api/delete"+    "DELETE"+    (Just reqBody)+    mbConfig+    (fmap (const () <$>) . nonJsonHandler)++{- | MonadIO version of 'deleteModel' for use in monadic contexts.++Lifts the 'deleteModel' function into a  context,+allowing it to be used in monadic computations.+-}+deleteModelM :: MonadIO m => Text -> Maybe OllamaConfig -> m (Either OllamaError ())+deleteModelM t mbCfg = liftIO $ deleteModel t mbCfg
src/Data/Ollama/Embeddings.hs view
@@ -1,102 +1,189 @@-{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.Embeddings+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for generating text embeddings using the Ollama API.++This module provides functions to generate text embeddings from an Ollama model. It includes both+high-level ('embedding', 'embeddingM') and low-level ('embeddingOps', 'embeddingOpsM') APIs for+generating embeddings, with support for customizing model options, truncation, and keep-alive settings.+The embeddings are returned as a list of float vectors, suitable for tasks like semantic search or+text similarity analysis.++The 'EmbeddingOps' type configures the embedding request, and 'EmbeddingResp' represents the response+containing the model name and the generated embeddings. The 'defaultEmbeddingOps' provides a default+configuration for convenience.++Example:++>>> embedding "llama3.2" ["Hello, world!"]+Right (EmbeddingResp "llama3.2" [[0.1, 0.2, ...]])+-} module Data.Ollama.Embeddings   ( -- * Embedding API     embedding   , embeddingOps+  , embeddingM+  , embeddingOpsM++    -- * Configuration and Response Types+  , defaultEmbeddingOps   , EmbeddingOps (..)   , EmbeddingResp (..)++    -- * Model Options+  , ModelOptions (..)+  , defaultModelOptions   ) where +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Error (OllamaError)+import Data.Ollama.Common.Types (ModelOptions (..)) import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T-import Network.HTTP.Client-import Control.Exception (try)-import Data.ByteString.Lazy.Char8 (ByteString) --- TODO: Add Options parameter+{- | Default configuration for embedding requests.++Provides a default 'EmbeddingOps' with the "llama3.2" model, an empty input list, and no additional options.+Can be customized by modifying fields as needed.+-}+defaultEmbeddingOps :: EmbeddingOps+defaultEmbeddingOps =+  EmbeddingOps+    { modelName = "nomic-embed-text"+    , input = []+    , truncateInput = Nothing+    , keepAlive = Nothing+    , modelOptions = Nothing+    , dimensions = Nothing+    }++-- | Configuration for an embedding request. data EmbeddingOps = EmbeddingOps-  { model :: Text-  , input :: Text-  , truncate :: Maybe Bool-  , keepAlive :: Maybe Text+  { modelName :: !Text+  -- ^ The name of the model to use for generating embeddings (e.g., "llama3.2").+  , input :: ![Text]+  -- ^ List of input texts to generate embeddings for.+  , truncateInput :: !(Maybe Bool)+  -- ^ Optional flag to truncate input if it exceeds model limits.+  , keepAlive :: !(Maybe Int)+  -- ^ Optional override for the keep-alive timeout in minutes.+  , modelOptions :: !(Maybe ModelOptions)+  -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile.+  --+  -- @since 0.2.0.0+  , dimensions :: !(Maybe Int)+  -- ^ number of dimensions for the embedding+  --+  -- @since 0.2.1.0   }   deriving (Show, Eq) +-- | Response type for an embedding request. data EmbeddingResp = EmbeddingResp-  { model :: Text-  , embedding_ :: [[Float]]+  { respondedModel :: !Text+  -- ^ The name of the model that generated the embeddings.+  , respondedEmbeddings :: ![[Float]]+  -- ^ List of embedding vectors, one for each input text.   }   deriving (Show, Eq)  instance FromJSON EmbeddingResp where-  parseJSON = withObject "EmbeddingResp" $ \v -> EmbeddingResp-        <$> v .: "model"-        <*> v .: "embeddings"+  parseJSON = withObject "EmbeddingResp" $ \v ->+    EmbeddingResp+      <$> v .: "model"+      <*> v .: "embeddings"  instance ToJSON EmbeddingOps where-  toJSON (EmbeddingOps model_ input_ truncate' keepAlive_) =+  toJSON (EmbeddingOps model_ input_ truncate' keepAlive_ ops dimensions_) =     object       [ "model" .= model_       , "input" .= input_       , "truncate" .= truncate'       , "keep_alive" .= keepAlive_+      , "options" .= ops+      , "dimensions" .= dimensions_       ] --- TODO: Add Options parameter+{- | Generates embeddings for a list of input texts with full configuration. --- | Embedding API+Sends a POST request to the @\/api\/embed@ endpoint to generate embeddings for the provided inputs.+Allows customization of truncation, keep-alive settings, model options, and Ollama configuration.+Returns 'Right' with an 'EmbeddingResp' on success or 'Left' with an 'OllamaError' on failure.+-} embeddingOps ::-  -- | Model-  Text ->-  -- | Input+  -- | Model name   Text ->-  -- | Truncate+  -- | List of input texts+  [Text] ->+  -- | Optional truncation flag   Maybe Bool ->-  -- | Keep Alive-  Maybe Text ->-  IO (Either String EmbeddingResp)-embeddingOps modelName input_ mTruncate mKeepAlive = do-  let url = defaultOllamaUrl-  manager <- newManager defaultManagerSettings-  --einitialRequest <- parseRequest $ T.unpack (url <> "/api/embed")-  eInitialRequest <--    try $ parseRequest $ T.unpack (url <> "/api/embed") :: IO (Either HttpException Request)-  case eInitialRequest of-    Left e -> do-      return $ Left $ show e-    Right initialRequest -> do-      let reqBody =-            EmbeddingOps-              { model = modelName-              , input = input_-              , truncate = mTruncate-              , keepAlive = mKeepAlive-              }-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      eResp <- try $ httpLbs request manager :: IO (Either HttpException (Response ByteString))-      case eResp of-        Left err -> return $ Left (show err)-        Right resp -> -          case decode (responseBody resp) of-            Nothing -> return $ Left $ "Couldn't decode response: " <> show (responseBody resp)-            Just r -> return $ Right r+  -- | Optional keep-alive timeout in minutes+  Maybe Int ->+  -- | Optional model options+  Maybe ModelOptions ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe Int ->+  Maybe OllamaConfig ->+  IO (Either OllamaError EmbeddingResp)+embeddingOps modelName_ input_ mTruncate mKeepAlive mbOptions mbDimensions mbConfig = do+  withOllamaRequest+    "/api/embed"+    "POST"+    ( Just $+        EmbeddingOps+          { modelName = modelName_+          , input = input_+          , truncateInput = mTruncate+          , keepAlive = mKeepAlive+          , modelOptions = mbOptions+          , dimensions = mbDimensions+          }+    )+    mbConfig+    commonNonStreamingHandler --- Higher level binding that only takes important params+{- | Simplified API for generating embeddings. --- | Embedding API+A higher-level function that generates embeddings using default settings for truncation, keep-alive,+model options, and Ollama configuration. Suitable for basic use cases.+-} embedding ::-  -- | Model+  -- | Model name   Text ->-  -- | Input+  -- | List of input texts+  [Text] ->+  IO (Either OllamaError EmbeddingResp)+embedding modelName_ input_ =+  embeddingOps modelName_ input_ Nothing Nothing Nothing Nothing Nothing++{- | MonadIO version of 'embedding' for use in monadic contexts.++Lifts the 'embedding' function into a 'MonadIO' context, allowing it to be used in monadic computations.+-}+embeddingM :: MonadIO m => Text -> [Text] -> m (Either OllamaError EmbeddingResp)+embeddingM m ip = liftIO $ embedding m ip++{- | MonadIO version of 'embeddingOps' for use in monadic contexts.++Lifts the 'embeddingOps' function into a 'MonadIO' context, allowing it to be used in monadic computations+with full configuration options.+-}+embeddingOpsM ::+  MonadIO m =>   Text ->-  IO (Either String EmbeddingResp)-embedding modelName input_ =-  embeddingOps modelName input_ Nothing Nothing+  [Text] ->+  Maybe Bool ->+  Maybe Int ->+  Maybe ModelOptions ->+  Maybe Int ->+  Maybe OllamaConfig ->+  m (Either OllamaError EmbeddingResp)+embeddingOpsM m ip mbTruncate mbKeepAlive mbOptions mbDimensions mbCfg =+  liftIO $ embeddingOps m ip mbTruncate mbKeepAlive mbOptions mbDimensions mbCfg
src/Data/Ollama/Generate.hs view
@@ -2,80 +2,111 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Generate+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Text generation functionality for the Ollama client.++This module provides functions and types for generating text using an Ollama model. It includes APIs+for sending generation requests, both in IO ('generate') and monadic ('generateM') contexts, with+support for streaming and non-streaming responses. The 'GenerateOps' type configures the generation+request, allowing customization of the model, prompt, images, format, and other parameters. The+'defaultGenerateOps' provides a convenient starting point for configuration.++The module supports advanced features like Base64-encoded images, custom templates, and model-specific+options (e.g., temperature). It also includes validation to ensure required fields are non-empty.++Example:++>>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Write a poem." }+>>> generate ops Nothing+Right (GenerateResponse ...)+-} module Data.Ollama.Generate   ( -- * Generate Texts     generate+  , generateM++    -- * Configuration   , defaultGenerateOps-  , generateJson   , GenerateOps (..)+  , validateGenerateOps++    -- * Response and Configuration Types   , GenerateResponse (..)+  , Format (..)+  , OllamaConfig (..)+  , defaultOllamaConfig+  , ModelOptions (..)+  , defaultModelOptions++    -- * Error Types+  , OllamaError (..)   ) where -import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.ByteString.Char8 qualified as BS-import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Maybe+import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Data.Ollama.Common.Error (OllamaError (..))+import Data.Ollama.Common.Types (Format (..), GenerateResponse (..), ModelOptions (..)) import Data.Ollama.Common.Utils as CU-import Data.Ollama.Common.Types (Format(..)) import Data.Text (Text) import Data.Text qualified as T-import Data.Text.Encoding qualified as T-import Data.Time (UTCTime)-import GHC.Int (Int64)-import Network.HTTP.Client --- TODO: Add Options parameter--- TODO: Add Context parameter+{- | Validates 'GenerateOps' to ensure required fields are non-empty. -{- |-  Input type for generate functions. This data type represents all possible configurations-  that you can pass to the Ollama generate API.+Checks that the 'modelName' and 'prompt' fields are not empty. Returns 'Right' with the validated+'GenerateOps' or 'Left' with an 'OllamaError' if validation fails. -  Example:+Example: -  > let ops = GenerateOps-  >         { modelName = "llama3.2"-  >         , prompt = "What is the meaning of life?"-  >         , suffix = Nothing-  >         , images = Nothing-  >         , format = Just "text"-  >         , system = Nothing-  >         , template = Nothing-  >         , stream = Nothing-  >         , raw = Just False-  >         , keepAlive = Just "yes"-  >         }+>>> validateGenerateOps defaultGenerateOps+Left (InvalidRequest "Prompt cannot be empty")++@since 0.2.0.0 -}+validateGenerateOps :: GenerateOps -> Either OllamaError GenerateOps+validateGenerateOps ops+  | T.null (modelName ops) = Left $ InvalidRequest "Model name cannot be empty"+  | T.null (prompt ops) = Left $ InvalidRequest "Prompt cannot be empty"+  | otherwise = Right ops++-- | Configuration for a text generation request. data GenerateOps = GenerateOps-  { modelName :: Text-  -- ^ The name of the model to be used for generation.-  , prompt :: Text-  -- ^ The prompt text that will be provided to the model for generating a response.+  { modelName :: !Text+  -- ^ The name of the model to use for generation (e.g., "gemma3").+  , prompt :: !Text+  -- ^ The prompt text to provide to the model for generating a response.   , suffix :: Maybe Text-  -- ^ An optional suffix to append to the generated text.-  , images :: Maybe [Text]-  -- ^ Optional list of base64 encoded images to include with the request.-  , format :: Maybe Format-  -- ^ An optional format specifier for the response.-  -- ^ Since 0.1.3.0-  , system :: Maybe Text-  -- ^ Optional system text that can be included in the generation context.-  , template :: Maybe Text-  -- ^ An optional template to format the response.-  , stream :: Maybe (GenerateResponse -> IO (), IO ())-  -- ^ An optional streaming function where the first function handles each chunk of response, and the second flushes the stream.-  , raw :: Maybe Bool-  -- ^ An optional flag to return the raw response.-  , keepAlive :: Maybe Text-  -- ^ Optional text to specify keep-alive behavior.-  , hostUrl :: Maybe Text-  -- ^ Override default Ollama host url. Default url = "http://127.0.0.1:11434"-  , responseTimeOut :: Maybe Int-  -- ^ Override default response timeout in minutes. Default = 15 minutes-  , options :: Maybe Value-  -- ^ additional model parameters listed in the documentation for the Modelfile such as temperature-  -- ^ Since 0.1.3.0+  -- ^ Optional suffix to append to the generated text (not supported by all models).+  , images :: !(Maybe [Text])+  -- ^ Optional list of Base64-encoded images to include with the request.+  , format :: !(Maybe Format)+  -- ^ Optional format specifier for the response (e.g., JSON).+  --+  -- @since 0.1.3.0+  , system :: !(Maybe Text)+  -- ^ Optional system text to include in the generation context.+  , template :: !(Maybe Text)+  -- ^ Optional template to format the response.+  , stream :: !(Maybe (GenerateResponse -> IO (), IO ()))+  -- ^ Optional callback function to be called with each incoming response.+  , raw :: !(Maybe Bool)+  -- ^ Optional flag to return the raw response.+  , keepAlive :: !(Maybe Int)+  -- ^ Optional override for how long (in minutes) the model stays loaded in memory (default: 5 minutes).+  , options :: !(Maybe ModelOptions)+  -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile.+  --+  -- @since 0.1.3.0+  , think :: !(Maybe Bool)+  -- ^ Optional flag to enable thinking mode.+  --+  -- @since 0.2.0.0   }  instance Show GenerateOps where@@ -103,6 +134,8 @@       <> show keepAlive       <> ", options : "       <> show options+      <> ", think: "+      <> show think  instance Eq GenerateOps where   (==) a b =@@ -116,35 +149,7 @@       && raw a == raw b       && keepAlive a == keepAlive b       && options a == options b---- TODO: Add Context Param--{- |-Result type for generate function containing the model's response and meta-information.--}-data GenerateResponse = GenerateResponse-  { model :: Text-  -- ^ The name of the model that generated the response.-  , createdAt :: UTCTime-  -- ^ The timestamp when the response was created.-  , response_ :: Text-  -- ^ The generated response from the model.-  , done :: Bool-  -- ^ A flag indicating whether the generation process is complete.-  , totalDuration :: Maybe Int64-  -- ^ Optional total duration in milliseconds for the generation process.-  , loadDuration :: Maybe Int64-  -- ^ Optional load duration in milliseconds for loading the model.-  , promptEvalCount :: Maybe Int64-  -- ^ Optional count of prompt evaluations during the generation process.-  , promptEvalDuration :: Maybe Int64-  -- ^ Optional duration in milliseconds for evaluating the prompt.-  , evalCount :: Maybe Int64-  -- ^ Optional count of evaluations during the generation process.-  , evalDuration :: Maybe Int64-  -- ^ Optional duration in milliseconds for evaluations during the generation process.-  }-  deriving (Show, Eq)+      && think a == think b  instance ToJSON GenerateOps where   toJSON@@ -159,9 +164,8 @@         stream         raw         keepAlive-        _ -- Host url-        _ -- Response timeout-        options +        options+        think       ) =       object         [ "model" .= model@@ -175,37 +179,24 @@         , "raw" .= raw         , "keep_alive" .= keepAlive         , "options" .= options+        , "think" .= think         ] -instance FromJSON GenerateResponse where-  parseJSON = withObject "GenerateResponse" $ \v ->-    GenerateResponse-      <$> v .: "model"-      <*> v .: "created_at"-      <*> v .: "response"-      <*> v .: "done"-      <*> v .:? "total_duration"-      <*> v .:? "load_duration"-      <*> v .:? "prompt_eval_count"-      <*> v .:? "prompt_eval_duration"-      <*> v .:? "eval_count"-      <*> v .:? "eval_duration"+{- | Default configuration for text generation. -{- |-A function to create a default 'GenerateOps' type with preset values.+Provides a default 'GenerateOps' with the "gemma3" model and an empty prompt. Other fields are set+to 'Nothing' or default values. Can be customized by modifying fields as needed.  Example: -> let ops = defaultGenerateOps-> generate ops--This will generate a response using the default configuration.+>>> let ops = defaultGenerateOps { modelName = "customModel", prompt = "Hello!" }+>>> generate ops Nothing -} defaultGenerateOps :: GenerateOps defaultGenerateOps =   GenerateOps-    { modelName = "llama3.2"-    , prompt = "what is 2+2"+    { modelName = "gemma3"+    , prompt = ""     , suffix = Nothing     , images = Nothing     , format = Nothing@@ -214,197 +205,44 @@     , stream = Nothing     , raw = Nothing     , keepAlive = Nothing-    , hostUrl = Nothing-    , responseTimeOut = Nothing     , options = Nothing+    , think = Nothing     } -{- |-Generate function that returns either a 'GenerateResponse' type or an error message.-It takes a 'GenerateOps' configuration and performs a request to the Ollama generate API.--Examples:--Basic usage without streaming:--> let ops = GenerateOps->         { modelName = "llama3.2"->         , prompt = "Tell me a joke."->         , suffix = Nothing->         , images = Nothing->         , format = Nothing->         , system = Nothing->         , template = Nothing->         , stream = Nothing->         , raw = Nothing->         , keepAlive = Nothing->         }-> result <- generate ops-> case result of->   Left errorMsg -> putStrLn ("Error: " ++ errorMsg)->   Right response -> print response+{- | Generates text using the specified model and configuration. -Usage with streaming to print responses to the console:+Validates the 'GenerateOps' configuration and sends a POST request to the @\/api\/generate@ endpoint.+Supports both streaming and non-streaming responses based on the 'stream' field in 'GenerateOps'.+Returns 'Right' with a 'GenerateResponse' on success or 'Left' with an 'OllamaError' on failure. -> void $->   generate->     defaultGenerateOps->       { modelName = "llama3.2"->       , prompt = "what is functional programming?"->       , stream = Just (T.putStr . response_, pure ())->       }+Example: -In this example, the first function in the 'stream' tuple processes each chunk of response by printing it,-and the second function is a simple no-op flush.generate :: GenerateOps -> IO (Either String GenerateResponse)+>>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Write a short poem." }+>>> generate ops Nothing+Right (GenerateResponse ...) -}-generate :: GenerateOps -> IO (Either String GenerateResponse)-generate genOps = do-  let url = fromMaybe defaultOllamaUrl (hostUrl genOps)-      responseTimeout = fromMaybe 15 (responseTimeOut genOps)-  manager <--    newManager -- Setting response timeout to 5 minutes, since llm takes time-      defaultManagerSettings-        { managerResponseTimeout = responseTimeoutMicro (responseTimeout * 60 * 1000000)-        }-  eInitialRequest <--    try $ parseRequest $ T.unpack (url <> "/api/generate") :: IO (Either HttpException Request)-  case eInitialRequest of-    Left e -> do-      return $ Left $ show e-    Right initialRequest -> do-      let reqBody = genOps-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      eRes <--        try (withResponse request manager $ handleRequest genOps) ::-          IO (Either HttpException (Either String GenerateResponse))-      case eRes of-        Left e -> do-          return $ Left $ "HTTP error occured: " <> show e-        Right r -> return r--handleRequest :: GenerateOps -> Response BodyReader -> IO (Either String GenerateResponse)-handleRequest genOps response = do-  let streamResponse sendChunk flush = do-        bs <- brRead $ responseBody response-        if BS.null bs-          then putStrLn "" >> pure (Left "")-          else do-            let eRes = eitherDecode (BSL.fromStrict bs) :: Either String GenerateResponse-            case eRes of-              Left e -> pure (Left e)-              Right r -> do-                _ <- sendChunk r-                _ <- flush-                if done r then pure (Right r) else streamResponse sendChunk flush-  let genResponse op = do-        bs <- brRead $ responseBody response-        if bs == ""-          then do-            let eRes0 = eitherDecode (BSL.fromStrict op) :: Either String GenerateResponse-            case eRes0 of-              Left e -> pure (Left e)-              Right r -> pure (Right r)-          else genResponse (op <> bs)-  case stream genOps of-    Nothing -> genResponse ""-    Just (sendChunk, flush) -> streamResponse sendChunk flush--{- |- generateJson is a higher level function that takes generateOps (similar to generate) and also takes- a Haskell type (that has To and From JSON instance) and returns the response in provided type.-- This function simply calls generate with extra prompt appended to it, telling LLM to return the- response in certain JSON format and serializes the response. This function will be helpful when you- want to use the LLM to do something programmatic.+generate :: GenerateOps -> Maybe OllamaConfig -> IO (Either OllamaError GenerateResponse)+generate ops mbConfig =+  case validateGenerateOps ops of+    Left err -> pure $ Left err+    Right _ -> withOllamaRequest "/api/generate" "POST" (Just ops) mbConfig handler+  where+    handler = maybe commonNonStreamingHandler commonStreamHandler (stream ops) - For Example:-  > let expectedJsonStrucutre = Example {-  >   sortedList = ["sorted List here"]-  > , wasListAlreadSorted = False-  > }-  > eRes2 <- generateJson-  >     defaultGenerateOps-  >      { modelName = "llama3.2"-  >     , prompt = "Sort given list: [4, 2 , 3, 67]. Also tell whether list was already sorted or not."-  >       }-  >     expectedJsonStrucutre-  >     Nothing-  > case eRes2 of-  >   Left e -> putStrLn e-  >   Right r -> print ("JSON response: " :: String, r)+{- | MonadIO version of 'generate' for use in monadic contexts. -Output:-  > ("JSON response: ",Example {sortedList = ["1","2","3","4"], wasListAlreadSorted = False})+Lifts the 'generate' function into a 'MonadIO' context, allowing it to be used in monadic computations. -Note: While Passing the type, construct the type that will help LLM understand the field better.- For example, in the above example, the sortedList's value is written as "Sorted List here". This- will help LLM understand context better.+Example: - You can also provide number of retries in case the LLM field to return the response in correct JSON- in first attempt.+>>> import Control.Monad.IO.Class+>>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Hello!" }+>>> runReaderT (generateM ops Nothing) someContext+Right (GenerateResponse ...) -}-generateJson ::-  (ToJSON jsonResult, FromJSON jsonResult) =>+generateM ::+  MonadIO m =>   GenerateOps ->-  -- | Haskell type that you want your result in-  jsonResult ->-  -- | Max retries-  Maybe Int ->-  IO (Either String jsonResult)-generateJson genOps@GenerateOps {..} jsonStructure mMaxRetries = do-  let jsonHelperPrompt =-        "You are an AI that returns only JSON object. \n"-          <> "* Your output should be a JSON object that matches the following schema: \n"-          <> T.decodeUtf8 (BSL.toStrict $ encode jsonStructure)-          <> prompt-          <> "\n"-          <> "# How to treat the task:\n"-          <> "* Stricly follow the schema for the output.\n"-          <> "* Never return anything other than a JSON object.\n"-          <> "* Do not talk to the user.\n"-  generatedResponse <- generate genOps {prompt = jsonHelperPrompt}-  case generatedResponse of-    Left err -> return $ Left err-    Right r -> do-      case decode (BSL.fromStrict . T.encodeUtf8 $ response_ r) of-        Nothing -> do-          case mMaxRetries of-            Nothing -> return $ Left "Decoding Failed :("-            Just n ->-              if n < 1-                then return $ Left "Decoding failed :("-                else generateJson genOps jsonStructure (Just (n - 1))-        Just resultInType -> return $ Right resultInType---{- |-   Example usage of 'Ollama.generate' with a JSON schema format and options field.--   In this example we pass a JSON schema that expects an object with an integer field @age@.-   The options field is supplied as a JSON value.--   >>> import Data.Aeson (Value, object, (.=))-   >>> import Ollama (GenerateOps, defaultGenerateOps, SchemaFormat)-   >>> let x :: Value-   ...     x = object [ "type" .= ("object" :: String)-   ...                , "properties" .= object [ "age" .= object ["type" .= ("integer" :: String)] ]-   ...                ]-   >>> let opts :: Value-   ...     opts = object ["option" .= ("some value" :: String)]-   >>> generate defaultGenerateOps-   ...   { modelName = "llama3.2"-   ...   , prompt = "Ollama is 22 years old and is busy saving the world. Respond using JSON"-   ...   , format = Just (SchemaFormat x)-   ...   , options = opts-   ...   }-   Right (GenerateResponse {model = "llama3.2", createdAt = 2025-03-25 09:34:15.853417157 UTC,-                            response_ = "{\n    \"age\": 22\n}", done = True,-                            totalDuration = Just 6625631744, loadDuration = Just 2578791966,-                            promptEvalCount = Just 43, promptEvalDuration = Just 2983000000,-                            evalCount = Just 10, evalDuration = Just 1061000000})--}-+  Maybe OllamaConfig ->+  m (Either OllamaError GenerateResponse)+generateM ops mbCfg = liftIO $ generate ops mbCfg
src/Data/Ollama/List.hs view
@@ -1,39 +1,69 @@ {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.List+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for listing available models in the Ollama client.++This module provides functions to retrieve a list of models available on the Ollama server.+It includes both an IO-based function ('list') and a monadic version ('listM') for use in+'MonadIO' contexts. The list operation is performed via a GET request to the @\/api\/tags@ endpoint,+returning a 'Models' type containing a list of 'ModelInfo' records with details about each model.++Example:++>>> list Nothing+Right (Models [ModelInfo ...])+-} module Data.Ollama.List   ( -- * List Models API     list+  , listM++    -- * Model Types   , Models (..)   , ModelInfo (..)-  )-where+  ) where +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Error (OllamaError) import Data.Ollama.Common.Types as CT import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T import Data.Time import GHC.Int (Int64)-import Network.HTTP.Client-import Network.HTTP.Types.Status (statusCode) -newtype Models = Models [ModelInfo]+-- | A wrapper type containing a list of available models.+newtype Models+  = -- | List of 'ModelInfo' records describing available models.+    Models [ModelInfo]   deriving (Eq, Show) +-- | Details about a specific model. data ModelInfo = ModelInfo-  { name :: Text-  , modifiedAt :: UTCTime-  , size :: Int64-  , digest :: Text-  , details :: ModelDetails+  { name :: !Text+  -- ^ The name of the model.+  , modifiedAt :: !UTCTime+  -- ^ The timestamp when the model was last modified.+  , size :: !Int64+  -- ^ The size of the model in bytes.+  , digest :: !Text+  -- ^ The digest (hash) of the model.+  , details :: !ModelDetails+  -- ^ Additional details about the model (e.g., format, family, parameters).   }   deriving (Eq, Show) --- Instances+-- | JSON parsing instance for 'Models'. instance FromJSON Models where   parseJSON = withObject "Models" $ \v -> Models <$> v .: "models" +-- | JSON parsing instance for 'ModelInfo'. instance FromJSON ModelInfo where   parseJSON = withObject "ModelInfo" $ \v ->     ModelInfo@@ -43,17 +73,33 @@       <*> v .: "digest"       <*> v .: "details" --- | List all models from local-list :: IO (Maybe Models)-list = do-  let url = defaultOllamaUrl-  manager <- newManager defaultManagerSettings-  request <- parseRequest $ T.unpack (url <> "/api/tags")-  response <- httpLbs request manager-  if statusCode (responseStatus response) /= 200-    then pure Nothing-    else do-      let res = decode (responseBody response) :: Maybe Models-      case res of-        Nothing -> pure Nothing-        Just l -> pure $ Just l+{- | Retrieves a list of available models from the Ollama server.++Sends a GET request to the @\/api\/tags@ endpoint to fetch the list of models.+Returns 'Right' with a 'Models' containing the list of 'ModelInfo' on success,+or 'Left' with an 'OllamaError' on failure.+-}+list ::+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError Models)+list mbConfig = do+  withOllamaRequest+    "/api/tags"+    "GET"+    (Nothing :: Maybe Value)+    mbConfig+    commonNonStreamingHandler++{- | MonadIO version of 'list' for use in monadic contexts.++Lifts the 'list' function into a 'MonadIO' context, allowing it to be used in monadic computations.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (listM Nothing) someContext+Right (Models [ModelInfo ...])+-}+listM :: MonadIO m => Maybe OllamaConfig -> m (Either OllamaError Models)+listM mbCfg = liftIO $ list mbCfg
+ src/Data/Ollama/Load.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Data.Ollama.Load+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : High-level functions for loading and unloading models in the Ollama client.++This module provides functions to load and unload generative models in the Ollama server.+It includes both IO-based functions ('loadGenModel', 'unloadGenModel') and monadic versions+('loadGenModelM', 'unloadGenModelM') for use in 'MonadIO' contexts. The operations are+performed via POST requests to the @\/api\/generate@ endpoint, leveraging the 'GenerateOps'+configuration from the 'Data.Ollama.Generate' module.++Loading a model keeps it in memory for faster subsequent requests, while unloading frees+up memory by setting the keep-alive duration to zero.++Example:++>>> loadGenModel "gemma3"+Right ()+>>> unloadGenModel "gemma3"+Right ()+-}+module Data.Ollama.Load+  ( -- * Load and Unload Model APIs+    loadGenModel+  , unloadGenModel+  , loadGenModelM+  , unloadGenModelM+  ) where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Ollama.Common.Error+import Data.Ollama.Common.Utils (commonNonStreamingHandler, withOllamaRequest)+import Data.Ollama.Generate qualified as Gen+import Data.Text (Text)++{- | Loads a generative model into memory.++Sends a POST request to the @\/api\/generate@ endpoint to load the specified model into+memory, ensuring faster response times for subsequent requests. Returns 'Right ()' on+success or 'Left' with an 'OllamaError' on failure.++@since 0.2.0.0+-}+loadGenModel ::+  -- |  Model name (e.g., "gemma3")+  Text ->+  IO (Either OllamaError ())+loadGenModel m = do+  let ops = Gen.defaultGenerateOps {Gen.modelName = m}+  withOllamaRequest "/api/generate" "POST" (Just ops) Nothing commonNonStreamingHandler++{- | Unloads a generative model from memory.++Sends a POST request to the @\/api\/generate@ endpoint with a keep-alive duration of zero+to unload the specified model from memory, freeing up resources. Returns 'Right ()' on+success or 'Left' with an 'OllamaError' on failure.++@since 0.2.0.0+-}+unloadGenModel ::+  -- | Model name (e.g., "gemma3")+  Text ->+  IO (Either OllamaError ())+unloadGenModel m = do+  let ops = Gen.defaultGenerateOps {Gen.modelName = m, Gen.keepAlive = Just 0}+  withOllamaRequest "/api/generate" "POST" (Just ops) Nothing commonNonStreamingHandler++{- | MonadIO version of 'loadGenModel' for use in monadic contexts.++Lifts the 'loadGenModel' function into a 'MonadIO' context, allowing it to be used in+monadic computations.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (loadGenModelM "gemma3") someContext+Right ()++@since 0.2.0.0+-}+loadGenModelM :: MonadIO m => Text -> m (Either OllamaError ())+loadGenModelM t = liftIO $ loadGenModel t++{- | MonadIO version of 'unloadGenModel' for use in monadic contexts.++Lifts the 'unloadGenModel' function into a 'MonadIO' context, allowing it to be used in+monadic computations.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (unloadGenModelM "gemma3") someContext+Right ()++@since 0.2.0.0+-}+unloadGenModelM :: MonadIO m => Text -> m (Either OllamaError ())+unloadGenModelM t = liftIO $ unloadGenModel t
src/Data/Ollama/Ps.hs view
@@ -1,39 +1,73 @@ {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.Ps+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for listing running models in the Ollama client.++This module provides functions to retrieve a list of models currently running on the Ollama server.+It includes both an IO-based function ('ps') and a monadic version ('psM') for use in 'MonadIO'+contexts. The operation is performed via a GET request to the @\/api\/ps@ endpoint, returning a+'RunningModels' type containing a list of 'RunningModel' records with details about each running model.++Example:++>>> ps Nothing+Right (RunningModels [RunningModel ...])+-} module Data.Ollama.Ps-  ( ps+  ( -- * List Running Models API+    ps+  , psM++    -- * Model Types   , RunningModels (..)   , RunningModel (..)   ) where +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Error (OllamaError) import Data.Ollama.Common.Types as CT import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T import Data.Time import GHC.Int (Int64)-import Network.HTTP.Client-import Network.HTTP.Types.Status (statusCode) --- Types for Ps API-newtype RunningModels = RunningModels [RunningModel]+-- | A wrapper type containing a list of running models.+newtype RunningModels+  = -- | List of 'RunningModel' records describing currently running models.+    RunningModels [RunningModel]   deriving (Eq, Show) +-- | Details about a specific running model. data RunningModel = RunningModel-  { name_ :: Text-  , modelName :: Text-  , size_ :: Int64-  , modelDigest :: Text-  , modelDetails :: ModelDetails-  , expiresAt :: UTCTime-  , sizeVRam :: Int64+  { name_ :: !Text+  -- ^ The name of the running model instance.+  , modelName :: !Text+  -- ^ The base model name (e.g., "gemma3").+  , size_ :: !Int64+  -- ^ The size of the model in bytes.+  , modelDigest :: !Text+  -- ^ The digest (hash) of the model.+  , modelDetails :: !ModelDetails+  -- ^ Additional details about the model (e.g., format, family, parameters).+  , expiresAt :: !UTCTime+  -- ^ The timestamp when the model's memory allocation expires.+  , sizeVRam :: !Int64+  -- ^ The size of the model's VRAM usage in bytes.   }   deriving (Eq, Show) +-- | JSON parsing instance for 'RunningModels'. instance FromJSON RunningModels where   parseJSON = withObject "Models" $ \v -> RunningModels <$> v .: "models" +-- | JSON parsing instance for 'RunningModel'. instance FromJSON RunningModel where   parseJSON = withObject "RunningModel" $ \v ->     RunningModel@@ -45,17 +79,31 @@       <*> v .: "expires_at"       <*> v .: "size_vram" --- | List running models-ps :: IO (Maybe RunningModels)-ps = do-  let url = defaultOllamaUrl-  manager <- newManager defaultManagerSettings-  request <- parseRequest $ T.unpack (url <> "/api/ps")-  response <- httpLbs request manager-  if statusCode (responseStatus response) /= 200-    then pure Nothing-    else do-      let res = decode (responseBody response) :: Maybe RunningModels-      case res of-        Nothing -> pure Nothing-        Just l -> pure $ Just l+{- | Retrieves a list of currently running models from the Ollama server.++Sends a GET request to the @\/api\/ps@ endpoint to fetch the list of running models.+Returns 'Right' with a 'RunningModels' containing the list of 'RunningModel' on success,+or 'Left' with an 'OllamaError' on failure.+Example:++>>> ps Nothing+Right (RunningModels [RunningModel {name_ = "gemma3:instance1", modelName = "gemma3", ...}])+-}+ps ::+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError RunningModels)+ps mbConfig = do+  withOllamaRequest+    "/api/ps"+    "GET"+    (Nothing :: Maybe Value)+    mbConfig+    commonNonStreamingHandler++{- | MonadIO version of 'ps' for use in monadic contexts.++Lifts the 'ps' function into a 'MonadIO' context, allowing it to be used in monadic computations.+-}+psM :: MonadIO m => Maybe OllamaConfig -> m (Either OllamaError RunningModels)+psM mbCfg = liftIO $ ps mbCfg
src/Data/Ollama/Pull.hs view
@@ -2,113 +2,152 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Pull+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for pulling models in the Ollama client.++This module provides functions to pull (download) models from the Ollama server. It includes both+high-level ('pull', 'pullM') and low-level ('pullOps', 'pullOpsM') APIs for pulling models, with+support for streaming progress updates and insecure connections. The 'PullOps' type configures the+pull request, and 'PullResp' represents the response containing the status and progress details.++The pull operation is performed via a POST request to the @\/api\/pull@ endpoint. Streaming mode,+when enabled, provides real-time progress updates by printing the remaining bytes to the console.++Example:++>>> pull "gemma3"+Remaining bytes: 123456789+...+Completed+Right (PullResp {status = "success", ...})+-} module Data.Ollama.Pull-  ( -- * Downloaded Models+  ( -- * Pull Model API     pull   , pullOps+  , pullM+  , pullOpsM   ) where +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Maybe (fromMaybe)+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Error (OllamaError)+import Data.Ollama.Common.Types (HasDone (..)) import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T import GHC.Generics import GHC.Int (Int64)-import Network.HTTP.Client --- TODO: Add Options parameter- -- | Configuration options for pulling a model. data PullOps = PullOps-  { name :: Text-  -- ^ The name of the model to pull.-  , insecure :: Maybe Bool-  -- ^ Option to allow insecure connections.-  -- If set to 'Just True', the pull operation will allow insecure connections.-  , stream :: Maybe Bool-  -- ^ Option to enable streaming of the download.-  -- If set to 'Just True', the download will be streamed.+  { name :: !Text+  -- ^ The name of the model to pull (e.g., "gemma3").+  , insecure :: !(Maybe Bool)+  -- ^ Optional flag to allow insecure connections. If 'Just True', insecure connections are permitted.+  , stream :: !(Maybe Bool)+  -- ^ Optional flag to enable streaming of the download. If 'Just True', progress updates are streamed.   }   deriving (Show, Eq, Generic, ToJSON)  -- | Response data from a pull operation. data PullResp = PullResp-  { status :: Text-  -- ^ The status of the pull operation, e.g., "success" or "failure".-  , digest :: Maybe Text-  -- ^ The digest of the model, if available.-  , total :: Maybe Int64+  { status :: !Text+  -- ^ The status of the pull operation (e.g., "success" or "failure").+  , digest :: !(Maybe Text)+  -- ^ The digest (hash) of the model, if available.+  , total :: !(Maybe Int64)   -- ^ The total size of the model in bytes, if available.-  , completed :: Maybe Int64-  -- ^ The number of bytes completed, if available.+  , completed :: !(Maybe Int64)+  -- ^ The number of bytes downloaded, if available.   }   deriving (Show, Eq, Generic, FromJSON) -{- |-Pull a model with additional options for insecure connections and streaming.-This function interacts directly with the Ollama API to download the specified model.--Example:+instance HasDone PullResp where+  getDone PullResp {..} = status /= "success" -> pullOps "myModel" (Just True) (Just True)+{- | Pulls a model with full configuration. -This will attempt to pull "myModel" with insecure connections allowed and enable streaming.+Sends a POST request to the @\/api\/pull@ endpoint to download the specified model. Supports+streaming progress updates (if 'stream' is 'Just True') and insecure connections (if 'insecure'+is 'Just True'). Prints remaining bytes during streaming and "Completed" when finished.+Returns 'Right' with a 'PullResp' on success or 'Left' with an 'OllamaError' on failure. -} pullOps ::-  -- | Model Name+  -- | Model name   Text ->-  -- | Insecure+  -- | Optional insecure connection flag   Maybe Bool ->-  -- | Stream+  -- | Optional streaming flag   Maybe Bool ->-  IO ()-pullOps modelName mInsecure mStream = do-  let url = defaultOllamaUrl-  manager <- newManager defaultManagerSettings-  initialRequest <- parseRequest $ T.unpack (url <> "/api/pull")-  let reqBody =-        PullOps-          { name = modelName-          , insecure = mInsecure-          , stream = mStream-          }-      request =-        initialRequest-          { method = "POST"-          , requestBody = RequestBodyLBS $ encode reqBody-          }-  withResponse request manager $ \response -> do-    let go = do-          bs <- brRead $ responseBody response-          let eRes = decode (BSL.fromStrict bs) :: Maybe PullResp-          case eRes of-            Nothing -> putStrLn "Something went wrong"-            Just res -> do-              if status res /= "success"-                then do-                  let completed' = fromMaybe 0 (completed res)-                  let total' = fromMaybe 0 (total res)-                  putStrLn $ "Remaining bytes: " <> show (total' - completed')-                  go-                else do-                  putStrLn "Completed"-    go+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError PullResp)+pullOps modelName mInsecure mStream mbConfig = do+  withOllamaRequest+    "/api/pull"+    "POST"+    (Just $ PullOps {name = modelName, insecure = mInsecure, stream = mStream})+    mbConfig+    (commonStreamHandler (onToken, pure ()))+  where+    onToken :: PullResp -> IO ()+    onToken res = do+      let completed' = fromMaybe 0 (completed res)+      let total' = fromMaybe 0 (total res)+      putStrLn $ "Remaining bytes: " <> show (total' - completed') -{- |-Pull a model using default options. This simplifies the pull operation by-not requiring additional options.+{- | Simplified API for pulling a model. +A higher-level function that pulls a model using default settings for insecure connections,+streaming, and Ollama configuration. Suitable for basic use cases.+-}+pull ::+  -- | Model name+  Text ->+  IO (Either OllamaError PullResp)+pull modelName = pullOps modelName Nothing Nothing Nothing++{- | MonadIO version of 'pull' for use in monadic contexts.++Lifts the 'pull' function into a 'MonadIO' context, allowing it to be used in monadic computations.+ Example: -> pull "myModel"+>>> import Control.Monad.IO.Class+>>> runReaderT (pullM "gemma3") someContext+Right (PullResp {status = "success", ...})+-}+pullM :: MonadIO m => Text -> m (Either OllamaError PullResp)+pullM t = liftIO $ pull t -This will pull "myModel" using default settings (no insecure connections and no streaming).+{- | MonadIO version of 'pullOps' for use in monadic contexts.++Lifts the 'pullOps' function into a 'MonadIO' context, allowing it to be used in monadic computations+with full configuration options.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (pullOpsM "gemma3" Nothing (Just True) Nothing) someContext+Remaining bytes: 123456789+...+Completed+Right (PullResp {status = "success", ...}) -}-pull ::-  -- | Model Name+pullOpsM ::+  MonadIO m =>   Text ->-  IO ()-pull modelName = pullOps modelName Nothing Nothing+  Maybe Bool ->+  Maybe Bool ->+  Maybe OllamaConfig ->+  m (Either OllamaError PullResp)+pullOpsM t mbInsecure mbStream mbCfg = liftIO $ pullOps t mbInsecure mbStream mbCfg
src/Data/Ollama/Push.hs view
@@ -2,84 +2,114 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} +{- |+Module      : Data.Ollama.Push+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for pushing models to the Ollama server.++This module provides functions to push (upload) a model to the Ollama server. It includes+both an IO-based function ('push') and a monadic version ('pushM') for use in 'MonadIO'+contexts. The push operation is performed via a POST request to the @\/api\/pull@ endpoint,+with support for streaming progress updates and insecure connections.++The 'PushOps' type configures the push request, and 'PushResp' represents the response+containing the status and progress details. Streaming mode, when enabled, provides+real-time progress updates by printing to the console.++Example:++>>> push "gemma3" Nothing (Just True) Nothing+Pushing...+Completed+-} module Data.Ollama.Push-  ( -- * Push API+  ( -- * Push Model API     push-  , pushOps+  , pushM   ) where +import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL-import Data.Maybe (fromMaybe)+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Types (HasDone (getDone)) import Data.Ollama.Common.Utils as CU import Data.Text (Text)-import Data.Text qualified as T import GHC.Generics import GHC.Int (Int64)-import Network.HTTP.Client --- TODO: Add Options parameter+-- | Configuration options for pushing a model. data PushOps = PushOps-  { name :: Text-  , insecure :: Maybe Bool-  , stream :: Maybe Bool+  { name :: !Text+  -- ^ The name of the model to push (e.g., "gemma3").+  , insecure :: !(Maybe Bool)+  -- ^ Optional flag to allow insecure connections.+  -- If 'Just True', insecure connections are permitted.+  , stream :: !(Maybe Bool)+  -- ^ Optional flag to enable streaming of the upload.+  -- If 'Just True', progress updates are streamed.   }   deriving (Show, Eq, Generic, ToJSON) +-- | Response data from a push operation. data PushResp = PushResp-  { status :: Text-  , digest :: Maybe Text-  , total :: Maybe Int64+  { status :: !Text+  -- ^ The status of the push operation (e.g., "success" or "failure").+  , digest :: !(Maybe Text)+  -- ^ The digest (hash) of the model, if available.+  , total :: !(Maybe Int64)+  -- ^ The total size of the model in bytes, if available.   }   deriving (Show, Eq, Generic, FromJSON) --- | Push a model with options-pushOps ::+instance HasDone PushResp where+  getDone PushResp {..} = status /= "success"++{- | Pushes a model to the Ollama server with specified options.++Sends a POST request to the @\/api\/pull@ endpoint to upload the specified model. Supports+streaming progress updates (if 'stream' is 'Just True') and insecure connections (if+'insecure' is 'Just True'). Prints "Pushing..." during streaming and "Completed" when+finished. Returns '()' on completion.+-}+push ::   -- | Model name   Text ->-  -- | Insecure+  -- | Optional insecure connection flag   Maybe Bool ->-  -- | Stream+  -- | Optional streaming flag   Maybe Bool ->+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->   IO ()-pushOps modelName mInsecure mStream = do-  let url = defaultOllamaUrl-  manager <- newManager defaultManagerSettings-  initialRequest <- parseRequest $ T.unpack (url <> "/api/push")-  let reqBody =-        PushOps-          { name = modelName-          , insecure = mInsecure-          , stream = mStream-          }-      request =-        initialRequest-          { method = "POST"-          , requestBody = RequestBodyLBS $ encode reqBody-          }-  withResponse request manager $ \response -> do-    let go = do-          bs <- brRead $ responseBody response-          let eRes = decode (BSL.fromStrict bs) :: Maybe PushResp-          case eRes of-            Nothing -> putStrLn "Something went wrong"-            Just res -> do-              if status res /= "success"-                then do-                  let total' = fromMaybe 0 (total res)-                  putStrLn $ "Remaining bytes: " <> show total'-                  go-                else do-                  putStrLn "Completed"-    go+push modelName mInsecure mStream mbConfig = do+  void $+    withOllamaRequest+      "/api/push"+      "POST"+      (Just $ PushOps {name = modelName, insecure = mInsecure, stream = mStream})+      mbConfig+      (commonStreamHandler (onToken, pure ()))+  where+    onToken :: PushResp -> IO ()+    onToken _ = putStrLn "Pushing... " --- Higher level API for Pull--- This API is untested. Will test soon!+{- | MonadIO version of 'push' for use in monadic contexts. --- | Push a model-push ::-  -- | Model name-  Text ->-  IO ()-push modelName = pushOps modelName Nothing Nothing+Lifts the 'push' function into a 'MonadIO' context, allowing it to be used in monadic+computations.++Example:++>>> import Control.Monad.IO.Class+>>> runReaderT (pushM "gemma3" Nothing (Just True) Nothing) someContext+Pushing...+Completed+-}+pushM :: MonadIO m => Text -> Maybe Bool -> Maybe Bool -> Maybe OllamaConfig -> m ()+pushM t insec s mbCfg = liftIO $ push t insec s mbCfg
src/Data/Ollama/Show.hs view
@@ -3,108 +3,149 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{- |+Module      : Data.Ollama.Show+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Description : Functionality for retrieving detailed information about models in the Ollama client.++This module provides functions to fetch detailed information about a specific model on the Ollama server.+It includes both high-level ('showModel', 'showModelM') and low-level ('showModelOps', 'showModelOpsM') APIs+for retrieving model details, with support for verbose output. The operation is performed via a POST request+to the @\/api\/show@ endpoint, returning a 'ShowModelResponse' containing comprehensive model metadata.++The 'ShowModelOps' type configures the request, and 'ShowModelResponse' and 'ShowModelInfo' represent the+response structure. The module also re-exports 'CT.ModelDetails' for completeness.++Note: Verbose mode parsing is currently not fully supported.++Example:++>>> showModel "gemma3"+Right (ShowModelResponse {modelFile = "...", ...})++@since 1.0.0.0+-} module Data.Ollama.Show   ( -- * Show Model Info API     showModel+  , showModelM   , showModelOps+  , showModelOpsM++    -- * Response Types   , ShowModelResponse (..)+  , ShowModelInfo (..)+  , CT.ModelDetails (..)   ) where +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson-import Data.Ollama.Common.Utils qualified as CU+import Data.Ollama.Common.Config (OllamaConfig)+import Data.Ollama.Common.Error (OllamaError)+import Data.Ollama.Common.Types qualified as CT+import Data.Ollama.Common.Utils (commonNonStreamingHandler, withOllamaRequest) import Data.Text (Text)-import Data.Text qualified as T import GHC.Generics import GHC.Int (Int64)-import Network.HTTP.Client --- TODO: Add Options parameter--- TODO: Add Context parameter--{- |- #ShowModelOps#- Input parameters for show model information.--}+-- | Configuration options for requesting model information. data ShowModelOps = ShowModelOps-  { name :: Text-  , verbose :: Maybe Bool+  { name :: !Text+  -- ^ The name of the model to query (e.g., "gemma3").+  , verbose :: !(Maybe Bool)+  -- ^ Optional flag to request verbose output. Note: Verbose mode parsing is currently incomplete.   }   deriving (Show, Eq, Generic, ToJSON) -{- |- #ShowModelResponse#-- Ouput structure for show model information.--}+-- | Response structure for model information. data ShowModelResponse = ShowModelResponse-  { modelFile :: Text-  , parameters :: Text-  , template :: Text-  , details :: ModelDetails-  , modelInfo :: ModelInfo-  }-  deriving (Show, Eq)--data ModelDetails = ModelDetails-  { parentModel :: Text-  , format :: Text-  , familiy :: Text-  , families :: [Text]-  , parameterSize :: Text-  , quantizationLevel :: Text+  { modelFile :: !Text+  -- ^ The content of the model's Modelfile.+  , parameters :: !(Maybe Text)+  -- ^ Optional model parameters (e.g., temperature settings).+  , template :: !(Maybe Text)+  -- ^ Optional template used for the model.+  , details :: !CT.ModelDetails+  -- ^ General details about the model (e.g., format, family).+  , modelInfo :: !ShowModelInfo+  -- ^ Detailed technical information about the model.+  , license :: !(Maybe Text)+  -- ^ Optional license information for the model.+  --+  -- @since 0.2.0.0+  , capabilities :: Maybe [Text]+  -- ^ Optional list of model capabilities.+  --+  -- @since 0.2.0.0   }   deriving (Show, Eq) -data ModelInfo = ModelInfo-  { generalArchitecture :: Maybe Text-  , generalFileType :: Maybe Int-  , generalParameterCount :: Maybe Int64-  , generalQuantizationVersion :: Maybe Int-  , llamaAttentionHeadCount :: Maybe Int-  , llamaAttentionHeadCountKV :: Maybe Int-  , llamaAttentionLayerNormRMSEpsilon :: Maybe Float-  , llamaBlockCount :: Maybe Int-  , llamaContextLength :: Maybe Int-  , llamaEmbeddingLength :: Maybe Int-  , llamaFeedForwardLength :: Maybe Int-  , llamaRopeDimensionCount :: Maybe Int-  , llamaRopeFreqBase :: Maybe Int64-  , llamaVocabSize :: Maybe Int64-  , tokenizerGgmlBosToken_id :: Maybe Int-  , tokenizerGgmlEosToken_id :: Maybe Int-  , tokenizerGgmlMerges :: Maybe [Text]-  , tokenizerGgmlMode :: Maybe Text-  , tokenizerGgmlPre :: Maybe Text-  , tokenizerGgmlTokenType :: Maybe [Text]-  , tokenizerGgmlTokens :: Maybe [Text]+-- | Detailed technical information about a model.+data ShowModelInfo = ShowModelInfo+  { generalArchitecture :: !(Maybe Text)+  -- ^ The architecture of the model (e.g., "llama").+  , generalFileType :: !(Maybe Int)+  -- ^ The file type identifier for the model.+  , generalParameterCount :: !(Maybe Int64)+  -- ^ The number of parameters in the model.+  , generalQuantizationVersion :: !(Maybe Int)+  -- ^ The quantization version used by the model.+  , llamaAttentionHeadCount :: !(Maybe Int)+  -- ^ Number of attention heads in the LLaMA model.+  , llamaAttentionHeadCountKV :: !(Maybe Int)+  -- ^ Number of key-value attention heads in the LLaMA model.+  , llamaAttentionLayerNormRMSEpsilon :: !(Maybe Float)+  -- ^ RMS epsilon for layer normalization in the LLaMA model.+  , llamaBlockCount :: !(Maybe Int)+  -- ^ Number of blocks in the LLaMA model.+  , llamaContextLength :: !(Maybe Int)+  -- ^ Context length supported by the LLaMA model.+  , llamaEmbeddingLength :: !(Maybe Int)+  -- ^ Embedding length used by the LLaMA model.+  , llamaFeedForwardLength :: !(Maybe Int)+  -- ^ Feed-forward layer length in the LLaMA model.+  , llamaRopeDimensionCount :: !(Maybe Int)+  -- ^ RoPE dimension count in the LLaMA model.+  , llamaRopeFreqBase :: !(Maybe Int64)+  -- ^ Base frequency for RoPE in the LLaMA model.+  , llamaVocabSize :: !(Maybe Int64)+  -- ^ Vocabulary size of the LLaMA model.+  , tokenizerGgmlBosToken_id :: !(Maybe Int)+  -- ^ BOS (beginning of sequence) token ID for the GGML tokenizer.+  , tokenizerGgmlEosToken_id :: !(Maybe Int)+  -- ^ EOS (end of sequence) token ID for the GGML tokenizer.+  , tokenizerGgmlMerges :: !(Maybe [Text])+  -- ^ List of merges for the GGML tokenizer.+  , tokenizerGgmlMode :: !(Maybe Text)+  -- ^ Mode of the GGML tokenizer.+  , tokenizerGgmlPre :: !(Maybe Text)+  -- ^ Pre-tokenization configuration for the GGML tokenizer.+  , tokenizerGgmlTokenType :: !(Maybe [Text])+  -- ^ Token type information for the GGML tokenizer.+  , tokenizerGgmlTokens :: !(Maybe [Text])+  -- ^ List of tokens for the GGML tokenizer.   }   deriving (Show, Eq) --- FromJSON instances---- | The instance for show model response+-- | JSON parsing instance for 'ShowModelResponse'. instance FromJSON ShowModelResponse where   parseJSON = withObject "ShowModelResponse" $ \v ->     ShowModelResponse       <$> v .: "modelfile"-      <*> v .: "parameters"-      <*> v .: "template"+      <*> v .:? "parameters"+      <*> v .:? "template"       <*> v .: "details"       <*> v .: "model_info"--instance FromJSON ModelDetails where-  parseJSON = withObject "ModelDetails" $ \v ->-    ModelDetails-      <$> v .: "parent_model"-      <*> v .: "format"-      <*> v .: "family"-      <*> v .: "families"-      <*> v .: "parameter_size"-      <*> v .: "quantization_level"+      <*> v .:? "license"+      <*> v .:? "capabilities" -instance FromJSON ModelInfo where+-- | JSON parsing instance for 'ShowModelInfo'.+instance FromJSON ShowModelInfo where   parseJSON = withObject "ModelInfo" $ \v ->-    ModelInfo+    ShowModelInfo       <$> v .:? "general.architecture"       <*> v .:? "general.file_type"       <*> v .:? "general.parameter_count"@@ -127,49 +168,63 @@       <*> v .:? "tokenizer.ggml.token_type"       <*> v .:? "tokenizer.ggml.tokens" -{- | Show given model's information with options.+{- | Retrieves model information with configuration options. -@since 1.0.0.0+Sends a POST request to the @\/api\/show@ endpoint to fetch detailed information about+the specified model. Supports verbose output if 'verbose' is 'Just True' (though verbose+mode parsing is currently incomplete). Returns 'Right' with a 'ShowModelResponse' on+success or 'Left' with an 'OllamaError' on failure. -} showModelOps ::-  -- | model name+  -- | Model name   Text ->-  -- | verbose+  -- | Optional verbose flag   Maybe Bool ->-  IO (Maybe ShowModelResponse)-showModelOps-  modelName-  verbose_ =-    do-      let url = CU.defaultOllamaUrl-      manager <- newManager defaultManagerSettings-      initialRequest <- parseRequest $ T.unpack (url <> "/api/show")-      let reqBody =-            ShowModelOps-              { name = modelName-              , verbose = verbose_-              }-          request =-            initialRequest-              { method = "POST"-              , requestBody = RequestBodyLBS $ encode reqBody-              }-      response <- httpLbs request manager-      let eRes =-            eitherDecode (responseBody response) ::-              Either String ShowModelResponse-      case eRes of-        Left _ -> pure Nothing-        Right r -> pure $ Just r+  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')+  Maybe OllamaConfig ->+  IO (Either OllamaError ShowModelResponse)+showModelOps modelName verbose_ mbConfig = do+  withOllamaRequest+    "/api/show"+    "POST"+    ( Just $+        ShowModelOps+          { name = modelName+          , verbose = verbose_+          }+    )+    mbConfig+    commonNonStreamingHandler -{- | Show given model's information.+{- | Simplified API for retrieving model information. -Higher level API for show.-@since 1.0.0.0+A higher-level function that fetches model information using default settings for+verbose output and Ollama configuration. Suitable for basic use cases. -} showModel ::-  -- | model name+  -- | Model name   Text ->-  IO (Maybe ShowModelResponse)+  IO (Either OllamaError ShowModelResponse) showModel modelName =-  showModelOps modelName Nothing+  showModelOps modelName Nothing Nothing++{- | MonadIO version of 'showModel' for use in monadic contexts.++Lifts the 'showModel' function into a 'MonadIO' context, allowing it to be used in+monadic computations.+-}+showModelM :: MonadIO m => Text -> m (Either OllamaError ShowModelResponse)+showModelM t = liftIO $ showModel t++{- | MonadIO version of 'showModelOps' for use in monadic contexts.++Lifts the 'showModelOps' function into a 'MonadIO' context, allowing it to be used in+monadic computations with full configuration options.+-}+showModelOpsM ::+  MonadIO m =>+  Text ->+  Maybe Bool ->+  Maybe OllamaConfig ->+  m (Either OllamaError ShowModelResponse)+showModelOpsM t v mbCfg = liftIO $ showModelOps t v mbCfg
src/Ollama.hs view
@@ -1,94 +1,199 @@ {-# LANGUAGE DuplicateRecordFields #-}+ {- |-  #Ollama-Haskell#-  This library lets you run LlMs from within Haskell projects. Inspired by `ollama-python`.+Module      : Data.Ollama+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+Portability : portable++== Ollama Haskell++This module provides a high-level Haskell interface to the [Ollama](https://ollama.com) API+    for interacting with local LLMs. It includes support for:++- Text generation (sync/streaming)+- Conversational chat (with tools and images)+- Embeddings+- Model management (pull, push, delete, list, show)+- Structured outputs+- Custom configuration and model options++Inspired by @ollama-python@, this library is built to offer idiomatic Haskell bindings+over Ollama’s HTTP API.++== 🔧 Usage++Import this module as a top-level interface:++@+import Ollama+@++All functions return @Either OllamaError a@ or can be used in a Monad stack using+their @\*M@ variants.++== 🔑 Main APIs++=== ✍️ Generate Text++- 'generate', 'generateM' – Generate text from a model+- 'defaultGenerateOps' – Default generation parameters+- 'GenerateOps', 'GenerateResponse' – Request and response types++=== 💬 Chat with LLMs++- 'chat', 'chatM' – Send chat messages to a model+- 'ChatOps', 'ChatResponse', 'Role', 'Message' – Chat input/output types+- Supports tools via 'InputTool', 'FunctionDef', 'OutputFunction', etc.++=== 🧠 Embeddings++- 'embedding', 'embeddingM' – Generate vector embeddings+- 'EmbeddingOps', 'EmbeddingResp' – Request/response types++=== 📦 Model Management++- 'copyModel', 'createModel', 'deleteModel'+- 'list' – List all installed models+- 'ps', 'psM' – Show running models+- 'showModel', 'showModelM' – Show model info+- 'pull', 'push' – Pull/push models (with progress support)++=== ⚙️ Configuration++- 'defaultOllamaConfig' – Modify host, retries, streaming, etc.+- 'withOnModelStart', 'withOnModelFinish', 'withOnModelError' – Hook support++=== 🧰 Utilities++- 'defaultModelOptions', 'encodeImage', 'withOllamaRequest'+- 'loadGenModel', 'unloadGenModel' – Load/unload generation models+- 'getVersion' – Ollama server version++== 🧾 Types++All request/response payloads and enums are exposed, including:++- 'ModelOptions', 'OllamaConfig', 'OllamaError', 'Format'+- 'Models', 'ModelInfo', 'ModelDetails', 'ShowModelResponse'+- 'RunningModels', 'RunningModel', 'Version' -} module Ollama   ( -- * Main APIs      -- ** Generate Texts     generate-  , generateJson+  , generateM   , defaultGenerateOps   , GenerateOps (..)   , GenerateResponse (..)      -- ** Chat with LLMs   , chat-  , chatJson+  , chatM   , Role (..)   , defaultChatOps   , ChatResponse (..)   , ChatOps (..)+  , InputTool (..)+  , FunctionDef (..)+  , FunctionParameters (..)+  , ToolCall (..)+  , OutputFunction (..)      -- ** Embeddings   , embedding   , embeddingOps+  , embeddingM+  , embeddingOpsM   , EmbeddingOps (..)   , EmbeddingResp (..) -    -- * Ollama operations-     -- ** Copy Models   , copyModel+  , copyModelM      -- ** Create Models   , createModel-  , createModelOps+  , createModelM      -- ** Delete Models   , deleteModel+  , deleteModelM      -- ** List Models   , list      -- ** List currently running models   , ps+  , psM      -- ** Push and Pull   , push-  , pushOps+  , pushM   , pull+  , pullM   , pullOps+  , pullOpsM      -- ** Show Model Info   , showModel   , showModelOps+  , showModelM+  , showModelOpsM +    -- ** Blob Operations+  , checkBlobExists+  , createBlob++    -- * Ollama config+  , defaultOllamaConfig+  , withOnModelStart+  , withOnModelFinish+  , withOnModelError++    -- * Utils+  , defaultModelOptions+  , ModelOptions (..)+  , encodeImage+  , withOllamaRequest+  , getVersion+  , loadGenModel+  , unloadGenModel+  , loadGenModelM+  , unloadGenModelM+     -- * Types   , ShowModelResponse (..)   , Models (..)   , ModelInfo (..)+  , ModelDetails (..)+  , ShowModelInfo (..)   , RunningModels (..)   , RunningModel (..)   , Message (..)-  , Format(..)+  , Format (..)+  , OllamaError (..)+  , OllamaConfig (..)+  , Version (..)   ) where +import Data.Ollama.Blob import Data.Ollama.Chat-  ( ChatOps (..)-  , ChatResponse (..)-  , Message (..)-  , Role (..)-  , chat-  , chatJson-  , defaultChatOps-  )-import Data.Ollama.Copy (copyModel)-import Data.Ollama.Create (createModel, createModelOps)-import Data.Ollama.Delete (deleteModel)-import Data.Ollama.Embeddings (embedding, embeddingOps, EmbeddingOps (..), EmbeddingResp (..))+import Data.Ollama.Common.Config+import Data.Ollama.Common.Types+import Data.Ollama.Common.Utils+import Data.Ollama.Copy+import Data.Ollama.Create+import Data.Ollama.Delete+import Data.Ollama.Embeddings hiding (keepAlive, modelName) import Data.Ollama.Generate-  ( GenerateOps (..)-  , GenerateResponse (..)-  , defaultGenerateOps-  , generate-  , generateJson-  )-import Data.Ollama.List (ModelInfo (..), Models (..), list)-import Data.Ollama.Ps (RunningModel (..), RunningModels (..), ps)-import Data.Ollama.Pull (pull, pullOps)-import Data.Ollama.Push (push, pushOps)-import Data.Ollama.Show (ShowModelResponse (..), showModel, showModelOps)-import Data.Ollama.Common.Types (Format (..))+import Data.Ollama.List+import Data.Ollama.Load+import Data.Ollama.Ps hiding (modelName)+import Data.Ollama.Pull+import Data.Ollama.Push+import Data.Ollama.Show
test/Main.hs view
@@ -2,211 +2,46 @@  module Main (main) where -import Data.Either-import Data.List.NonEmpty hiding (length)-import Data.Maybe-import Data.Ollama.Chat qualified as Chat-import Data.Text.IO qualified as T-import Ollama (GenerateOps (..), Role (..), defaultChatOps, defaultGenerateOps)-import Ollama qualified-import System.IO.Silently (capture)+import Data.Text (unpack)+import Ollama (Version (..), getVersion)+import Test.Ollama.Blob qualified as Blob+import Test.Ollama.Chat qualified as Chat+import Test.Ollama.Common qualified as Common+import Test.Ollama.Copy qualified as Copy+import Test.Ollama.Create qualified as Create+import Test.Ollama.Delete qualified as Delete+import Test.Ollama.Embedding qualified as Embeddings+import Test.Ollama.Generate qualified as Generate+import Test.Ollama.List qualified as List+import Test.Ollama.Load qualified as Load+import Test.Ollama.Show qualified as Show import Test.Tasty-import Test.Tasty.HUnit-import qualified Data.Text as T -import Data.Aeson   tests :: TestTree tests =   testGroup     "Tests"-    [ generateTest-    , chatTest-    , psTest-    , showTest-    , embeddingTest-    , generateFormatTest-    , chatFormatTest-    ]--generateTest :: TestTree-generateTest =-  testGroup-    "Generate tests"-    [ testCase "generate stream" $ do-        output <--          capture $-            Ollama.generate-              defaultGenerateOps-                { modelName = "llama3.2"-                , prompt = "what is 4 + 2?"-                , stream = Just (T.putStr . Ollama.response_, pure ())-                }-        assertBool "Checking if generate function is printing anything" (length output > 0)-    , testCase "Generate non-stream" $ do-        eRes <--          Ollama.generate-            defaultGenerateOps-              { modelName = "llama3.2"-              , prompt = "what is 4 + 2?"-              }-        assertBool "Checking if generate function returns a valid value" (isRight eRes)-    , testCase "Generate with invalid host" $ do-        eRes <- Ollama.generate defaultGenerateOps {-            modelName = "llama3.2"-          , prompt = "what is 23 + 9?"-          , hostUrl = pure "http://some-site"-          , responseTimeOut = pure 2-        }-        print ("got response" :: String ,eRes)-        assertBool "Expecting Left" (isLeft eRes)-    , testCase "Generate with invalid model" $ do-        eRes <- Ollama.generate defaultGenerateOps {modelName = "invalid-model"}-        assertBool "Expecting generation to fail with invalid model" (isLeft eRes)-    ]--generateFormatTest :: TestTree-generateFormatTest =-  testGroup "Generate tests with format and options"-    [ testCase "Generate with SchemaFormat and options" $ do-        let schema = object-              [ "type" .= ("object" :: String)-              , "properties" .= object [ "age" .= object ["type" .= ("integer" :: String)] ]-              ]-        eRes <--          Ollama.generate-            defaultGenerateOps-              { modelName = "llama3.2"-              , prompt = "Ollama is 22 years old and is busy saving the world. Respond using JSON"-              , format = Just (Ollama.SchemaFormat schema)-              }-        case eRes of-          Right res ->-            assertBool "Response should contain JSON with key \"age\"" ( "age" `T.isInfixOf` Ollama.response_ res )-          Left err ->-            assertFailure $ "Generation failed with error: " ++ show err-    , testCase "Generate with JsonFormat and options" $ do-        eRes <--          Ollama.generate-            defaultGenerateOps-              { modelName = "llama3.2"-              , prompt = "Provide a simple JSON response describing Ollama."-              , format = Just Ollama.JsonFormat-              }-        case eRes of-          Right res ->-            assertBool "Response should start with '{'" ( "{" `T.isPrefixOf` Ollama.response_ res )-          Left err ->-            assertFailure $ "Generation failed with error: " ++ show err-    ]--chatTest :: TestTree-chatTest =-  testGroup-    "Chat tests"-    [ testCase "chat stream" $ do-        let msg = Ollama.Message User "What is 29 + 3?" Nothing Nothing-            defaultMsg = Ollama.Message User "" Nothing Nothing-        output <--          capture $-            Ollama.chat-              defaultChatOps-                { Chat.chatModelName = "llama3.2"-                , Chat.messages = msg :| []-                , Chat.stream = Just (T.putStr . Chat.content . fromMaybe defaultMsg . Chat.message, pure ())-                }-        assertBool "Checking if chat function is printing anything" (length output > 0)-    , testCase "Chat non-stream" $ do-        let msg = Ollama.Message User "What is 29 + 3?" Nothing Nothing-        eRes <--          Ollama.chat-            defaultChatOps-              { Chat.chatModelName = "llama3.2"-              , Chat.messages = msg :| []-              }-        assertBool "Checking if chat function returns a valid value" (isRight eRes)-    , testCase "Chat invalid host url" $ do-        let msg = Ollama.Message User "What is 29 + 3?" Nothing Nothing-        eRes <--          Ollama.chat-            defaultChatOps-              { Chat.chatModelName = "llama3.2"-              , Chat.messages = msg :| []-              , Chat.hostUrl = pure "some random value"-              , Chat.responseTimeOut = pure 2-              }-        assertBool "It should return Left" (isLeft eRes)-    ]--chatFormatTest :: TestTree-chatFormatTest =-  testGroup "Chat tests with format and options"-    [ testCase "Chat with SchemaFormat and options" $ do-        let schema = object-              [ "type" .= ("object" :: String)-              , "properties" .= object [ "age" .= object ["type" .= ("integer" :: String)] ]-              ]-            msg = Ollama.Message User "Ollama is 22 years old and is busy saving the world. Respond using JSON" Nothing Nothing-        eRes <--          Ollama.chat-            defaultChatOps-              { Chat.chatModelName = "llama3.2"-              , Chat.messages = msg :| []-              , Chat.format = Just (Ollama.SchemaFormat schema)-              , Chat.options = Just $ object ["penalize_newline" .= Bool True]-              }-        case eRes of-          Right res ->-            assertBool "Chat response should contain key \"age\"" $-              maybe False (\m -> "age" `T.isInfixOf` Chat.content m) (Chat.message res)-          Left err ->-            assertFailure $ "Chat failed with error: " ++ show err-    , testCase "Chat with JsonFormat and options" $ do-        let msg = Ollama.Message User "Tell me about Ollama in JSON format." Nothing Nothing-        eRes <--          Ollama.chat-            defaultChatOps-              { Chat.chatModelName = "llama3.2"-              , Chat.messages = msg :| []-              , Chat.format = Just Ollama.JsonFormat-              }-        case eRes of-          Right res ->-            assertBool "Chat response should start with '{'" $-              maybe False (\m -> "{" `T.isPrefixOf` Chat.content m) (Chat.message res)-          Left err ->-            assertFailure $ "Chat failed with error: " ++ show err-    ]--psTest :: TestTree-psTest =-  testGroup-    "PS test"-    [ testCase "check ps" $ do-        mRes <- Ollama.ps-        assertBool "Check if ps returns anything" (isJust mRes)-    ]--showTest :: TestTree-showTest =-  testGroup-    "Show test"-    [ testCase "check show" $ do-        mRes <- Ollama.showModel "llama3.2"-        assertBool "Check if model exists or not" (isJust mRes)-    ]--embeddingTest :: TestTree-embeddingTest =-  testGroup-    "Embedding test"-    [ testCase "check embedding" $ do-        eRes <- Ollama.embedding "llama3.2" "Why is sky blue?"-        assertBool "Check if embedding returns anything" (isRight eRes)+    [ -- Core functionality tests+      Generate.tests+    , Chat.tests+    , Embeddings.tests+    , -- Model management tests+      Show.tests+    , List.tests+    , Copy.tests+    , Create.tests+    , Delete.tests+    , Load.tests+    , -- Utility and blob tests+      Blob.tests+    , Common.tests     ]  main :: IO () main = do-  mRes <- Ollama.list-  case mRes of-    Nothing -> pure () -- Ollama is likely not running. Not running tests.-    Just _ -> defaultMain tests+  eRes <- getVersion+  case eRes of+    Left err -> print err+    Right (Version r) -> do+      putStrLn $ "Ollama client version: " <> unpack r+      defaultMain tests
+ test/Test/Ollama/Blob.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Blob (tests) where++import Data.Ollama.Blob+import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Test.Tasty+import Test.Tasty.HUnit++testCheckBlobExistsInvalid :: TestTree+testCheckBlobExistsInvalid = testCase "Check blob exists: invalid digest should fail" $ do+  res <- checkBlobExists "invalid-digest" Nothing+  case res of+    Left _ -> assertBool "Should fail with invalid digest" True+    Right _ -> assertBool "Or return False for invalid digest" True++testCheckBlobExistsNonExistent :: TestTree+testCheckBlobExistsNonExistent = testCase "Check blob exists: non-existent blob" $ do+  let fakeDigest = "1234567890abcdef1234567890abcdef1234567890abcdef1234567890abcdef"+  res <- checkBlobExists fakeDigest Nothing+  case res of+    Left _ -> return () -- Network error is acceptable+    Right exists -> assertBool "Non-existent blob should return False" (not exists)++testCheckBlobExistsWithConfig :: TestTree+testCheckBlobExistsWithConfig = testCase "Check blob exists: with custom config" $ do+  let config = Just $ defaultOllamaConfig {timeout = 5}+      fakeDigest = "1234567890abcdef1234567890abcdef1234567890abcdef1234567890abcdef"+  res <- checkBlobExists fakeDigest config+  case res of+    Left _ -> return () -- Network error is acceptable+    Right _ -> assertBool "Should handle custom config" True++testCreateBlobInvalidFile :: TestTree+testCreateBlobInvalidFile = testCase "Create blob: invalid file path should fail" $ do+  let fakeDigest = "1234567890abcdef1234567890abcdef1234567890abcdef1234567890abcdef"+  res <- createBlob "/nonexistent/file/path" fakeDigest Nothing+  case res of+    Left _ -> assertBool "Should fail with invalid file path" True+    Right () -> assertFailure "Should not succeed with invalid file path"++tests :: TestTree+tests =+  testGroup+    "Blob tests"+    [ testCheckBlobExistsInvalid+    , testCheckBlobExistsNonExistent+    , testCheckBlobExistsWithConfig+    , testCreateBlobInvalidFile+    ]
+ test/Test/Ollama/Chat.hs view
@@ -0,0 +1,307 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Chat (tests) where++import Control.Monad (void)+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy.Char8 qualified as BSL+import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Data.List.NonEmpty (fromList)+import Data.List.NonEmpty qualified as NE+import Data.Map qualified as HM+import Data.Maybe (isJust)+import Data.Ollama.Chat+import Data.Scientific+import Data.Text qualified as T+import Data.Time (diffUTCTime, getCurrentTime)+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Test.Tasty+import Test.Tasty.HUnit++-- | Basic chat test with default options+basicChatTest :: TestTree+basicChatTest = testCase "Basic chat should contain 4 for 2+2" $ do+  let ops = defaultChatOps+  eRes <- chat ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> case message r of+      Nothing -> assertFailure "Expected a message in response"+      Just msg -> assertBool "Should contain '4'" (T.isInfixOf "4" (content msg))++-- | Test timeout configuration+timeoutTest :: TestTree+timeoutTest = testCase "Setting timeout" $ do+  let config = Just $ defaultOllamaConfig {timeout = 1}+  eRes <- chat defaultChatOps config+  case eRes of+    Right _ -> assertFailure "The model responded before timeout"+    Left (TimeoutError _) -> pure ()+    Left other -> assertFailure $ "Expected timeout error, got " ++ show other++-- | Test model lifecycle hooks on failure+hooksFailTest :: TestTree+hooksFailTest = testCase "Model lifecycle hooks should trigger on failure" $ do+  refStart <- newIORef False+  refError <- newIORef False+  refFinish <- newIORef True+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- Guaranteed to fail+          , onModelStart = Just $ writeIORef refStart True+          , onModelError = Just $ writeIORef refError True+          , onModelFinish = Just $ writeIORef refFinish False+          }+  void $ chat defaultChatOps (Just config)+  wasStarted <- readIORef refStart+  wasErrored <- readIORef refError+  wasFinished <- readIORef refFinish+  assertBool "onModelStart should be called" wasStarted+  assertBool "onModelError should be called" wasErrored+  assertBool "onModelFinish should be called" wasFinished++-- | Test model lifecycle hooks on success+hooksSuccessTest :: TestTree+hooksSuccessTest = testCase "Model lifecycle hooks should trigger on success" $ do+  refStart <- newIORef False+  refError <- newIORef True+  refFinish <- newIORef False+  let config =+        defaultOllamaConfig+          { onModelStart = Just $ writeIORef refStart True+          , onModelError = Just $ writeIORef refError False+          , onModelFinish = Just $ writeIORef refFinish True+          }+  void $ chat defaultChatOps (Just config)+  wasStarted <- readIORef refStart+  wasErrored <- readIORef refError+  wasFinished <- readIORef refFinish+  assertBool "onModelStart should be called" wasStarted+  assertBool "onModelError should not be called" wasErrored+  assertBool "onModelFinish should be called" wasFinished++-- | Test retry count+retryCountTest :: TestTree+retryCountTest = testCase "Should retry chat call retryCount times" $ do+  counter <- newIORef (0 :: Int)+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- Fails+          , retryCount = Just 2+          , retryDelay = Just 1+          , onModelStart = Just $ modifyIORef counter (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }+  _ <- chat defaultChatOps (Just config)+  calls <- readIORef counter+  assertEqual "Expected 3 attempts (1 initial + 2 retries)" 3 calls++-- | Test retry delay+retryDelayTest :: TestTree+retryDelayTest = testCase "Should delay between retries" $ do+  counter <- newIORef (0 :: Int)+  let delaySecs = 2+  start <- getCurrentTime+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- Fails+          , retryCount = Just 1+          , retryDelay = Just delaySecs+          , onModelStart = Just $ modifyIORef counter (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }+  _ <- chat defaultChatOps (Just config)+  end <- getCurrentTime+  let elapsed = realToFrac (diffUTCTime end start) :: Double+      expectedMin = fromIntegral delaySecs+  assertBool+    ("Elapsed time should be at least " ++ show expectedMin ++ "s, but was " ++ show elapsed)+    (elapsed >= expectedMin)++-- | Test common manager usage+commonManagerTest :: TestTree+commonManagerTest = testCase "Should reuse provided commonManager" $ do+  refStart <- newIORef (0 :: Int)+  mgr <-+    newTlsManagerWith+      tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro 1000000}+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- Will fail fast+          , commonManager = Just mgr+          , timeout = 999 -- Shouldn’t matter, manager timeout takes precedence+          , onModelStart = Just $ modifyIORef refStart (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }+  _ <- chat defaultChatOps (Just config)+  _ <- chat defaultChatOps (Just config)+  startCount <- readIORef refStart+  assertEqual "Both requests should start (reuse manager)" 2 startCount++-- | Test JSON format response+jsonFormatTest :: TestTree+jsonFormatTest = testCase "Should return response in JSON format" $ do+  let ops =+        defaultChatOps+          { messages =+              fromList+                [userMessage "Return a JSON with keys 'name' and 'age' for John, 25 years old."]+          , format = Just JsonFormat+          }+  eRes <- chat ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> case message r of+      Nothing -> assertFailure "Expected a message in response"+      Just msg -> do+        let responseText = content msg+        let decoded = Aeson.decode (BSL.pack $ T.unpack responseText) :: Maybe Aeson.Value+        assertBool "Expected valid JSON object in response" (isJust decoded)++-- | Test streaming response+streamingTest :: TestTree+streamingTest = testCase "Should handle streaming response" $ do+  chunksRef <- newIORef []+  let streamHandler chunk = modifyIORef chunksRef (++ [message chunk])+      ops = defaultChatOps {stream = Just (streamHandler, pure ())}+  eRes <- chat ops Nothing+  chunks <- readIORef chunksRef+  let fullOutput = T.concat (map (maybe "" content) chunks)+  case eRes of+    Left err -> assertFailure $ "Expected streaming success, got error: " ++ show err+    Right _ -> assertBool "Expected some streamed content" (not $ T.null fullOutput)++-- | Test custom model options+modelOptionsTest :: TestTree+modelOptionsTest = testCase "Should use custom model options" $ do+  let opts =+        Just $+          defaultModelOptions+            { temperature = Just 0.9+            , topP = Just 0.8+            , topK = Nothing+            , numPredict = Just 20+            }+      ops = defaultChatOps {options = opts}+  eRes <- chat ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> assertBool "Expected a response message" (isJust (message r))++testToolCallAddTwoNumbers :: TestTree+testToolCallAddTwoNumbers = testCase "Tool call: addTwoNumbers(23, 46)" $ do+  let messageList = NE.singleton $ userMessage "What is 23 + 46? (Use tool)"+      paramProps =+        HM.fromList+          [ ("a", FunctionParameters "number" Nothing Nothing Nothing)+          , ("b", FunctionParameters "number" Nothing Nothing Nothing)+          ]+      functionParams =+        FunctionParameters+          { parameterType = "object"+          , requiredParams = Just ["a", "b"]+          , parameterProperties = Just paramProps+          , additionalProperties = Just False+          }+      functionDef =+        FunctionDef+          { functionName = "addTwoNumbers"+          , functionDescription = Just "Add two numbers"+          , functionParameters = Just functionParams+          , functionStrict = Nothing+          }+      tool =+        InputTool+          { toolType = "function"+          , function = functionDef+          }+      ops =+        defaultChatOps+          { modelName = "qwen3:0.6b"+          , messages = messageList+          , tools = Just [tool]+          }++  res <- chat ops Nothing+  case res of+    Left err -> assertFailure $ "Chat failed: " ++ show err+    Right ChatResponse {message = Nothing} -> assertFailure "No message in response"+    Right ChatResponse {message = Just msg} ->+      case tool_calls msg of+        Nothing -> assertFailure "No tool calls received"+        Just [toolCall] -> do+          result <- captureAddToolCall toolCall+          assertEqual "Expected result of 23 + 46" 69 result+        Just other -> assertFailure $ "Unexpected number of tool calls: " ++ show other++-- Helper to evaluate the tool call+captureAddToolCall :: ToolCall -> IO Int+captureAddToolCall (ToolCall func)+  | outputFunctionName func == "addTwoNumbers" =+      case ( HM.lookup "a" (arguments func) >>= convertToNumber+           , HM.lookup "b" (arguments func) >>= convertToNumber+           ) of+        (Just a, Just b) -> return $ addTwoNumbers a b+        _ -> assertFailure "Missing parameters a or b" >> return 0+  | otherwise = assertFailure "Unexpected function name" >> return 0++addTwoNumbers :: Int -> Int -> Int+addTwoNumbers = (+)++-- Convert Aeson value to Int+convertToNumber :: Aeson.Value -> Maybe Int+convertToNumber (Aeson.Number n) = toBoundedInteger n+convertToNumber _ = Nothing++-- | Test conversation with multiple messages+multiMessageConversationTest :: TestTree+multiMessageConversationTest = testCase "Multi-message conversation should work" $ do+  let msgs =+        fromList+          [ systemMessage "You are a helpful assistant."+          , userMessage "What is 2+2?"+          , assistantMessage "2+2 equals 4."+          , userMessage "What about 3+3?"+          ]+      ops = defaultChatOps {messages = msgs}+  eRes <- chat ops Nothing+  case eRes of+    Left _ -> assertFailure "Expected success, got error"+    Right r -> case message r of+      Nothing -> assertFailure "Expected a message in response"+      Just msg -> assertBool "Should contain '6'" (T.isInfixOf "6" (content msg))++-- | Test invalid model name+invalidModelChatTest :: TestTree+invalidModelChatTest = testCase "Invalid model name should fail" $ do+  let ops = defaultChatOps {modelName = "nonexistent-chat-model"}+  eRes <- chat ops Nothing+  case eRes of+    Left _ -> assertBool "Should fail with invalid model" True+    Right _ -> assertFailure "Should not succeed with invalid model"++-- | Group all tests+tests :: TestTree+tests =+  sequentialTestGroup+    "Chat tests"+    AllFinish+    [ basicChatTest+    , timeoutTest+    , hooksFailTest+    , hooksSuccessTest+    , retryCountTest+    , retryDelayTest+    , commonManagerTest+    , jsonFormatTest+    , streamingTest+    , modelOptionsTest+    , testToolCallAddTwoNumbers+    , multiMessageConversationTest+    , invalidModelChatTest+    ]
+ test/Test/Ollama/Common.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Common (tests) where++import Data.Ollama.Common.SchemaBuilder+import Data.Ollama.Common.Utils (encodeImage)+import Data.Text qualified as T+import Test.Tasty+import Test.Tasty.HUnit++-- Test SchemaBuilder functionality+testSchemaBuilderBasic :: TestTree+testSchemaBuilderBasic = testCase "SchemaBuilder: basic object construction" $ do+  let schema =+        buildSchema $+          emptyObject+            |+ ("name", JString)+            |+ ("age", JNumber)+            |! "name"+            |! "age"++  -- Check that schema is not null/empty+  let schemaText = T.pack $ show schema+  assertBool "Schema should not be empty" (not $ T.null schemaText)+  assertBool "Schema should contain 'name'" ("name" `T.isInfixOf` schemaText)+  assertBool "Schema should contain 'age'" ("age" `T.isInfixOf` schemaText)++testSchemaBuilderArray :: TestTree+testSchemaBuilderArray = testCase "SchemaBuilder: array types" $ do+  let arraySchema =+        buildSchema $+          emptyObject+            |+ ("items", JArray JString)+            |+ ("numbers", JArray JNumber)+            |+ ("flags", JArray JBoolean)+            |! "items"++  let schemaText = T.pack $ show arraySchema+  assertBool "Array schema should not be empty" (not $ T.null schemaText)+  assertBool "Should contain items field" ("items" `T.isInfixOf` schemaText)++testSchemaBuilderOptionalFields :: TestTree+testSchemaBuilderOptionalFields = testCase "SchemaBuilder: optional vs required fields" $ do+  let schema =+        buildSchema $+          emptyObject+            |+ ("required_field", JString)+            |+ ("optional_field", JString)+            |! "required_field"++  let schemaText = T.pack $ show schema+  assertBool "Schema should contain both fields" $+    "required_field" `T.isInfixOf` schemaText+      && "optional_field" `T.isInfixOf` schemaText++-- Test image encoding utility+testEncodeImageValidFile :: TestTree+testEncodeImageValidFile = testCase "EncodeImage: should handle existing image file" $ do+  -- Test with the sample image from the examples+  result <- encodeImage "./examples/sample.png"+  case result of+    Nothing -> return () -- File might not exist in test environment+    Just encoded -> do+      assertBool "Encoded image should not be empty" (not $ T.null encoded)+      assertBool "Should be base64-like content" (T.length encoded > 10)++testEncodeImageNonExistentFile :: TestTree+testEncodeImageNonExistentFile = testCase "EncodeImage: should return Nothing for non-existent file" $ do+  result <- encodeImage "./nonexistent/file.png"+  case result of+    Nothing -> assertBool "Should return Nothing for non-existent file" True+    Just _ -> assertFailure "Should not encode non-existent file"++testEncodeImageInvalidFormat :: TestTree+testEncodeImageInvalidFormat = testCase "EncodeImage: should handle invalid file format" $ do+  result <- encodeImage "./test/Main.hs" -- Text file, not an image+  case result of+    Nothing -> assertBool "Should return Nothing for invalid format" True+    Just _ -> assertFailure "Should not encode invalid format"++tests :: TestTree+tests =+  testGroup+    "Common utilities tests"+    [ testSchemaBuilderBasic+    , testSchemaBuilderArray+    , testSchemaBuilderOptionalFields+    , testEncodeImageValidFile+    , testEncodeImageNonExistentFile+    , testEncodeImageInvalidFormat+    ]
+ test/Test/Ollama/Copy.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Copy (tests) where++import Control.Monad (void)+import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Data.Ollama.Copy+import Data.Ollama.Delete (deleteModel)+import Test.Tasty+import Test.Tasty.HUnit++testCopyModelBasic :: TestTree+testCopyModelBasic = testCase "Copy model: basic functionality" $ do+  res <- copyModel "gemma3" "gemma3-test-copy" Nothing+  case res of+    Left _ -> return () -- Allow failure if source model doesn't exist+    Right () -> do+      assertBool "Copy should succeed" True+      void $ deleteModel "gemma3-test-copy" Nothing++testCopyModelWithConfig :: TestTree+testCopyModelWithConfig = testCase "Copy model: with custom config" $ do+  let config = Just $ defaultOllamaConfig {timeout = 30}+  res <- copyModel "gemma3" "gemma3-test-copy-config" config+  case res of+    Left _ -> return () -- Allow failure if source doesn't exist+    Right () -> do+      assertBool "Copy with config should work" True+      void $ deleteModel "gemma3-test-copy-config" Nothing++testCopyModelInvalidSource :: TestTree+testCopyModelInvalidSource = testCase "Copy model: invalid source should fail" $ do+  res <- copyModel "nonexistent-model-12345" "some-destination" Nothing+  case res of+    Left _ -> assertBool "Should fail with invalid source" True+    Right () -> assertFailure "Should not succeed with invalid source"++tests :: TestTree+tests =+  testGroup+    "Copy tests"+    [ testCopyModelBasic+    , testCopyModelWithConfig+    , testCopyModelInvalidSource+    ]
+ test/Test/Ollama/Create.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Create (tests) where++import Control.Monad (void)+import Data.Maybe (isNothing)+import Data.Ollama.Common.Types (ModelOptions (..))+import Data.Ollama.Common.Utils (defaultModelOptions)+import Data.Ollama.Create+import Data.Ollama.Delete (deleteModel)+import Test.Tasty+import Test.Tasty.HUnit++testCreateModelBasic :: TestTree+testCreateModelBasic = testCase "Create model: basic from existing model" $ do+  let ops =+        (defaultCreateOps "test-model-basic")+          { fromModel = Just "gemma3"+          , systemPrompt = Just "You are a helpful assistant."+          }+  createModel ops Nothing+  assertBool "Create should complete without error" True+  void $ deleteModel "test-model-basic" Nothing++testCreateModelWithQuantization :: TestTree+testCreateModelWithQuantization = testCase "Create model: with quantization" $ do+  let ops =+        (defaultCreateOps "test-model-quantized")+          { fromModel = Just "gemma3"+          , quantizeType = Just Q4_K_M+          }+  createModel ops Nothing+  assertBool "Quantization request should complete" True+  void $ deleteModel "test-model-quantized" Nothing++testCreateModelWithParameters :: TestTree+testCreateModelWithParameters = testCase "Create model: with custom parameters" $ do+  let modelOpts =+        defaultModelOptions+          { temperature = Just 0.7+          , topP = Just 0.9+          , topK = Just 40+          }+      ops =+        (defaultCreateOps "test-model-params")+          { fromModel = Just "gemma3"+          , parameters = Just modelOpts+          , template = Just "Custom template: {{.Prompt}}"+          }+  createModel ops Nothing+  assertBool "Custom parameters should be handled" True+  void $ deleteModel "test-model-params" Nothing++testQuantizationTypeValues :: TestTree+testQuantizationTypeValues = testCase "Quantization types: should have valid values" $ do+  let q1 = Q4_K_M+      q2 = Q4_K_S+      q3 = Q8_0+  assertBool "Q4_K_M should be valid" (show q1 == "Q4_K_M")+  assertBool "Q4_K_S should be valid" (show q2 == "Q4_K_S")+  assertBool "Q8_0 should be valid" (show q3 == "Q8_0")++testCreateModelFieldAccess :: TestTree+testCreateModelFieldAccess = testCase "CreateOps: field access should work" $ do+  let ops = defaultCreateOps "test-model"+  assertBool "modelName should be accessible" (modelName ops == "test-model")+  assertBool "fromModel should be Nothing by default" (isNothing (fromModel ops))+  assertBool "files should be Nothing by default" (isNothing (files ops))++tests :: TestTree+tests =+  testGroup+    "Create tests"+    [ testCreateModelBasic+    , testCreateModelWithQuantization+    , testCreateModelWithParameters+    , testQuantizationTypeValues+    , testCreateModelFieldAccess+    ]
+ test/Test/Ollama/Delete.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Delete (tests) where++import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Data.Ollama.Delete+import Test.Tasty+import Test.Tasty.HUnit++testDeleteModelNonExistent :: TestTree+testDeleteModelNonExistent = testCase "Delete non-existent model should fail gracefully" $ do+  res <- deleteModel "nonexistent-model-12345" Nothing+  case res of+    Left _ -> assertBool "Should fail when deleting non-existent model" True+    Right () -> assertBool "Or succeed if server handles gracefully" True++testDeleteModelWithConfig :: TestTree+testDeleteModelWithConfig = testCase "Delete model: with custom config" $ do+  let config = Just $ defaultOllamaConfig {timeout = 30}+  res <- deleteModel "nonexistent-test-model" config+  case res of+    Left _ -> assertBool "Should handle custom config" True+    Right () -> assertBool "Or succeed if server handles gracefully" True++testDeleteModelEmptyName :: TestTree+testDeleteModelEmptyName = testCase "Delete model: empty name should fail" $ do+  res <- deleteModel "" Nothing+  case res of+    Left _ -> assertBool "Should fail with empty name" True+    Right () -> assertFailure "Should not succeed with empty name"++-- Note: We avoid testing actual deletion of existing models in unit tests+-- as it would be destructive. Integration tests could cover this.++tests :: TestTree+tests =+  testGroup+    "Delete tests"+    [ testDeleteModelNonExistent+    , testDeleteModelWithConfig+    , testDeleteModelEmptyName+    ]
+ test/Test/Ollama/Embedding.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Embedding (tests) where++import Data.Ollama.Embeddings+import Test.Tasty+import Test.Tasty.HUnit++-- Qwen doesn't support embeddings yet+-- TODO: Add embeddings supporting model.++-- testEmbeddingBasic :: TestTree+-- testEmbeddingBasic = testCase "Basic embedding with qwen3" $ do+--   res <- embedding "qwen3:0.6b" ["The sky is blue.", "Cats are independent."]+--   case res of+--     Left err -> assertFailure $ "Expected success, got error: " ++ show err+--     Right EmbeddingResp {..} -> do+--       assertEqual "Should return two embeddings" 2 (length respondedEmbeddings)+--       assertBool "Embeddings should not be empty" (not (any null respondedEmbeddings))++-- testEmbeddingWithOptions :: TestTree+-- testEmbeddingWithOptions = testCase "Embedding with truncate and keepAlive" $ do+--   let opts = defaultModelOptions {numKeep = Just 5, seed = Just 42}+--   res <-+--     embeddingOps+--       "qwen3:0.6b"+--       ["Hello world"]+--       (Just True)+--       (Just 30)+--       (Just opts)+--       Nothing+--       Nothing+--   case res of+--     Left err -> assertFailure $ "Unexpected error: " ++ show err+--     Right EmbeddingResp {..} -> do+--       assertEqual "Should return one embedding" 1 (length respondedEmbeddings)+--       assertBool+--         "Embedding vector should not be empty"+--         (not . null $ listToMaybe respondedEmbeddings)++testEmbeddingInvalidModel :: TestTree+testEmbeddingInvalidModel = testCase "Embedding with invalid model name" $ do+  res <- embedding "nonexistent-model" ["This should fail."]+  case res of+    Left _ -> return () -- Expected failure+    Right _ -> assertFailure "Expected failure with invalid model name"++tests :: TestTree+tests =+  testGroup+    "Embeddings tests"+    [ testEmbeddingInvalidModel+    ]
+ test/Test/Ollama/Generate.hs view
@@ -0,0 +1,360 @@+{-# LANGUAGE OverloadedStrings #-}++{-+  Tests related to Generate module+-}+module Test.Ollama.Generate (tests) where++import Control.Monad (void)+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy.Char8 qualified as BSL+import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Data.Maybe (isJust)+import Data.Ollama.Common.SchemaBuilder+import Data.Ollama.Common.Utils (encodeImage)+import Data.Ollama.Generate+import Data.Text qualified as T+import Data.Time (diffUTCTime, getCurrentTime)+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Test.Tasty+import Test.Tasty.HUnit++generateTests :: TestTree+generateTests =+  testGroup+    "Generation with various options"+    [ testCase "Should contain 4 in 2+2" $ do+        eRes <-+          generate+            defaultGenerateOps {modelName = "gemma3", prompt = "What is 2+2?"}+            Nothing+        case eRes of+          Left err -> assertFailure $ "Expected success, got error: " ++ show err+          Right r -> assertBool "Should contain 4" (T.isInfixOf "4" (genResponse r))+    , testCase "Setting timeout" $ do+        eRes <-+          generate+            defaultGenerateOps+              { modelName = "gemma3"+              , prompt = "Write a poem about French revolution"+              }+            (Just $ defaultOllamaConfig {timeout = 1})+        case eRes of+          Left (TimeoutError _) -> pure ()+          _ -> assertFailure "Expected timeout error"+    ]++testOnModelHooksFail :: TestTree+testOnModelHooksFail = testCase "Model lifecycle hooks should be triggered" $ do+  refStart <- newIORef False+  refError <- newIORef False+  refFinish <- newIORef True+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- guaranteed to fail+          , onModelStart = Just $ writeIORef refStart True+          , onModelError = Just $ writeIORef refError True+          , onModelFinish = Just $ writeIORef refFinish True+          }++  void $+    generate+      defaultGenerateOps {modelName = "gemma3", prompt = "what is 23+41?"}+      (Just config)++  wasStarted <- readIORef refStart+  wasErrored <- readIORef refError+  wasFinished <- readIORef refFinish++  assertBool "onModelStart should be called" wasStarted+  assertBool "onModelError should be called" wasErrored+  assertBool "onModelFinish should be called" wasFinished++testOnModelHooksSucc :: TestTree+testOnModelHooksSucc = testCase "Model lifecycle hooks should be triggered 2" $ do+  refStart <- newIORef False+  refError <- newIORef True+  refFinish <- newIORef False+  let config =+        defaultOllamaConfig+          { onModelStart = Just $ writeIORef refStart True+          , onModelError = Just $ writeIORef refError False+          , onModelFinish = Just $ writeIORef refFinish True+          }++  void $+    generate+      defaultGenerateOps {modelName = "gemma3", prompt = "what is 23+41?"}+      (Just config)++  wasStarted <- readIORef refStart+  wasErrored <- readIORef refError+  wasFinished <- readIORef refFinish++  assertBool "onModelStart should be called" wasStarted+  assertBool "onModelError should be called" wasErrored+  assertBool "onModelFinish should be called" wasFinished++testRetryCount :: TestTree+testRetryCount = testCase "Should retry generate call retryCount times" $ do+  counter <- newIORef (0 :: Int)+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- fails+          , retryCount = Just 2+          , retryDelay = Just 1+          , onModelStart = Just $ modifyIORef counter (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }++  _ <- generate defaultGenerateOps {prompt = "Retry test"} (Just config)+  calls <- readIORef counter+  -- Should be retryCount + 1 (initial + retries)+  assertEqual "Expected 3 attempts (1 initial + 2 retries)" 3 calls++testRetryDelay :: TestTree+testRetryDelay = testCase "Should delay between retries" $ do+  counter <- newIORef (0 :: Int)+  let delaySecs = 2+  start <- getCurrentTime++  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- fails+          , retryCount = Just 1+          , retryDelay = Just delaySecs+          , onModelStart = Just $ modifyIORef counter (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }++  _ <- generate defaultGenerateOps {prompt = "Retry delay test"} (Just config)+  end <- getCurrentTime+  let elapsed = realToFrac (diffUTCTime end start) :: Double+  let expectedMin = fromIntegral delaySecs++  assertBool+    ("Elapsed time should be at least " ++ show expectedMin ++ "s, but was " ++ show elapsed)+    (elapsed >= expectedMin)++testCommonManagerUsage :: TestTree+testCommonManagerUsage = testCase "Should reuse provided commonManager" $ do+  refStart <- newIORef (0 :: Int)+  mgr <-+    newTlsManagerWith tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro 1000000}+  let config =+        defaultOllamaConfig+          { hostUrl = "http://localhost:12345" -- will fail fast+          , commonManager = Just mgr+          , timeout = 999 -- shouldn't matter, manager timeout will be used+          , onModelStart = Just $ modifyIORef refStart (+ 1)+          , onModelError = Just $ pure ()+          , onModelFinish = Just $ pure ()+          }++  _ <- generate defaultGenerateOps {prompt = "1"} (Just config)+  _ <- generate defaultGenerateOps {prompt = "2"} (Just config)+  startCount <- readIORef refStart+  assertEqual "Both requests should start (reuse manager)" 2 startCount++{-+ Suffix is not supported for few gemma3 and qwen3.++testSuffixOption :: TestTree+testSuffixOption = testCase "Should respect suffix in generation" $ do+  let ops = defaultGenerateOps+              { modelName = "qwen3:0.6b"+              , prompt = "Complete this sentence: The Eiffel Tower is in"+              , suffix = Just " [End]"+              }+  eRes <- generate ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> assertBool "Expected suffix in response" $+                  T.isSuffixOf "[End]" (genResponse r)+                  -}++testThinkOption :: TestTree+testThinkOption = testCase "Should activate thinking mode when think=True" $ do+  let ops =+        defaultGenerateOps+          { modelName = "qwen3:0.6b"+          , prompt = "What is 2+2?"+          , think = Just True+          }+  eRes <- generate ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right _ -> pure () -- TODO: Need to find a way to know if model is thinking++testFormatJsonFormat :: TestTree+testFormatJsonFormat = testCase "Should return response in JsonFormat" $ do+  let ops =+        defaultGenerateOps+          { modelName = "gemma3"+          , prompt =+              "John was 23 year old in 2023, this is year 2025."+                <> "How old is John assuming he celebrated this year's birthday; "+                <> "Return an object with keys 'name' and 'age'."+          , format = Just JsonFormat+          }+  eRes <- generate ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> do+      let responseText = genResponse r+      let decoded =+            Aeson.decode (BSL.pack $ T.unpack responseText) ::+              Maybe Aeson.Value+      assertBool "Expected valid JSON object in response" (isJust decoded)++testFormatSchemaFormat :: TestTree+testFormatSchemaFormat = testCase "Should include SchemaFormat in the request" $ do+  let schema =+        buildSchema $+          emptyObject+            |+ ("fruit", JString)+            |+ ("quantity", JNumber)+            |! "fruit"+            |! "quantity"++      ops =+        defaultGenerateOps+          { modelName = "gemma3"+          , prompt = "I had 3 apples, 1 gave one away. How many left?"+          , format = Just (SchemaFormat schema)+          }++  eRes <- generate ops Nothing+  case eRes of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right r -> do+      let response = T.toLower (genResponse r)+      assertBool "Expected fruit information in response" $+        "apple" `T.isInfixOf` response || "fruit" `T.isInfixOf` response++testImageInput :: TestTree+testImageInput = testCase "Should accept and process base64 image input" $ do+  maybeImg <- encodeImage "./examples/sample.png"+  case maybeImg of+    Nothing -> assertFailure "Image encoding failed (unsupported format or missing file)"+    Just imgData -> do+      -- Validate the encoded image data+      assertBool "Encoded image should not be empty" (not $ T.null imgData)+      assertBool "Encoded image should be reasonable length" (T.length imgData > 100)++      let ops =+            defaultGenerateOps+              { modelName = "gemma3"+              , prompt = "Describe this image."+              , images = Just [imgData]+              }+          cfg = Just defaultOllamaConfig {timeout = 300}++      eRes <- generate ops cfg+      case eRes of+        Left err -> assertFailure $ "Expected success, got error: " ++ show err+        Right r -> do+          let response = T.toLower (genResponse r)+          assertBool "Response should not be empty" (not $ T.null response)+          assertBool "Expected image-related description in response" $+            T.isInfixOf "i love haskell" response++testStreamingHandler :: TestTree+testStreamingHandler = testCase "Should handle streaming response" $ do+  -- IORef to collect streamed chunks+  chunksRef <- newIORef []+  -- Define the stream handler: accumulate responses+  let streamHandler chunk = modifyIORef chunksRef (++ [genResponse chunk])+      ops =+        defaultGenerateOps+          { modelName = "gemma3"+          , prompt = "Write few words about Haskell."+          , stream = Just (streamHandler, pure ())+          }+  eRes <- generate ops Nothing+  -- Collect streamed chunks from IORef+  chunks <- readIORef chunksRef+  let fullOutput = T.concat chunks+  case eRes of+    Left err -> assertFailure $ "Expected streaming success, got error: " ++ show err+    Right _ -> do+      assertBool "Expected streamed text to include 'haskell'" $+        "haskell" `T.isInfixOf` T.toLower fullOutput+      assertBool "Expected some streamed content" $ not (T.null fullOutput)++testModelOptionsBasic :: TestTree+testModelOptionsBasic = testCase "ModelOptions: temperature and topP" $ do+  let opts =+        Just $+          defaultModelOptions+            { temperature = Just 0.9+            , topP = Just 0.8+            , topK = Nothing+            , numPredict = Just 20+            }++  eRes <-+    generate+      defaultGenerateOps+        { modelName = "gemma3"+        , prompt = "Generate a random list of 3 animals"+        , options = opts+        }+      Nothing++  case eRes of+    Left err -> assertFailure $ "Expected success, got: " ++ show err+    Right r -> assertBool "Response should not be empty" (not . T.null $ genResponse r)++testModelOptionsEdgeCases :: TestTree+testModelOptionsEdgeCases = testCase "ModelOptions: edge case values" $ do+  let opts =+        Just $+          defaultModelOptions+            { temperature = Just 0.0 -- Minimum temperature+            , topP = Just 1.0 -- Maximum topP+            , topK = Just 1 -- Minimum topK+            , numPredict = Just 1 -- Minimum prediction+            }+  eRes <-+    generate+      defaultGenerateOps+        { modelName = "gemma3"+        , prompt = "Hi"+        , options = opts+        }+      Nothing+  case eRes of+    Left _ -> assertFailure "Expected success, got error"+    Right _ -> assertBool "Should handle edge case model options" True++testInvalidModelName :: TestTree+testInvalidModelName = testCase "Invalid model name should fail gracefully" $ do+  eRes <- generate defaultGenerateOps {modelName = "invalid-model-xyz"} Nothing+  case eRes of+    Left _ -> assertBool "Should fail with invalid model name" True+    Right _ -> assertFailure "Should not succeed with invalid model name"++tests :: TestTree+tests =+  sequentialTestGroup+    "Generate tests"+    AllFinish+    [ generateTests+    , testOnModelHooksFail+    , testOnModelHooksSucc+    , testRetryCount+    , testRetryDelay+    , testCommonManagerUsage+    , testThinkOption+    , testFormatJsonFormat+    , testFormatSchemaFormat+    , testImageInput+    , testStreamingHandler+    , testModelOptionsBasic+    , testModelOptionsEdgeCases+    , testInvalidModelName+    ]
+ test/Test/Ollama/List.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.List (tests) where++import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig)+import Data.Ollama.List+import Data.Text qualified as T+import Test.Tasty+import Test.Tasty.HUnit++testListBasic :: TestTree+testListBasic = testCase "List models: basic call should return Models" $ do+  res <- list Nothing+  case res of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right (Models modelList) -> do+      assertBool "Should return a list (possibly empty)" True+      -- Additional checks if models are present+      case modelList of+        [] -> return () -- Empty list is acceptable+        (model : _) -> do+          assertBool "Model name should not be empty" (not $ T.null $ name model)+          assertBool "Model digest should not be empty" (not $ T.null $ digest model)+          assertBool "Model size should be positive" (size model > 0)+          assertBool "details should be present" True -- ModelDetails is always present++testListWithConfig :: TestTree+testListWithConfig = testCase "List with custom config should work" $ do+  let config = Just $ defaultOllamaConfig {timeout = 10}+  res <- list config+  case res of+    Left _ -> assertFailure "Expected success, got error"+    Right (Models _) -> assertBool "Should return Models type" True++tests :: TestTree+tests =+  testGroup+    "List tests"+    [ testListBasic+    , testListWithConfig+    ]
+ test/Test/Ollama/Load.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Load (tests) where++import Data.Ollama.Load+import Test.Tasty+import Test.Tasty.HUnit++testLoadGenModelBasic :: TestTree+testLoadGenModelBasic = testCase "Load generation model: basic functionality" $ do+  res <- loadGenModel "gemma3"+  case res of+    Left _ -> assertFailure "Expected success, got error"+    Right () -> assertBool "Load should succeed" True++testUnloadGenModelBasic :: TestTree+testUnloadGenModelBasic = testCase "Unload generation model: basic functionality" $ do+  res <- unloadGenModel "gemma3"+  case res of+    Left _ -> assertFailure "Expected success, got error"+    Right () -> assertBool "Unload should succeed" True++testLoadInvalidModel :: TestTree+testLoadInvalidModel = testCase "Load invalid model should fail" $ do+  res <- loadGenModel "nonexistent-model-12345"+  case res of+    Left _ -> assertBool "Should fail with invalid model" True+    Right () -> assertFailure "Should not succeed with invalid model"++testUnloadInvalidModel :: TestTree+testUnloadInvalidModel = testCase "Unload invalid model should handle gracefully" $ do+  res <- unloadGenModel "nonexistent-model-12345"+  case res of+    Left _ -> assertBool "Should fail or handle gracefully" True+    Right () -> assertBool "Or succeed if server handles gracefully" True++testLoadEmptyModelName :: TestTree+testLoadEmptyModelName = testCase "Load model: empty name should fail" $ do+  res <- loadGenModel ""+  case res of+    Left _ -> assertBool "Should fail with empty name" True+    Right () -> assertFailure "Should not succeed with empty name"++tests :: TestTree+tests =+  testGroup+    "Load tests"+    [ testLoadGenModelBasic+    , testUnloadGenModelBasic+    , testLoadInvalidModel+    , testUnloadInvalidModel+    , testLoadEmptyModelName+    ]
+ test/Test/Ollama/Show.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Ollama.Show (tests) where++import Data.Maybe (isJust)+import Data.Ollama.Ps+import Data.Ollama.Show+import Data.Text qualified as T+import Test.Tasty+import Test.Tasty.HUnit++testShowModelBasic :: TestTree+testShowModelBasic = testCase "Show model info: basic call" $ do+  res <- showModel "gemma3"+  case res of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right ShowModelResponse {modelFile, modelInfo = ShowModelInfo {generalArchitecture}} -> do+      assertBool "modelFile should not be empty" (not $ T.null modelFile)+      assertBool "Architecture should be present" (isJust generalArchitecture)++testShowModelVerbose :: TestTree+testShowModelVerbose = testCase "Show model info: verbose enabled" $ do+  res <- showModelOps "qwen3:0.6b" (Just True) Nothing+  case res of+    Left _ -> pure () -- assertFailure $ "Expected success, got error: " ++ show err+    Right ShowModelResponse {template, parameters} -> do+      -- Verbose should yield more details like parameters/template+      assertBool "Should have a template if verbose" (isJust template)+      assertBool "Should have parameters if verbose" (isJust parameters)++testPsBasic :: TestTree+testPsBasic = testCase "List running models: basic success" $ do+  res <- ps Nothing+  case res of+    Left err -> assertFailure $ "Expected success, got error: " ++ show err+    Right (RunningModels _) -> do+      assertBool "Should return a list (possibly empty)" True++testPsModelFields :: TestTree+testPsModelFields = testCase "Running model fields are populated" $ do+  res <- ps Nothing+  case res of+    Left _ -> return () -- Allow failure if no models are running+    Right (RunningModels (m : _)) -> do+      assertBool "name_ should not be empty" (not $ T.null $ name_ m)+      assertBool "modelName should not be empty" (not $ T.null $ modelName m)+      assertBool "modelDigest should not be empty" (not $ T.null $ modelDigest m)+      assertBool "size_ should be positive" (size_ m > 0)+      assertBool "sizeVRam should be non-negative" (sizeVRam m >= 0)+    Right _ -> return () -- If empty, that's acceptable++tests :: TestTree+tests =+  testGroup+    "show model tests"+    [ testShowModelBasic+    , testShowModelVerbose+    , testPsBasic+    , testPsModelFields+    ]