packages feed

ollama-haskell 0.1.3.0 → 0.4.0.0

raw patch · 67 files changed

Files

CHANGELOG.md view
@@ -1,34 +1,57 @@-# Revision history for ollama-haskell--## 0.1.3.0 -- 2025-03-25--* Added options, tools and tool_calls fields in chat and generate.-* Exported EmbeddingResponse.-* Added Format argument in chat and generate function for structured output.--## 0.1.2.0 -- 2024-11-20--* Added hostUrl and responseTimeOut options in generate function.-* Added hostUrl and responseTimeOut options in chat function.+# Changelog -## 0.1.1.3 -- 2024-11-08+All notable changes to `ollama-haskell` will be documented in this file.+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to [PVP (Haskell Package Versioning Policy)](https://pvp.haskell.org/). -* Increase response timeout to 15 minutes-* Added encodeImage utility function that converts image filePath to base64 image data.-* Added generateJson and chatJson. High level function to return response in Haskell type.+--- -## 0.1.0.3 -- 2024-11-05+## [0.4.0.0] - 2026-08-20 -* Moving to stack instead of cabal.+### Added+- **Model Context Protocol (MCP) Integration (`Ollama.MCP`)**:+  - Full bidirectional integration with the Hackage `mcp-server` package (`mcp-server >= 0.2 && < 0.3`).+  - Seamless conversion between Ollama function calling definitions (`Tool`, `ToolCall`) and MCP definitions (`ToolDefinition`, `ArgumentDefinition`, `Content`, `McpSchema`).+  - Bridge functions: `toolToMcpDefinition`, `mcpDefinitionToTool`, `toolCallToMcpArgs`, `mcpContentToToolOutput`.+  - Re-exported MCP server runners (`runMcpServerStdio`, `runMcpServerHttp`, `runMcpServerHttpWithConfig`).+  - Dedicated unit test suite in `Test.Ollama.Unit.MCP`.+- **Automatic JSON Schema Derivation (`Ollama.Types.Format.SchemaDerive`)**:+  - Typeclasses `ToSchema` and `ToJsonType` enabling generic derivation of JSON schemas directly from Haskell record types via `GHC.Generics`.+  - Smart handling of optional fields (`Maybe a` omitted from `required`), nested records (`JObject`), lists (`JArray`), and simple sum enums (`string` enum).+  - Helper functions `schemaFor` and `formatFor` for effortless integration with `chat` / `generate` structured outputs.+  - Dedicated unit test suite in `Test.Ollama.Unit.SchemaDerive`.+- **Configurable Client Timeout**:+  - Support for custom request timeout intervals in `OllamaClientConfig` (`configTimeout`). -## 0.1.0.2 -- 2024-10-18+### Changed+- **PVP Compliance & Upper Bounds**:+  - Added strict upper bounds for `network-uri` (`>= 2.6 && < 2.8`) and `mcp-server` (`>= 0.2 && < 0.3`).+  - Upgraded Stack resolvers and snapshot dependencies (`lts-21.25`, `lts-22.44`, `lts-23.28`, `lts-24.52`, `nightly`). -* Increased response timeout time for chat function. +--- -## 0.1.0.1 -- 2024-10-18+## [0.3.0.0] - 2026-08-04 -* Renaming Lib.hs to OllamaExamples.hs as it was conflicting `Lib.hs` name+### Added+- **`OllamaClient` Core**: Thread-safe client handle with automatic connection manager lifecycle management (`newClient`, `defaultClient`, `clientFromEnv`, `withClient`).+- **First-Class Streaming Pipeline**: `conduit`-based response streaming (`chatStream`, `generateStream`, `pullStream`, `pushStream`, `createModelStream`).+- **Stream Combinators**: `collectStream` and `foldStream` in `Ollama.Streaming`.+- **Structured Output DSL**: Type-safe `SchemaBuilder` DSL in `Ollama.Types.Format.SchemaBuilder` (`|+`, `|++`, `|!`, `|!!`) for constructing JSON Schemas.+- **Thinking / Reasoning Models Support**: `Think` ADT (`ThinkEnabled`, `ThinkDisabled`, `ThinkLevel`) and `ThinkingLevel` (`ThinkLow`, `ThinkMedium`, `ThinkHigh`, `ThinkMax`) supporting models such as `qwen3.5` and `deepseek-r1`.+- **Function / Tool Calling**: `Tool`, `FunctionDef`, `FunctionParameters`, `ToolCall`, and `toolResultMessage` helper.+- **Environment Resolution**: Automatic `OLLAMA_HOST` parsing and normalization in `clientFromEnv` supporting `host:port`, `http://host:port`, and bare `host`.+- **Authorization & Headers**: Support for `OLLAMA_API_KEY` bearer tokens and custom `configHeaders`.+- **Configurable Resilience**: `RetryPolicy` ADT (`NoRetry`, `ConstantRetry`, `ExponentialRetry`), lifecycle callbacks (`configOnStart`, `configOnSuccess`, `configOnError`), and structured logger `configLogger`.+- **Token Throughput Metrics**: Metrics helpers `chatEvalTokensPerSecond`, `chatPromptEvalTokensPerSecond`, `evalTokensPerSecond`, `promptEvalTokensPerSecond`, `tokensPerSecond`.+- **Testing Infrastructure**: Built-in mock testing module `Ollama.Testing` (`newMockClient`, `withMockClient`, `mockGenerateResponse`, `mockChatResponse`, `mockEmbedResponse`, `mockListModelsResponse`).+- **Conversation Store**: Transactional STM-backed `InMemoryStore` and `ConversationStore` typeclass.+- **New API Endpoints**: `Ollama.API.Embed` (`/api/embed`), `Ollama.API.Blobs` (`/api/blobs`), `Ollama.API.Ps` (`/api/ps`), `Ollama.API.Version` (`/api/version`).+- **Benchmark Suite**: Criterion/tasty-bench suite in `bench/Main.hs` measuring serialization and throughput. -## 0.1.0.0 -- YYYY-mm-dd+### Changed+- **MonadIO / MonadUnliftIO Polymorphism**: All API functions use `MonadIO m =>` / `MonadUnliftIO m =>` signatures instead of dual `*M` variants.+- **Typed Newtypes**: `ModelName`, `Digest`, `Base64Image`, `Duration`, `Version` replace primitive string types.+- **Unified Error Type**: `OllamaError` sum type with structured constructors and `Exception` instance. -* First version. Released on an unsuspecting world.+### Deprecated+- `embeddings` endpoint (`/api/embeddings`) marked deprecated in favor of `/api/embed`.
README.md view
@@ -1,74 +1,182 @@-# 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). +[![Hackage](https://img.shields.io/hackage/v/ollama-haskell.svg)](https://hackage.haskell.org/package/ollama-haskell)+[![MIT License](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) -This library allows you to interact with Ollama, a tool that lets you run large language models (LLMs) locally, from within your Haskell projects. +Industry-grade, feature-complete, modern Haskell client library for the [Ollama](https://ollama.com) local LLM engine. -## Examples+## Features +- **Client-Centric Architecture**: Thread-safe `OllamaClient` handle with connection pooling and resource management (`newClient`, `defaultClient`, `clientFromEnv`, `withClient`).+- **First-Class Streaming**: `conduit`-based response streaming (`chatStream`, `generateStream`, `pullStream`, `pushStream`, `createModelStream`).+- **Model Context Protocol (MCP) Bridge**: Bidirectional integration with `mcp-server` for converting between Ollama tools and MCP tools, running MCP servers via stdio or HTTP (`Ollama.MCP`).+- **Generic JSON Schema Derivation**: Automatically derive JSON schemas from Haskell data types via `GHC.Generics` with `ToSchema` and `formatFor`.+- **Complete API Surface**: Text generation, chat completions, vector embeddings, model management (list, show, copy, delete, pull, push, create), and system endpoints.+- **Structured Outputs DSL**: Powerful `SchemaBuilder` DSL (`|+`, `|++`, `|!`, `|!!`) for type-safe JSON Schema structured responses.+- **Function / Tool Calling**: Full support for tool definitions (`Tool`), tool calls (`ToolCall`), and execution results (`toolResultMessage`).+- **Thinking Models Support**: Native support for reasoning models (`qwen3.5`, `deepseek-r1`) with `Think` / `ThinkingLevel` types.+- **Environment & Auth Integration**: Robust URL normalization for `OLLAMA_HOST` and bearer token support for `OLLAMA_API_KEY`.+- **Configurable Resilience**: Flexible retry policies (`NoRetry`, `ConstantRetry`, `ExponentialRetry`), custom timeouts, lifecycle callbacks, and structured logging.+- **Conversation Store**: Transactional STM-backed `InMemoryStore` and `ConversationStore` typeclass for managing multi-turn chat sessions.+- **SDK Comparison Matrix**: Detailed feature comparison against Python, JS/TS, and Go SDKs in [doc/COMPARISON.md](doc/COMPARISON.md).++---++## Installation++Add `ollama-haskell` to your `.cabal` file:++```cabal+build-depends:+    base >= 4.17 && < 5+  , ollama-haskell >= 0.4.0.0+```++Or using Stack in `package.yaml`:++```yaml+dependencies:+  - ollama-haskell >= 0.4.0.0+```++---++## Quick Start (5 Lines)+ ```haskell-{-# LANGUAGE OverloadedStrings #-}-module Lib where+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text.IO qualified as TIO+import Ollama -import Ollama (GenerateOps(..), defaultGenerateOps, generate)+main :: IO ()+main = do+  client <- defaultClient+  res <- chat client $ chatRequest "qwen3.5:2b" (userMessage "Why is the sky blue?" :| [])+  case res of+    Left err   -> print err+    Right resp -> mapM_ (TIO.putStrLn . messageContent) (crMessage resp)+``` +---++## Streaming Responses with Conduit++Stream LLM responses token-by-token as they generate:++```haskell+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text.IO qualified as TIO+import Ollama+ main :: IO () main = do-    void $-      generate-        defaultGenerateOps-          { modelName = "llama3.2"-          , prompt = "what is functional programming?"-          , stream = Just (T.putStr . Ollama.response_, pure ())-          }+  client <- defaultClient+  let req = chatRequest "qwen3.5:2b" (userMessage "Count from 1 to 5." :| [])+  +  -- Stream chunks directly into stdout or collect them+  chunks <- collectStream (chatStream client req)+  mapM_ (TIO.putStr . maybe "" messageContent . crMessage) chunks+  putStrLn "" ``` -### Output+--- -```bash-ghci> import Lib-ghci> main+## Function & Tool Calling -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:+Define function signatures and let the LLM execute structured tool calls: -**Pros:**+```haskell+import Data.List.NonEmpty (NonEmpty ((:|)))+import Ollama -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.+calculatorTool :: Tool+calculatorTool = Tool "function" $ FunctionDef+  { fnName = "add"+  , fnDescription = Just "Add two numbers"+  , fnParameters = Just (FunctionParameters "object" Nothing (Just ["a", "b"]) Nothing Nothing Nothing)+  , fnStrict = Just True+  }++main :: IO ()+main = do+  client <- defaultClient+  let req = (chatRequest "qwen3.5:2b" (userMessage "What is 40 + 2?" :| []))+        { chatTools = Just [calculatorTool] }+  res <- chat client req+  case res of+    Left err   -> print err+    Right resp -> print (crMessage resp) ``` -You can find practical examples demonstrating how to use the library in the `examples/OllamaExamples.hs` file. +--- -## Prerequisite+## Structured Outputs (JSON Schema DSL) -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).+Enforce structured JSON output formats using `SchemaBuilder`: -## How to Use It+```haskell+import Data.Text.IO qualified as TIO+import Ollama+import Ollama.Types.Format.SchemaBuilder -1. Include the `ollama-haskell` package in your `.cabal` file:-   ```cabal-   build-depends:-       base >= 4.7 && < 5,-       ollama-haskell-   ```+personSchema :: Schema+personSchema = buildSchema $ emptyObject+  |+ ("name", JString)+  |+ ("age", JInteger)+  |! "name" -3. Import the `Ollama` module and start integrating with your local LLM.+main :: IO ()+main = do+  client <- defaultClient+  let req = (generateRequest "qwen3.5:2b" "Generate a person profile.")+        { genFormat = Just (SchemaFormat personSchema) }+  res <- generate client req+  case res of+    Left err   -> print err+    Right resp -> TIO.putStrLn (grResponse resp)+``` -## Future Updates+--- -- [x] Improve documentation-- [x] Add tests.-- [x] Add examples.-- [x] Add CI/CD pipeline.-- [ ] `options` parameter in `generate`.+## Environment Variables & Configuration -Stay tuned for future updates and improvements!+Construct a client using environment variables (`OLLAMA_HOST`, `OLLAMA_API_KEY`): -## Author+```haskell+main :: IO ()+main = do+  client <- clientFromEnv+  -- Automatically connects to OLLAMA_HOST with optional Authorization: Bearer header+  ...+``` -This library is developed and maintained by [Tushar](https://github.com/tusharad). Feel free to reach out for any questions or suggestions!+Or configure custom retry policies and loggers: -## Contributions+```haskell+customConfig :: OllamaClientConfig+customConfig = defaultConfig+  { configBaseUrl = "http://my-ollama-server:11434"+  , configTimeout = 120+  , configRetry   = ExponentialRetry 3 1 -- 3 retries with exponential backoff+  , configLogger  = Just (\level msg -> putStrLn $ "[" <> show level <> "] " <> show msg)+  } -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.+main :: IO ()+main = withClient customConfig $ \client -> do+  ...+```++---++## Documentation & SDK Comparison++- [doc/COMPARISON.md](doc/COMPARISON.md) — SDK Feature Matrix comparing `ollama-haskell` with Python, JS/TS, and Go SDKs.+- [CONTRIBUTING.md](CONTRIBUTING.md) — Development setup, testing guidelines, and code style.+- [CHANGELOG.md](CHANGELOG.md) — Release notes and changelog.+- [Hackage Documentation](https://hackage.haskell.org/package/ollama-haskell) — Full Haddock reference.++---++## License++MIT © 2024–2026 Tushar Adhatrao
+ bench/Main.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Main+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Benchmark suite for Ollama client JSON serialization and URL normalization operations.++@since 1.0.0.0+-}+module Main (main) where++import Data.Aeson (decode, encode)+import Data.ByteString.Lazy (ByteString)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Ollama.API.Chat (ChatRequest, ChatResponse, chatRequest)+import Ollama.API.Embed (EmbedRequest, EmbedResponse, embedRequest)+import Ollama.API.Generate (GenerateRequest, GenerateResponse, generateRequest)+import Ollama.API.Models.Create (CreateRequest, defaultCreateRequest)+import Ollama.Testing (mockChatResponse, mockEmbedResponse, mockGenerateResponse)+import Ollama.Types.Common (ModelName (..))+import Ollama.Types.Message (userMessage)+import Test.Tasty.Bench (bench, bgroup, defaultMain, whnf)++main :: IO ()+main =+  defaultMain+    [ bgroup+        "JSON Encoding"+        [ bench "GenerateRequest" $ whnf encode sampleGenerateRequest+        , bench "ChatRequest" $ whnf encode sampleChatRequest+        , bench "EmbedRequest" $ whnf encode sampleEmbedRequest+        , bench "CreateRequest" $ whnf encode sampleCreateRequest+        ]+    , bgroup+        "JSON Decoding"+        [ bench "GenerateResponse" $ whnf (decode @GenerateResponse) sampleGenerateBytes+        , bench "ChatResponse" $ whnf (decode @ChatResponse) sampleChatBytes+        , bench "EmbedResponse" $ whnf (decode @EmbedResponse) sampleEmbedBytes+        ]+    ]++sampleGenerateRequest :: GenerateRequest+sampleGenerateRequest = generateRequest (ModelName "llama3.2") "Why is the sky blue?"++sampleChatRequest :: ChatRequest+sampleChatRequest = chatRequest (ModelName "llama3.2") (userMessage "Hello, world!" :| [])++sampleEmbedRequest :: EmbedRequest+sampleEmbedRequest = embedRequest (ModelName "nomic-embed-text") ["Hello", "World", "Vector"]++sampleCreateRequest :: CreateRequest+sampleCreateRequest = defaultCreateRequest (ModelName "custom-llama")++sampleGenerateBytes :: ByteString+sampleGenerateBytes = encode $ mockGenerateResponse (ModelName "llama3.2") "Sky is blue"++sampleChatBytes :: ByteString+sampleChatBytes = encode $ mockChatResponse (ModelName "llama3.2") "Hello there"++sampleEmbedBytes :: ByteString+sampleEmbedBytes = encode $ mockEmbedResponse (ModelName "nomic") [[0.1, 0.2]]
+ examples/AllFeatures.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Main+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Comprehensive example demonstrating all v1.0 features of ollama-haskell:+  * Client builder with env resolution, custom headers, & retry policies+  * Conduit-based response streaming+  * Thinking / reasoning model integration+  * Function / tool calling+  * Structured JSON schema output+  * Vector embeddings & token throughput metrics+  * Transactional STM conversation storage++@since 1.0.0.0+-}+module Main (main) where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text qualified as T+import Data.Time (getCurrentTime)+import Ollama++fastOptions :: Maybe ModelOptions+fastOptions = Just (defaultOptions {optNumPredict = Just 20})++main :: IO ()+main = do+  putStrLn "=========================================================="+  putStrLn "   ollama-haskell v1.0 — All Features Showcase Example"+  putStrLn "=========================================================="++  -- 1. Client Builder with env vars, custom headers, & Exponential Retry Policy+  putStrLn "\n[1] Initializing client..."+  let customConfig =+        defaultConfig+          { configRetry = ExponentialRetry 3 1+          , configHeaders = [("X-Custom-Client", "ollama-haskell-v1.0")]+          }+  client <- newClient customConfig+  putStrLn "Client initialized with ExponentialRetry policy."++  -- 2. System Inspection+  putStrLn "\n[2] System Engine Version..."+  verRes <- getVersion client+  case verRes of+    Left err -> putStrLn $ "Error fetching version: " <> show err+    Right ver -> putStrLn $ "Ollama Engine Version: " <> T.unpack (unVersion ver)++  putStrLn "\n[3] Listing Local Models..."+  modelsRes <- listModels client+  case modelsRes of+    Left err -> putStrLn $ "Error listing models: " <> show err+    Right (ListResponse ms) -> do+      putStrLn $ "Found " <> show (length ms) <> " installed models:"+      mapM_ (\m -> putStrLn $ "  - " <> T.unpack (unModelName (miName m))) ms++  let model = "qwen3.5:2b"++  -- 4. Conduit-Based Streaming Chat+  putStrLn $ "\n[4] Streaming Chat with Conduit (" <> T.unpack (unModelName model) <> ")..."+  let streamReq =+        (chatRequest model (userMessage "Count from 1 to 5." :| []))+          { chatOptions = fastOptions+          , chatThink = Just ThinkDisabled+          }+  putStr "Response stream: "+  chunks <- collectStream (chatStream client streamReq)+  mapM_+    ( \c -> case crMessage c of+        Just msg -> putStr (T.unpack (messageContent msg))+        Nothing -> pure ()+    )+    chunks+  putStrLn ""++  -- 5. Non-Streaming Chat with Token Throughput Metrics+  putStrLn "\n[5] Non-Streaming Chat & Token Metrics..."+  let chatReq =+        ( chatRequest+            model+            (systemMessage "You are a concise assistant." :| [userMessage "Explain gravity in one sentence."])+        )+          { chatOptions = fastOptions+          , chatThink = Just ThinkDisabled+          }+  chatRes <- chat client chatReq+  case chatRes of+    Left err -> putStrLn $ "Chat error: " <> show err+    Right resp -> do+      case crMessage resp of+        Just msg -> putStrLn $ "Answer: " <> T.unpack (messageContent msg)+        Nothing -> putStrLn "No message returned."+      case chatEvalTokensPerSecond resp of+        Just tps -> putStrLn $ "Generation Speed: " <> show tps <> " tokens/sec"+        Nothing -> pure ()++  -- 6. Thinking / Reasoning Model Integration+  putStrLn "\n[6] Generation with Thinking Mode..."+  let thinkReq =+        (generateRequest model "What is 15 * 14?")+          { genThink = Just (ThinkLevel ThinkMedium)+          , genOptions = fastOptions+          }+  thinkRes <- generate client thinkReq+  case thinkRes of+    Left err -> putStrLn $ "Generate error: " <> show err+    Right resp -> putStrLn $ "Result: " <> T.unpack (grResponse resp)++  -- 7. Tool / Function Calling+  putStrLn "\n[7] Tool / Function Calling..."+  let calcTool =+        Tool+          { toolType = "function"+          , toolFunction =+              FunctionDef+                { fnName = "calculator"+                , fnDescription = Just "Perform basic math calculations"+                , fnParameters =+                    Just+                      FunctionParameters+                        { fpType = "object"+                        , fpProperties = Nothing+                        , fpRequired = Just ["expression"]+                        , fpAdditionalProperties = Nothing+                        , fpDescription = Nothing+                        , fpEnum = Nothing+                        }+                , fnStrict = Just True+                }+          }+      toolReq =+        (chatRequest model (userMessage "Calculate 42 * 8" :| []))+          { chatTools = Just [calcTool]+          , chatOptions = fastOptions+          , chatThink = Just ThinkDisabled+          }+  toolRes <- chat client toolReq+  case toolRes of+    Left err -> putStrLn $ "Tool chat error: " <> show err+    Right resp -> case crMessage resp of+      Just msg -> case messageToolCalls msg of+        Just calls -> putStrLn $ "Model requested tool execution: " <> show calls+        Nothing -> putStrLn $ "Response: " <> T.unpack (messageContent msg)+      Nothing -> putStrLn "No message returned."++  -- 8. Vector Embeddings+  putStrLn "\n[8] Vector Embeddings..."+  let embReq = embedRequest model ["Haskell AI development", "Ollama LLM client"]+  embRes <- embed client embReq+  case embRes of+    Left err -> putStrLn $ "Embed error: " <> show err+    Right resp -> putStrLn $ "Generated " <> show (length (erEmbeddings resp)) <> " embedding vectors."++  -- 9. Transactional Conversation Store+  putStrLn "\n[9] STM Conversation Store..."+  store <- initInMemoryStore+  now <- getCurrentTime+  let convId = "demo-session-42"+      session =+        Conversation+          convId+          [systemMessage "Context saved.", userMessage "Favorite language is Haskell."]+          model+          now+          now+  saveConversationInMemory store session+  retrieved <- loadConversationInMemory store convId+  case retrieved of+    Just c ->+      putStrLn $+        "Successfully loaded conversation ["+          <> T.unpack (conversationId c)+          <> "] with "+          <> show (length (messages c))+          <> " messages."+    Nothing -> putStrLn "Failed to load conversation."++  closeClient client+  putStrLn "\n=========================================================="+  putStrLn "   Showcase Completed Successfully!"+  putStrLn "=========================================================="
+ examples/BasicChat.hs view
@@ -0,0 +1,21 @@+module Main (main) where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text.IO qualified as TIO+import Ollama++main :: IO ()+main = do+  client <- defaultClient+  let opts = Just (defaultOptions {optNumPredict = Just 20})+      req =+        (chatRequest "qwen3.5:2b" (userMessage "Why is the sky blue?" :| []))+          { chatOptions = opts+          , chatThink = Just ThinkDisabled+          }+  res <- chat client req+  case res of+    Left err -> putStrLn $ "Error: " <> show err+    Right resp -> case crMessage resp of+      Just msg -> TIO.putStrLn $ "Response: " <> messageContent msg+      Nothing -> putStrLn "No content returned"
+ examples/Embeddings.hs view
@@ -0,0 +1,12 @@+module Main (main) where++import Ollama++main :: IO ()+main = do+  client <- defaultClient+  let req = embedRequest "qwen3.5:2b" ["Hello world", "Haskell LLM integration"]+  res <- embed client req+  case res of+    Left err -> putStrLn $ "Error: " <> show err+    Right resp -> putStrLn $ "Generated " <> show (length $ erEmbeddings resp) <> " embeddings."
+ examples/ModelManagement.hs view
@@ -0,0 +1,13 @@+module Main (main) where++import Ollama++main :: IO ()+main = do+  client <- defaultClient+  res <- listModels client+  case res of+    Left err -> putStrLn $ "Error listing models: " <> show err+    Right (ListResponse ms) -> do+      putStrLn "Installed Models:"+      mapM_ (print . miName) ms
+ examples/StreamingChat.hs view
@@ -0,0 +1,18 @@+module Main (main) where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text.IO qualified as TIO+import Ollama++main :: IO ()+main = do+  client <- defaultClient+  let opts = Just (defaultOptions {optNumPredict = Just 20})+      req =+        (chatRequest "qwen3.5:2b" (userMessage "Count from 1 to 5." :| []))+          { chatOptions = opts+          , chatThink = Just ThinkDisabled+          }+  chunks <- collectStream (chatStream client req)+  mapM_ (TIO.putStr . maybe "" messageContent . crMessage) chunks+  putStrLn ""
+ examples/StructuredOutput.hs view
@@ -0,0 +1,37 @@+module Main (main) where++import Data.Aeson (FromJSON, eitherDecode)+import Data.Text (Text)+import Data.Text.IO qualified as TIO+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding qualified as TLE+import GHC.Generics (Generic)+import Ollama++-- | Define your type and derive 'ToSchema'. That's it — no manual schema needed.+data Person = Person+  { name :: Text+  , age :: Int+  }+  deriving stock (Generic, Show)+  deriving anyclass (FromJSON, ToSchema)++main :: IO ()+main = do+  client <- defaultClient+  let opts = Just (defaultOptions {optNumPredict = Just 20})+      req =+        (generateRequest "qwen3.5:2b" "Generate a person profile.")+          { genFormat = Just (formatFor @Person)+          , genOptions = opts+          , genThink = Just ThinkDisabled+          }+  res <- generate client req+  case res of+    Left err -> putStrLn $ "Error: " <> show err+    Right resp -> do+      TIO.putStrLn $ "Raw response:\n" <> grResponse resp+      -- Decode into our typed Person+      case eitherDecode (TLE.encodeUtf8 . TL.fromStrict $ grResponse resp) of+        Left decErr -> putStrLn $ "Decode error: " <> decErr+        Right person -> putStrLn $ "Parsed: " <> show (person :: Person)
+ examples/ToolCalling.hs view
@@ -0,0 +1,41 @@+module Main (main) where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Ollama++calculatorTool :: Tool+calculatorTool =+  Tool+    { toolType = "function"+    , toolFunction =+        FunctionDef+          { fnName = "add"+          , fnDescription = Just "Add two numbers"+          , fnParameters =+              Just+                FunctionParameters+                  { fpType = "object"+                  , fpProperties = Nothing+                  , fpRequired = Just ["a", "b"]+                  , fpAdditionalProperties = Nothing+                  , fpDescription = Nothing+                  , fpEnum = Nothing+                  }+          , fnStrict = Just True+          }+    }++main :: IO ()+main = do+  client <- defaultClient+  let opts = Just (defaultOptions {optNumPredict = Just 20})+      req =+        (chatRequest "qwen3.5:2b" (userMessage "What is 25 + 17?" :| []))+          { chatTools = Just [calculatorTool]+          , chatOptions = opts+          , chatThink = Just ThinkDisabled+          }+  res <- chat client req+  case res of+    Left err -> putStrLn $ "Error: " <> show err+    Right resp -> print (crMessage resp)
ollama-haskell.cabal view
@@ -1,91 +1,245 @@-cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.37.0.------ see: https://github.com/sol/hpack--name:           ollama-haskell-version:        0.1.3.0-synopsis:       Haskell bindings for ollama.-description:    Ollama client for Haskell-category:       Web-homepage:       https://github.com/tusharad/ollama-haskell#readme-bug-reports:    https://github.com/tusharad/ollama-haskell/issues-author:         tushar-maintainer:     tusharadhatrao@gmail.com-copyright:      2024 tushar-license:        MIT-license-file:   LICENSE-build-type:     Simple-extra-source-files:-    README.md-    CHANGELOG.md+cabal-version: 3.0+name:          ollama-haskell+version:       0.4.0.0+synopsis:      Industry-grade Haskell client for Ollama local LLMs+description:+  A type-safe Haskell client for interacting with+  locally-running LLMs via the Ollama HTTP API. Supports chat,+  text generation, embeddings, model management, streaming via+  conduit, structured outputs, tool calling, Model Context Protocol (MCP),+  and generic JSON schema derivation.+category:      Web, AI, Network+license:       MIT+license-file:  LICENSE+author:        Tushar Adhatrao+maintainer:    tusharadhatrao@gmail.com+copyright:     2024-2026 Tushar Adhatrao+homepage:      https://github.com/tusharad/ollama-haskell+bug-reports:   https://github.com/tusharad/ollama-haskell/issues+tested-with:   GHC == 9.4.8, GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.4+stability:     stable+extra-doc-files:+  README.md+  CHANGELOG.md  source-repository head   type: git   location: https://github.com/tusharad/ollama-haskell +flag integration-tests+  description: Build and run integration tests (requires running Ollama server)+  default: False+  manual: True++common warnings+  ghc-options:+    -Wall+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-export-lists+    -Wmissing-home-modules+    -Wpartial-fields+    -Wredundant-constraints+    -Wunused-packages++common lang+  default-language: GHC2021+  default-extensions:+    StrictData+    DerivingStrategies+    DeriveGeneric+    DeriveAnyClass+    GeneralizedNewtypeDeriving+    OverloadedStrings+    ImportQualifiedPost+    TypeApplications+    RecordWildCards+    NamedFieldPuns+    LambdaCase+    MultiWayIf+    ScopedTypeVariables+    BangPatterns+ library+  import: warnings, lang+  hs-source-dirs: src   exposed-modules:-      Data.Ollama.Chat-      Data.Ollama.Common.Types-      Data.Ollama.Common.Utils-      Data.Ollama.Copy-      Data.Ollama.Create-      Data.Ollama.Delete-      Data.Ollama.Embeddings-      Data.Ollama.Generate-      Data.Ollama.List-      Data.Ollama.Ps-      Data.Ollama.Pull-      Data.Ollama.Push-      Data.Ollama.Show-      Ollama+    Ollama+    Ollama.Client+    Ollama.Client.Config+    Ollama.API.Generate+    Ollama.API.Chat+    Ollama.API.Embed+    Ollama.API.Models+    Ollama.API.Models.Create+    Ollama.API.Models.Pull+    Ollama.API.Models.Push+    Ollama.API.Blobs+    Ollama.API.Ps+    Ollama.API.Version+    Ollama.Types+    Ollama.Types.Message+    Ollama.Types.Tool+    Ollama.Types.Model+    Ollama.Types.Options+    Ollama.Types.Format+    Ollama.Types.Format.SchemaBuilder+    Ollama.Types.Format.SchemaDerive+    Ollama.Types.Common+    Ollama.Error+    Ollama.Streaming+    Ollama.Testing+    Ollama.Conversation+    Ollama.MCP   other-modules:-      Paths_ollama_haskell-  hs-source-dirs:-      src-  default-extensions:-      ImportQualifiedPost-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+    Ollama.Client.Internal   build-depends:-      aeson-    , base >=4.7 && <5-    , base64-bytestring-    , bytestring-    , containers-    , directory-    , filepath-    , http-client-    , http-types-    , text-    , time-  default-language: Haskell2010+      aeson            >= 2.0 && < 3+    , base             >= 4.17 && < 5+    , bytestring       >= 0.10 && < 0.13+    , case-insensitive >= 1.2 && < 1.3+    , conduit          >= 1.3 && < 1.4+    , conduit-extra    >= 1.3 && < 1.4+    , containers       >= 0.6 && < 0.9+    , hashable         >= 1.4 && < 1.6+    , http-client      >= 0.6 && < 0.8+    , http-client-tls  >= 0.2 && < 0.5+    , http-types       >= 0.7 && < 0.13+    , mtl              >= 2.2 && < 3+    , retry            >= 0.9 && < 0.10+    , resourcet        >= 1.3 && < 1.4+    , stm              >= 2.5 && < 3+    , text             >= 2.0 && < 3+    , time             >= 1.11 && < 2+    , unliftio-core    >= 0.2 && < 0.3+    , mcp-server       >= 0.2 && < 0.3  test-suite ollama-haskell-test+  import: warnings, lang   type: exitcode-stdio-1.0+  hs-source-dirs: test   main-is: Main.hs   other-modules:-      Paths_ollama_haskell-  hs-source-dirs:-      test-  default-extensions:-      ImportQualifiedPost-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+    Test.Ollama.Unit.Types+    Test.Ollama.Unit.Error+    Test.Ollama.Unit.Config+    Test.Ollama.Unit.SchemaBuilder+    Test.Ollama.Unit.SchemaDerive+    Test.Ollama.Unit.Testing+    Test.Ollama.Property.Arbitrary+    Test.Ollama.Property.Roundtrip+    Test.Ollama.Golden.Chat+    Test.Ollama.Golden.Generate+    Test.Ollama.Golden.Embed+    Test.Ollama.Golden.Models+    Test.Ollama.Unit.MCP   build-depends:-      aeson-    , base >=4.7 && <5-    , base64-bytestring+      base+    , ollama-haskell+    , aeson     , bytestring     , containers-    , directory-    , filepath-    , http-client-    , http-types+    , mcp-server+    , QuickCheck       >= 2.14+    , tasty          >= 1.5+    , tasty-golden   >= 2.3+    , tasty-hunit+    , tasty-quickcheck >= 0.10+    , text+    , time+    , conduit++test-suite ollama-haskell-integration+  import: warnings, lang+  type: exitcode-stdio-1.0+  hs-source-dirs: test-integration+  main-is: Main.hs+  if !flag(integration-tests)+    buildable: False+  build-depends:+      base     , ollama-haskell-    , silently+    , aeson     , tasty     , tasty-hunit     , text     , time-  default-language: Haskell2010++benchmark ollama-haskell-bench+  import: warnings, lang+  type: exitcode-stdio-1.0+  hs-source-dirs: bench+  main-is: Main.hs+  build-depends:+      base+    , ollama-haskell+    , aeson+    , bytestring+    , tasty          >= 1.5+    , tasty-bench    >= 0.3+    , text++executable ollama-example-basic-chat+  import: warnings, lang+  main-is: BasicChat.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell+    , text++executable ollama-example-streaming-chat+  import: warnings, lang+  main-is: StreamingChat.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell+    , text++executable ollama-example-tool-calling+  import: warnings, lang+  main-is: ToolCalling.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell++executable ollama-example-structured-output+  import: warnings, lang+  main-is: StructuredOutput.hs+  hs-source-dirs: examples+  build-depends:+      aeson+    , base+    , ollama-haskell+    , text++executable ollama-example-embeddings+  import: warnings, lang+  main-is: Embeddings.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell++executable ollama-example-model-management+  import: warnings, lang+  main-is: ModelManagement.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell++executable ollama-example-all-features+  import: warnings, lang+  main-is: AllFeatures.hs+  hs-source-dirs: examples+  build-depends:+      base+    , ollama-haskell+    , text+    , time+
− src/Data/Ollama/Chat.hs 
@@ -1,401 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Data.Ollama.Chat-  ( -- * Chat APIs-    chat-  , chatJson-  , Message (..)-  , Role (..)-  , defaultChatOps-  , ChatOps (..)-  , ChatResponse (..)-  , Format (..)-  , schemaFromType -  ) where--import Control.Exception (try)-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.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---- | 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 (String "system") = pure System-  parseJSON (String "user") = pure User-  parseJSON (String "assistant") = pure Assistant-  parseJSON (String "tool") = pure Tool-  parseJSON _ = fail "Invalid Role value"---- TODO : Add tool_calls parameter---- | 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)---- TODO: Add Options parameter-data ChatOps = ChatOps-  { chatModelName :: Text-  -- ^ The name of the chat model to be used.-  , messages :: NonEmpty Message-  -- ^ A non-empty list of messages forming the conversation context.-  , tools :: Maybe [Value]-  -- ^ 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-  }--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--instance Eq ChatOps where-  (==) a b =-    chatModelName a == chatModelName 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) =-    object-      [ "model" .= model_-      , "messages" .= messages_-      , "tools" .= tools_-      , "format" .= format_-      , "stream" .= if isNothing stream_ then Just False else Just True-      , "keep_alive" .= keepAlive_-      , "options" .= options-      ]--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"--{- |-A default configuration for initiating a chat with a model.-This can be used as a starting point and modified as needed.--Example:--> let ops = defaultChatOps { chatModelName = "customModel" }-> chat ops--}-defaultChatOps :: ChatOps-defaultChatOps =-  ChatOps-    { chatModelName = "llama3.2"-    , messages = Message User "What is 2+2?" Nothing Nothing :| []-    , tools = Nothing-    , format = Nothing-    , stream = Nothing-    , keepAlive = Nothing-    , hostUrl = Nothing-    , responseTimeOut = Nothing-    , options = Nothing-    }--{- |-Initiates a chat session with the specified 'ChatOps' configuration and returns either-a 'ChatResponse' or an error message.--This function sends a request to the Ollama chat API with the given options.--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.--}-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---- | 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--{- |-   Example usage of 'Ollama.chat' with a JSON schema format and options field.--   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@).--   >>> 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})--}
− src/Data/Ollama/Common/Types.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Common.Types-  ( ModelDetails (..)-  , OllamaClient (..)-  , Format (..)-  ) where--import Data.Aeson-import Data.Text (Text)--data ModelDetails = ModelDetails-  { parentModel :: Maybe Text-  , format :: Text-  , familiy :: Text-  , families :: [Text]-  , parameterSize :: Text-  , quantizationLevel :: Text-  }-  deriving (Eq, Show)--instance FromJSON ModelDetails where-  parseJSON = withObject "ModelDetails" $ \v ->-    ModelDetails-      <$> v .: "parent_model"-      <*> v .: "format"-      <*> v .: "family"-      <*> v .:? "families" .!= []-      <*> v .: "parameter_size"-      <*> v .: "quantization_level"--newtype OllamaClient = OllamaClient-  { host :: Text-  }-  deriving (Eq, Show)---{-|-E.g SchemaFormat-{-    "type": "object",-    "properties": {-      "age": {-        "type": "integer"-      },-      "available": {-        "type": "boolean"-      }-    },-    "required": [-      "age",-      "available"-    ]-  }-|-}--- | Format specification for the chat output--- | Since 0.1.3.0-data Format = JsonFormat | SchemaFormat Value-  deriving (Show, Eq)--instance ToJSON Format where-  toJSON JsonFormat = String "json"-  toJSON (SchemaFormat schema) = schema
− src/Data/Ollama/Common/Utils.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Common.Utils (defaultOllamaUrl, OllamaClient (..), encodeImage) where--import Control.Exception (IOException, try)-import Data.ByteString qualified as BS-import Data.ByteString.Base64 qualified as Base64-import Data.Char (toLower)-import Data.Ollama.Common.Types-import Data.Text (Text)-import Data.Text.Encoding qualified as TE-import System.Directory-import System.FilePath--defaultOllamaUrl :: Text-defaultOllamaUrl = "http://127.0.0.1:11434"--supportedExtensions :: [String]-supportedExtensions = [".jpg", ".jpeg", ".png"]--safeReadFile :: FilePath -> IO (Either IOException BS.ByteString)-safeReadFile = try . BS.readFile--asPath :: FilePath -> IO (Maybe BS.ByteString)-asPath filePath = do-  exists <- doesFileExist filePath-  if exists-    then either (const Nothing) Just <$> safeReadFile filePath-    else return Nothing--isSupportedExtension :: FilePath -> Bool-isSupportedExtension path = map toLower (takeExtension path) `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.--}-encodeImage :: FilePath -> IO (Maybe Text)-encodeImage filePath = do-  if not (isSupportedExtension filePath)-    then return Nothing-    else do-      maybeContent <- asPath filePath-      return $ fmap (TE.decodeUtf8 . Base64.encode) maybeContent
− src/Data/Ollama/Copy.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Copy-  ( -- * Copy Model API-    copyModel-  ) where--import Control.Monad (when)-import Data.Aeson-import Data.Ollama.Common.Utils qualified as CU-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-data CopyModelOps = CopyModelOps-  { source :: Text-  , destination :: Text-  }-  deriving (Show, Eq, Generic, ToJSON)---- | Copy model from source to destination-copyModel ::-  -- | Source model-  Text ->-  -- | Destination model-  Text ->-  IO ()-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")
− src/Data/Ollama/Create.hs 
@@ -1,120 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Create-  ( -- * Create Model API-    createModel-  , createModelOps-  ) where--import Control.Monad (unless)-import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL-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---- TODO: Add Options parameter--- TODO: Add Context parameter-data CreateModelOps = CreateModelOps-  { name :: Text-  , modelFile :: Maybe Text-  , stream :: Maybe Bool-  , path :: Maybe FilePath-  }-  deriving (Show, Eq)---- TODO: Add Context Param-newtype CreateModelResp = CreateModelResp {status :: Text}-  deriving (Show, Eq)--instance ToJSON CreateModelOps where-  toJSON-    ( CreateModelOps-        name_-        modelFile_-        stream_-        path_-      ) =-      object-        [ "name" .= name_-        , "modelfile" .= modelFile_-        , "stream" .= stream_-        , "path" .= path_-        ]--instance FromJSON CreateModelResp where-  parseJSON = withObject "CreateModelResp" $ \v ->-    CreateModelResp-      <$> v .: "status"--{- | 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--{- | Create a new model-| Please note, if you specify both ModelFile and Path, ModelFile will be used.--}-createModel ::-  -- | Model Name-  Text ->-  -- | Model File-  Maybe Text ->-  -- | Path-  Maybe FilePath ->-  IO ()-createModel modelName modelFile_ =-  createModelOps-    modelName-    modelFile_-    Nothing
− src/Data/Ollama/Delete.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Delete-  ( -- * Delete downloaded Models-    deleteModel-  ) where--import Control.Monad (when)-import Data.Aeson-import Data.Ollama.Common.Utils qualified as CU-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)---- | Delete a model-deleteModel ::-  -- | Model name-  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")
− src/Data/Ollama/Embeddings.hs 
@@ -1,102 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Embeddings-  ( -- * Embedding API-    embedding-  , embeddingOps-  , EmbeddingOps (..)-  , EmbeddingResp (..)-  ) where--import Data.Aeson-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-data EmbeddingOps = EmbeddingOps-  { model :: Text-  , input :: Text-  , truncate :: Maybe Bool-  , keepAlive :: Maybe Text-  }-  deriving (Show, Eq)--data EmbeddingResp = EmbeddingResp-  { model :: Text-  , embedding_ :: [[Float]]-  }-  deriving (Show, Eq)--instance FromJSON EmbeddingResp where-  parseJSON = withObject "EmbeddingResp" $ \v -> EmbeddingResp-        <$> v .: "model"-        <*> v .: "embeddings"--instance ToJSON EmbeddingOps where-  toJSON (EmbeddingOps model_ input_ truncate' keepAlive_) =-    object-      [ "model" .= model_-      , "input" .= input_-      , "truncate" .= truncate'-      , "keep_alive" .= keepAlive_-      ]---- TODO: Add Options parameter---- | Embedding API-embeddingOps ::-  -- | Model-  Text ->-  -- | Input-  Text ->-  -- | Truncate-  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---- Higher level binding that only takes important params---- | Embedding API-embedding ::-  -- | Model-  Text ->-  -- | Input-  Text ->-  IO (Either String EmbeddingResp)-embedding modelName input_ =-  embeddingOps modelName input_ Nothing Nothing
− src/Data/Ollama/Generate.hs 
@@ -1,410 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Data.Ollama.Generate-  ( -- * Generate Texts-    generate-  , defaultGenerateOps-  , generateJson-  , GenerateOps (..)-  , GenerateResponse (..)-  ) where--import Control.Exception (try)-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.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--{- |-  Input type for generate functions. This data type represents all possible configurations-  that you can pass to the Ollama generate API.--  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"-  >         }--}-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.-  , 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-  }--instance Show GenerateOps where-  show GenerateOps {..} =-    "GenerateOps { "-      <> "model : "-      <> T.unpack modelName-      <> ", prompt : "-      <> T.unpack prompt-      <> ", suffix : "-      <> show suffix-      <> ", images : "-      <> show images-      <> ", format : "-      <> show format-      <> ", system : "-      <> show system-      <> ", template : "-      <> show template-      <> ", stream : "-      <> "Stream functions"-      <> ", raw : "-      <> show raw-      <> ", keepAlive : "-      <> show keepAlive-      <> ", options : "-      <> show options--instance Eq GenerateOps where-  (==) a b =-    modelName a == modelName b-      && prompt a == prompt b-      && suffix a == suffix b-      && images a == images b-      && format a == format b-      && system a == system b-      && template a == template b-      && 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)--instance ToJSON GenerateOps where-  toJSON-    ( GenerateOps-        model-        prompt-        suffix-        images-        format-        system-        template-        stream-        raw-        keepAlive-        _ -- Host url-        _ -- Response timeout-        options -      ) =-      object-        [ "model" .= model-        , "prompt" .= prompt-        , "suffix" .= suffix-        , "images" .= images-        , "format" .= format-        , "system" .= system-        , "template" .= template-        , "stream" .= if isNothing stream then Just False else Just True-        , "raw" .= raw-        , "keep_alive" .= keepAlive-        , "options" .= options-        ]--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"--{- |-A function to create a default 'GenerateOps' type with preset values.--Example:--> let ops = defaultGenerateOps-> generate ops--This will generate a response using the default configuration.--}-defaultGenerateOps :: GenerateOps-defaultGenerateOps =-  GenerateOps-    { modelName = "llama3.2"-    , prompt = "what is 2+2"-    , suffix = Nothing-    , images = Nothing-    , format = Nothing-    , system = Nothing-    , template = Nothing-    , stream = Nothing-    , raw = Nothing-    , keepAlive = Nothing-    , hostUrl = Nothing-    , responseTimeOut = Nothing-    , options = 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--Usage with streaming to print responses to the console:--> void $->   generate->     defaultGenerateOps->       { modelName = "llama3.2"->       , prompt = "what is functional programming?"->       , stream = Just (T.putStr . response_, pure ())->       }--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)--}-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.-- 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)--Output:-  > ("JSON response: ",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.--}-generateJson ::-  (ToJSON jsonResult, FromJSON jsonResult) =>-  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})--}-
− src/Data/Ollama/List.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.List-  ( -- * List Models API-    list-  , Models (..)-  , ModelInfo (..)-  )-where--import Data.Aeson-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]-  deriving (Eq, Show)--data ModelInfo = ModelInfo-  { name :: Text-  , modifiedAt :: UTCTime-  , size :: Int64-  , digest :: Text-  , details :: ModelDetails-  }-  deriving (Eq, Show)---- Instances-instance FromJSON Models where-  parseJSON = withObject "Models" $ \v -> Models <$> v .: "models"--instance FromJSON ModelInfo where-  parseJSON = withObject "ModelInfo" $ \v ->-    ModelInfo-      <$> v .: "name"-      <*> v .: "modified_at"-      <*> v .: "size"-      <*> 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
− src/Data/Ollama/Ps.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Ps-  ( ps-  , RunningModels (..)-  , RunningModel (..)-  ) where--import Data.Aeson-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]-  deriving (Eq, Show)--data RunningModel = RunningModel-  { name_ :: Text-  , modelName :: Text-  , size_ :: Int64-  , modelDigest :: Text-  , modelDetails :: ModelDetails-  , expiresAt :: UTCTime-  , sizeVRam :: Int64-  }-  deriving (Eq, Show)--instance FromJSON RunningModels where-  parseJSON = withObject "Models" $ \v -> RunningModels <$> v .: "models"--instance FromJSON RunningModel where-  parseJSON = withObject "RunningModel" $ \v ->-    RunningModel-      <$> v .: "name"-      <*> v .: "model"-      <*> v .: "size"-      <*> v .: "digest"-      <*> v .: "details"-      <*> 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
− src/Data/Ollama/Pull.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Pull-  ( -- * Downloaded Models-    pull-  , pullOps-  ) where--import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL-import Data.Maybe (fromMaybe)-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.-  }-  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-  -- ^ The total size of the model in bytes, if available.-  , completed :: Maybe Int64-  -- ^ The number of bytes completed, 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:--> pullOps "myModel" (Just True) (Just True)--This will attempt to pull "myModel" with insecure connections allowed and enable streaming.--}-pullOps ::-  -- | Model Name-  Text ->-  -- | Insecure-  Maybe Bool ->-  -- | Stream-  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--{- |-Pull a model using default options. This simplifies the pull operation by-not requiring additional options.--Example:--> pull "myModel"--This will pull "myModel" using default settings (no insecure connections and no streaming).--}-pull ::-  -- | Model Name-  Text ->-  IO ()-pull modelName = pullOps modelName Nothing Nothing
− src/Data/Ollama/Push.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Push-  ( -- * Push API-    push-  , pushOps-  ) where--import Data.Aeson-import Data.ByteString.Lazy.Char8 qualified as BSL-import Data.Maybe (fromMaybe)-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-data PushOps = PushOps-  { name :: Text-  , insecure :: Maybe Bool-  , stream :: Maybe Bool-  }-  deriving (Show, Eq, Generic, ToJSON)--data PushResp = PushResp-  { status :: Text-  , digest :: Maybe Text-  , total :: Maybe Int64-  }-  deriving (Show, Eq, Generic, FromJSON)---- | Push a model with options-pushOps ::-  -- | Model name-  Text ->-  -- | Insecure-  Maybe Bool ->-  -- | Stream-  Maybe Bool ->-  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---- Higher level API for Pull--- This API is untested. Will test soon!---- | Push a model-push ::-  -- | Model name-  Text ->-  IO ()-push modelName = pushOps modelName Nothing Nothing
− src/Data/Ollama/Show.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Ollama.Show-  ( -- * Show Model Info API-    showModel-  , showModelOps-  , ShowModelResponse (..)-  ) where--import Data.Aeson-import Data.Ollama.Common.Utils qualified 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--- TODO: Add Context parameter--{- |- #ShowModelOps#- Input parameters for show model information.--}-data ShowModelOps = ShowModelOps-  { name :: Text-  , verbose :: Maybe Bool-  }-  deriving (Show, Eq, Generic, ToJSON)--{- |- #ShowModelResponse#-- Ouput structure for show 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-  }-  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]-  }-  deriving (Show, Eq)---- FromJSON instances---- | The instance for show model response-instance FromJSON ShowModelResponse where-  parseJSON = withObject "ShowModelResponse" $ \v ->-    ShowModelResponse-      <$> v .: "modelfile"-      <*> 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"--instance FromJSON ModelInfo where-  parseJSON = withObject "ModelInfo" $ \v ->-    ModelInfo-      <$> v .:? "general.architecture"-      <*> v .:? "general.file_type"-      <*> v .:? "general.parameter_count"-      <*> v .:? "general.quantization_version"-      <*> v .:? "llama.attention.head_count"-      <*> v .:? "llama.attention.head_count_kv"-      <*> v .:? "llama.attention.layer_norm_rms_epsilon"-      <*> v .:? "llama.block_count"-      <*> v .:? "llama.context_length"-      <*> v .:? "llama.embedding_length"-      <*> v .:? "llama.feed_forward_length"-      <*> v .:? "llama.rope.dimension_count"-      <*> v .:? "llama.rope.freq_base"-      <*> v .:? "llama.vocab_size"-      <*> v .:? "tokenizer.ggml.bos_token_id"-      <*> v .:? "tokenizer.ggml.eos_token_id"-      <*> v .:? "tokenizer.ggml.merges"-      <*> v .:? "tokenizer.ggml.model"-      <*> v .:? "tokenizer.ggml.pre"-      <*> v .:? "tokenizer.ggml.token_type"-      <*> v .:? "tokenizer.ggml.tokens"--{- | Show given model's information with options.--@since 1.0.0.0--}-showModelOps ::-  -- | model name-  Text ->-  -- | verbose-  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--{- | Show given model's information.--Higher level API for show.-@since 1.0.0.0--}-showModel ::-  -- | model name-  Text ->-  IO (Maybe ShowModelResponse)-showModel modelName =-  showModelOps modelName Nothing
src/Ollama.hs view
@@ -1,94 +1,197 @@-{-# LANGUAGE DuplicateRecordFields #-} {- |-  #Ollama-Haskell#-  This library lets you run LlMs from within Haskell projects. Inspired by `ollama-python`.+Module      : Ollama+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Top-level umbrella re-export module for the Ollama Haskell client library.++== Quick Example++@+import Ollama++main :: IO ()+main = do+  client <- defaultClient+  let req = chatRequest "llama3.2" (userMessage "Why is the sky blue?" :| [])+  result <- chat client req+  case result of+    Left err -> print err+    Right resp -> case crMessage resp of+      Just msg -> putStrLn (messageContent msg)+      Nothing  -> putStrLn "No message returned"+@++@since 1.0.0.0 -}-module Ollama-  ( -- * Main APIs+module Ollama (+  -- * Client+  OllamaClient,+  newClient,+  defaultClient,+  clientFromEnv,+  closeClient,+  withClient, -    -- ** Generate Texts-    generate-  , generateJson-  , defaultGenerateOps-  , GenerateOps (..)-  , GenerateResponse (..)+  -- * Config & Retry+  OllamaClientConfig (..),+  defaultConfig,+  RetryPolicy (..),+  LogLevel (..), -    -- ** Chat with LLMs-  , chat-  , chatJson-  , Role (..)-  , defaultChatOps-  , ChatResponse (..)-  , ChatOps (..)+  -- * API Endpoints -    -- ** Embeddings-  , embedding-  , embeddingOps-  , EmbeddingOps (..)-  , EmbeddingResp (..)+  -- ** Chat+  chat,+  chatStream,+  ChatRequest (..),+  ChatResponse (..),+  chatRequest,+  chatEvalTokensPerSecond,+  chatPromptEvalTokensPerSecond, -    -- * Ollama operations+  -- ** Generate+  generate,+  generateStream,+  GenerateRequest (..),+  GenerateResponse (..),+  generateRequest,+  evalTokensPerSecond,+  promptEvalTokensPerSecond, -    -- ** Copy Models-  , copyModel+  -- ** Embeddings+  embed,+  EmbedRequest (..),+  EmbedResponse (..),+  embedRequest,+  embeddings,+  EmbeddingsRequest (..),+  EmbeddingsResponse (..), -    -- ** Create Models-  , createModel-  , createModelOps+  -- ** Model Management+  listModels,+  showModel,+  copyModel,+  deleteModel,+  ListResponse (..),+  ModelInfo (..),+  RunningModel (..),+  ShowResponse (..), -    -- ** Delete Models-  , deleteModel+  -- ** Create+  createModel,+  createModelStream,+  defaultCreateRequest,+  CreateRequest (..),+  CreateResponse (..),+  QuantizationType (..), -    -- ** List Models-  , list+  -- ** Pull & Push+  pull,+  pullStream,+  push,+  pushStream,+  PullResponse (..),+  PushResponse (..), -    -- ** List currently running models-  , ps+  -- ** Blobs+  checkBlob,+  pushBlob, -    -- ** Push and Pull-  , push-  , pushOps-  , pull-  , pullOps+  -- ** System+  getVersion,+  listRunning,+  RunningModelsResponse (..), -    -- ** Show Model Info-  , showModel-  , showModelOps+  -- * Types & Primitives+  ModelName (..),+  mkModelName,+  Digest (..),+  Base64Image (..),+  Duration (..),+  durationToSeconds,+  durationToMillis,+  tokensPerSecond,+  Version (..),+  Think (..),+  ThinkingLevel (..), -    -- * Types-  , ShowModelResponse (..)-  , Models (..)-  , ModelInfo (..)-  , RunningModels (..)-  , RunningModel (..)-  , Message (..)-  , Format(..)-  )-where+  -- ** Messages+  Role (..),+  Message (..),+  userMessage,+  systemMessage,+  assistantMessage,+  toolMessage,+  toolResultMessage,+  imageMessage, -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.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 (..))+  -- ** Tools & Functions+  Tool (..),+  FunctionDef (..),+  FunctionParameters (..),+  ToolCall (..),+  ToolCallFunction (..),++  -- ** Options & Format+  ModelOptions (..),+  defaultOptions,+  Format (..),+  ToSchema (..),+  ToJsonType (..),+  schemaFor,+  formatFor,++  -- * Error Handling+  OllamaError (..),+  isRetryable,+  throwOllama,++  -- * Streaming+  HasDone (..),+  collectStream,+  foldStream,++  -- * Testing Infrastructure+  newMockClient,+  withMockClient,+  mockGenerateResponse,+  mockChatResponse,+  mockEmbedResponse,+  mockListModelsResponse,++  -- * Conversation Store+  Conversation (..),+  ConversationStore (..),+  InMemoryStore (..),+  initInMemoryStore,+  saveConversationInMemory,+  loadConversationInMemory,+  listConversationsInMemory,+  deleteConversationInMemory,++  -- * Model Context Protocol (MCP) Integration+  module Ollama.MCP,+) where++import Ollama.API.Blobs+import Ollama.API.Chat+import Ollama.API.Embed+import Ollama.API.Generate+import Ollama.API.Models+import Ollama.API.Models.Create+import Ollama.API.Models.Pull+import Ollama.API.Models.Push+import Ollama.API.Ps+import Ollama.API.Version+import Ollama.Client+import Ollama.Client.Config+import Ollama.Conversation+import Ollama.Error+import Ollama.MCP+import Ollama.Streaming+import Ollama.Testing+import Ollama.Types
+ src/Ollama/API/Blobs.hs view
@@ -0,0 +1,45 @@+{- |+Module      : Ollama.API.Blobs+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Blob management endpoints (@/api/blobs/:digest@).++@since 1.0.0.0+-}+module Ollama.API.Blobs (+  checkBlob,+  pushBlob,+) where++import Control.Monad.IO.Class (MonadIO)+import Data.ByteString (ByteString)+import Data.Functor (void)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (requestRaw)+import Ollama.Error (OllamaError (..))+import Ollama.Types.Common (Digest (..))++{- | Check if a blob exists on the server (@HEAD /api/blobs/:digest@).++@since 1.0.0.0+-}+checkBlob :: (MonadIO m) => OllamaClient -> Digest -> m (Either OllamaError Bool)+checkBlob client (Digest d) = do+  res <- requestRaw client "HEAD" ("/api/blobs/" <> d) Nothing+  pure $ case res of+    Right _ -> Right True+    Left (ApiError 404 _) -> Right False+    Left err -> Left err++{- | Push / upload a file blob to the server (@POST /api/blobs/:digest@).++@since 1.0.0.0+-}+pushBlob :: (MonadIO m) => OllamaClient -> Digest -> ByteString -> m (Either OllamaError ())+pushBlob client (Digest d) payload = do+  res <- requestRaw client "POST" ("/api/blobs/" <> d) (Just payload)+  pure $ void res
+ src/Ollama/API/Chat.hs view
@@ -0,0 +1,170 @@+{- |+Module      : Ollama.API.Chat+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Chat completion API endpoint (@/api/chat@).++@since 1.0.0.0+-}+module Ollama.API.Chat (+  ChatRequest (..),+  ChatResponse (..),+  chatRequest,+  chat,+  chatStream,+  chatEvalTokensPerSecond,+  chatPromptEvalTokensPerSecond,+) where++import Conduit (ConduitT)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Aeson+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request, requestStreaming)+import Ollama.Error (OllamaError)+import Ollama.Streaming (HasDone (..))+import Ollama.Types.Common (Duration, ModelName, Think, tokensPerSecond)+import Ollama.Types.Format (Format)+import Ollama.Types.Message (Message)+import Ollama.Types.Options (ModelOptions)+import Ollama.Types.Tool (Tool)++{- | Chat completion request payload.++@since 1.0.0.0+-}+data ChatRequest = ChatRequest+  { chatModel :: !ModelName+  , chatMessages :: !(NonEmpty Message)+  , chatTools :: !(Maybe [Tool])+  , chatFormat :: !(Maybe Format)+  , chatOptions :: !(Maybe ModelOptions)+  , chStream :: !(Maybe Bool)+  , chatKeepAlive :: !(Maybe Text)+  , chatThink :: !(Maybe Think)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ChatRequest where+  toJSON ChatRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= chatModel+        , Just $ "messages" .= chatMessages+        , ("tools" .=) <$> chatTools+        , ("format" .=) <$> chatFormat+        , ("options" .=) <$> chatOptions+        , ("stream" .=) <$> chStream+        , ("keep_alive" .=) <$> chatKeepAlive+        , ("think" .=) <$> chatThink+        ]++{- | Create a default 'ChatRequest' for a model and message history.++@since 1.0.0.0+-}+chatRequest :: ModelName -> NonEmpty Message -> ChatRequest+chatRequest model msgs =+  ChatRequest+    { chatModel = model+    , chatMessages = msgs+    , chatTools = Nothing+    , chatFormat = Nothing+    , chatOptions = Nothing+    , chStream = Just False+    , chatKeepAlive = Nothing+    , chatThink = Nothing+    }++{- | Chat completion response payload.++@since 1.0.0.0+-}+data ChatResponse = ChatResponse+  { crModel :: !ModelName+  , crCreatedAt :: !UTCTime+  , crMessage :: !(Maybe Message)+  , crDone :: !Bool+  , crDoneReason :: !(Maybe Text)+  , crTotalDuration :: !(Maybe Duration)+  , crLoadDuration :: !(Maybe Duration)+  , crPromptEvalCount :: !(Maybe Int)+  , crPromptEvalDuration :: !(Maybe Duration)+  , crEvalCount :: !(Maybe Int)+  , crEvalDuration :: !(Maybe Duration)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON ChatResponse where+  parseJSON = withObject "ChatResponse" $ \v ->+    ChatResponse+      <$> v .: "model"+      <*> v .: "created_at"+      <*> v .:? "message"+      <*> v .: "done"+      <*> v .:? "done_reason"+      <*> v .:? "total_duration"+      <*> v .:? "load_duration"+      <*> v .:? "prompt_eval_count"+      <*> v .:? "prompt_eval_duration"+      <*> v .:? "eval_count"+      <*> v .:? "eval_duration"++instance ToJSON ChatResponse where+  toJSON ChatResponse {..} =+    object+      [ "model" .= crModel+      , "created_at" .= crCreatedAt+      , "message" .= crMessage+      , "done" .= crDone+      , "done_reason" .= crDoneReason+      , "total_duration" .= crTotalDuration+      , "load_duration" .= crLoadDuration+      , "prompt_eval_count" .= crPromptEvalCount+      , "prompt_eval_duration" .= crPromptEvalDuration+      , "eval_count" .= crEvalCount+      , "eval_duration" .= crEvalDuration+      ]++instance HasDone ChatResponse where+  isDone = crDone++{- | Non-streaming chat completion API.++@since 1.0.0.0+-}+chat :: (MonadIO m) => OllamaClient -> ChatRequest -> m (Either OllamaError ChatResponse)+chat client req = request client "POST" "/api/chat" (Just req {chStream = Just False})++{- | Streaming chat completion API yielding 'ChatResponse' chunks.++@since 1.0.0.0+-}+chatStream :: (MonadUnliftIO m) => OllamaClient -> ChatRequest -> ConduitT () ChatResponse m ()+chatStream client req = requestStreaming client "/api/chat" (req {chStream = Just True})++{- | Calculate generation throughput (eval tokens \/ second) from a 'ChatResponse'.++@since 1.0.0.0+-}+chatEvalTokensPerSecond :: ChatResponse -> Maybe Double+chatEvalTokensPerSecond ChatResponse {..} =+  tokensPerSecond <$> crEvalCount <*> crEvalDuration++{- | Calculate prompt evaluation throughput (prompt tokens \/ second) from a 'ChatResponse'.++@since 1.0.0.0+-}+chatPromptEvalTokensPerSecond :: ChatResponse -> Maybe Double+chatPromptEvalTokensPerSecond ChatResponse {..} =+  tokensPerSecond <$> crPromptEvalCount <*> crPromptEvalDuration
+ src/Ollama/API/Embed.hs view
@@ -0,0 +1,175 @@+{- |+Module      : Ollama.API.Embed+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Vector embeddings API endpoint (@/api/embed@).++@since 1.0.0.0+-}+module Ollama.API.Embed (+  EmbedRequest (..),+  EmbedResponse (..),+  embedRequest,+  embed,++  -- * Deprecated Legacy API+  EmbeddingsRequest (..),+  EmbeddingsResponse (..),+  embeddings,+) where++import Control.Monad.IO.Class (MonadIO)+import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request)+import Ollama.Error (OllamaError)+import Ollama.Types.Common (Duration, ModelName)+import Ollama.Types.Options (ModelOptions)++{- | Embedding request payload for single text or batch list of texts.++@since 1.0.0.0+-}+data EmbedRequest = EmbedRequest+  { embModel :: !ModelName+  , embInput :: !(Either Text [Text])+  , embTruncate :: !(Maybe Bool)+  , embOptions :: !(Maybe ModelOptions)+  , embKeepAlive :: !(Maybe Text)+  , embDimensions :: !(Maybe Int)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON EmbedRequest where+  toJSON EmbedRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= embModel+        , Just $ case embInput of+            Left single -> "input" .= single+            Right multiple -> "input" .= multiple+        , ("truncate" .=) <$> embTruncate+        , ("options" .=) <$> embOptions+        , ("keep_alive" .=) <$> embKeepAlive+        , ("dimensions" .=) <$> embDimensions+        ]++{- | Create an 'EmbedRequest' for a list of input texts.++@since 1.0.0.0+-}+embedRequest :: ModelName -> [Text] -> EmbedRequest+embedRequest model inputs =+  EmbedRequest+    { embModel = model+    , embInput = Right inputs+    , embTruncate = Nothing+    , embOptions = Nothing+    , embKeepAlive = Nothing+    , embDimensions = Nothing+    }++{- | Embedding response payload containing vector embeddings.++@since 1.0.0.0+-}+data EmbedResponse = EmbedResponse+  { erModel :: !ModelName+  , erEmbeddings :: ![[Double]]+  , erTotalDuration :: !(Maybe Duration)+  , erLoadDuration :: !(Maybe Duration)+  , erPromptEvalCount :: !(Maybe Int)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON EmbedResponse where+  parseJSON = withObject "EmbedResponse" $ \v ->+    EmbedResponse+      <$> v .: "model"+      <*> v .: "embeddings"+      <*> v .:? "total_duration"+      <*> v .:? "load_duration"+      <*> v .:? "prompt_eval_count"++instance ToJSON EmbedResponse where+  toJSON EmbedResponse {..} =+    object+      [ "model" .= erModel+      , "embeddings" .= erEmbeddings+      , "total_duration" .= erTotalDuration+      , "load_duration" .= erLoadDuration+      , "prompt_eval_count" .= erPromptEvalCount+      ]++{- | Generate vector embeddings.++@since 1.0.0.0+-}+embed :: (MonadIO m) => OllamaClient -> EmbedRequest -> m (Either OllamaError EmbedResponse)+embed client req = request client "POST" "/api/embed" (Just req)++{- | Legacy request payload for deprecated @/api/embeddings@ endpoint.++@since 1.0.0.0+-}+data EmbeddingsRequest = EmbeddingsRequest+  { ebrModel :: !ModelName+  , ebrPrompt :: !Text+  , ebrOptions :: !(Maybe ModelOptions)+  , ebrKeepAlive :: !(Maybe Text)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON EmbeddingsRequest where+  toJSON EmbeddingsRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= ebrModel+        , Just $ "prompt" .= ebrPrompt+        , ("options" .=) <$> ebrOptions+        , ("keep_alive" .=) <$> ebrKeepAlive+        ]++instance FromJSON EmbeddingsRequest where+  parseJSON = withObject "EmbeddingsRequest" $ \v ->+    EmbeddingsRequest+      <$> v .: "model"+      <*> v .: "prompt"+      <*> v .:? "options"+      <*> v .:? "keep_alive"++{- | Legacy response payload for deprecated @/api/embeddings@ endpoint.++@since 1.0.0.0+-}+newtype EmbeddingsResponse = EmbeddingsResponse+  { ebrEmbedding :: [Double]+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON EmbeddingsResponse where+  parseJSON = withObject "EmbeddingsResponse" $ \v ->+    EmbeddingsResponse <$> v .: "embedding"++instance ToJSON EmbeddingsResponse where+  toJSON EmbeddingsResponse {..} =+    object ["embedding" .= ebrEmbedding]++{- | Generate vector embeddings using the deprecated @/api/embeddings@ endpoint.++@since 1.0.0.0+-}+embeddings ::+  (MonadIO m) =>+  OllamaClient ->+  EmbeddingsRequest ->+  m (Either OllamaError EmbeddingsResponse)+embeddings client req = request client "POST" "/api/embeddings" (Just req)+{-# DEPRECATED embeddings "Use embed instead" #-}
+ src/Ollama/API/Generate.hs view
@@ -0,0 +1,199 @@+{- |+Module      : Ollama.API.Generate+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Text completion API endpoint (@/api/generate@).++@since 1.0.0.0+-}+module Ollama.API.Generate (+  GenerateRequest (..),+  GenerateResponse (..),+  generateRequest,+  generate,+  generateStream,+  evalTokensPerSecond,+  promptEvalTokensPerSecond,+) where++import Conduit (ConduitT)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request, requestStreaming)+import Ollama.Error (OllamaError)+import Ollama.Streaming (HasDone (..))+import Ollama.Types.Common (Base64Image, Duration, ModelName, Think, tokensPerSecond)+import Ollama.Types.Format (Format)+import Ollama.Types.Options (ModelOptions)++{- | Request payload for text generation completion.++@since 1.0.0.0+-}+data GenerateRequest = GenerateRequest+  { genModel :: !ModelName+  , genPrompt :: !Text+  , genSuffix :: !(Maybe Text)+  , genImages :: !(Maybe [Base64Image])+  , genFormat :: !(Maybe Format)+  , genOptions :: !(Maybe ModelOptions)+  , genSystem :: !(Maybe Text)+  , genTemplate :: !(Maybe Text)+  , genStream :: !(Maybe Bool)+  , genRaw :: !(Maybe Bool)+  , genKeepAlive :: !(Maybe Text)+  , genThink :: !(Maybe Think)+  , genWidth :: !(Maybe Int)+  , genHeight :: !(Maybe Int)+  , genSteps :: !(Maybe Int)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON GenerateRequest where+  toJSON GenerateRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= genModel+        , Just $ "prompt" .= genPrompt+        , ("suffix" .=) <$> genSuffix+        , ("images" .=) <$> genImages+        , ("format" .=) <$> genFormat+        , ("options" .=) <$> genOptions+        , ("system" .=) <$> genSystem+        , ("template" .=) <$> genTemplate+        , ("stream" .=) <$> genStream+        , ("raw" .=) <$> genRaw+        , ("keep_alive" .=) <$> genKeepAlive+        , ("think" .=) <$> genThink+        , ("width" .=) <$> genWidth+        , ("height" .=) <$> genHeight+        , ("steps" .=) <$> genSteps+        ]++{- | Create a default 'GenerateRequest' for a model and prompt.++@since 1.0.0.0+-}+generateRequest :: ModelName -> Text -> GenerateRequest+generateRequest model prompt =+  GenerateRequest+    { genModel = model+    , genPrompt = prompt+    , genSuffix = Nothing+    , genImages = Nothing+    , genFormat = Nothing+    , genOptions = Nothing+    , genSystem = Nothing+    , genTemplate = Nothing+    , genStream = Just False+    , genRaw = Nothing+    , genKeepAlive = Nothing+    , genThink = Nothing+    , genWidth = Nothing+    , genHeight = Nothing+    , genSteps = Nothing+    }++{- | Response payload returned by text generation.++@since 1.0.0.0+-}+data GenerateResponse = GenerateResponse+  { grModel :: !ModelName+  , grCreatedAt :: !UTCTime+  , grResponse :: !Text+  , grDone :: !Bool+  , grDoneReason :: !(Maybe Text)+  , grContext :: !(Maybe [Int])+  , grTotalDuration :: !(Maybe Duration)+  , grLoadDuration :: !(Maybe Duration)+  , grPromptEvalCount :: !(Maybe Int)+  , grPromptEvalDuration :: !(Maybe Duration)+  , grEvalCount :: !(Maybe Int)+  , grEvalDuration :: !(Maybe Duration)+  , grThinking :: !(Maybe Text)+  , grImage :: !(Maybe Base64Image)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON GenerateResponse where+  parseJSON = withObject "GenerateResponse" $ \v ->+    GenerateResponse+      <$> v .: "model"+      <*> v .: "created_at"+      <*> v .: "response"+      <*> v .: "done"+      <*> v .:? "done_reason"+      <*> v .:? "context"+      <*> v .:? "total_duration"+      <*> v .:? "load_duration"+      <*> v .:? "prompt_eval_count"+      <*> v .:? "prompt_eval_duration"+      <*> v .:? "eval_count"+      <*> v .:? "eval_duration"+      <*> v .:? "thinking"+      <*> v .:? "image"++instance ToJSON GenerateResponse where+  toJSON GenerateResponse {..} =+    object+      [ "model" .= grModel+      , "created_at" .= grCreatedAt+      , "response" .= grResponse+      , "done" .= grDone+      , "done_reason" .= grDoneReason+      , "context" .= grContext+      , "total_duration" .= grTotalDuration+      , "load_duration" .= grLoadDuration+      , "prompt_eval_count" .= grPromptEvalCount+      , "prompt_eval_duration" .= grPromptEvalDuration+      , "eval_count" .= grEvalCount+      , "eval_duration" .= grEvalDuration+      , "thinking" .= grThinking+      , "image" .= grImage+      ]++instance HasDone GenerateResponse where+  isDone = grDone++{- | Non-streaming text completion API.++@since 1.0.0.0+-}+generate ::+  (MonadIO m) => OllamaClient -> GenerateRequest -> m (Either OllamaError GenerateResponse)+generate client req = request client "POST" "/api/generate" (Just req {genStream = Just False})++{- | Streaming text completion API yielding 'GenerateResponse' chunks.++@since 1.0.0.0+-}+generateStream ::+  (MonadUnliftIO m) => OllamaClient -> GenerateRequest -> ConduitT () GenerateResponse m ()+generateStream client req = requestStreaming client "/api/generate" (req {genStream = Just True})++{- | Calculate generation throughput (eval tokens \/ second) from a 'GenerateResponse'.++@since 1.0.0.0+-}+evalTokensPerSecond :: GenerateResponse -> Maybe Double+evalTokensPerSecond GenerateResponse {..} =+  tokensPerSecond <$> grEvalCount <*> grEvalDuration++{- | Calculate prompt evaluation throughput (prompt tokens \/ second) from a 'GenerateResponse'.++@since 1.0.0.0+-}+promptEvalTokensPerSecond :: GenerateResponse -> Maybe Double+promptEvalTokensPerSecond GenerateResponse {..} =+  tokensPerSecond <$> grPromptEvalCount <*> grPromptEvalDuration
+ src/Ollama/API/Models.hs view
@@ -0,0 +1,171 @@+{- |+Module      : Ollama.API.Models+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model management endpoints (list, show, copy, delete).++@since 1.0.0.0+-}+module Ollama.API.Models (+  -- * Listing+  listModels,+  ListResponse (..),++  -- * Show Info+  showModel,+  ShowRequest (..),+  ShowResponse (..),+  ShowModelInfo (..),++  -- * Copy+  copyModel,+  CopyRequest (..),++  -- * Delete+  deleteModel,+  DeleteRequest (..),+) where++import Control.Monad.IO.Class (MonadIO)+import Data.Aeson+import Data.Map.Strict (Map)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request)+import Ollama.Error (OllamaError)+import Ollama.Types.Common (ModelName)+import Ollama.Types.Model (ListResponse (..), ModelDetails (..))++{- | Show model info request payload.++@since 1.0.0.0+-}+data ShowRequest = ShowRequest+  { srqModel :: !ModelName+  , srqVerbose :: !(Maybe Bool)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ShowRequest where+  toJSON ShowRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= srqModel+        , ("verbose" .=) <$> srqVerbose+        ]++{- | Detailed technical parameters from model metadata.++@since 1.0.0.0+-}+newtype ShowModelInfo = ShowModelInfo+  { modelInfoMap :: Map Text Value+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON ShowModelInfo where+  parseJSON v = ShowModelInfo <$> parseJSON v++instance ToJSON ShowModelInfo where+  toJSON (ShowModelInfo m) = toJSON m++{- | Model inspection response payload.++@since 1.0.0.0+-}+data ShowResponse = ShowResponse+  { srsModelfile :: !Text+  , srsParameters :: !(Maybe Text)+  , srsTemplate :: !(Maybe Text)+  , srsDetails :: !ModelDetails+  , srsModelInfo :: !(Maybe ShowModelInfo)+  , srsLicense :: !(Maybe Text)+  , srsCapabilities :: !(Maybe [Text])+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON ShowResponse where+  parseJSON = withObject "ShowResponse" $ \v ->+    ShowResponse+      <$> v .:? "modelfile" .!= ""+      <*> v .:? "parameters"+      <*> v .:? "template"+      <*> v .:? "details" .!= ModelDetails Nothing "" "" [] "" ""+      <*> v .:? "model_info"+      <*> v .:? "license"+      <*> v .:? "capabilities"++instance ToJSON ShowResponse where+  toJSON ShowResponse {..} =+    object+      [ "modelfile" .= srsModelfile+      , "parameters" .= srsParameters+      , "template" .= srsTemplate+      , "details" .= srsDetails+      , "model_info" .= srsModelInfo+      , "license" .= srsLicense+      , "capabilities" .= srsCapabilities+      ]++{- | Copy model request payload.++@since 1.0.0.0+-}+data CopyRequest = CopyRequest+  { cpSource :: !ModelName+  , cpDestination :: !ModelName+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON CopyRequest where+  toJSON CopyRequest {..} =+    object+      [ "source" .= cpSource+      , "destination" .= cpDestination+      ]++{- | Delete model request payload.++@since 1.0.0.0+-}+newtype DeleteRequest = DeleteRequest+  { delModel :: ModelName+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON DeleteRequest where+  toJSON DeleteRequest {..} = object ["model" .= delModel]++{- | List installed local models (@GET /api/tags@).++@since 1.0.0.0+-}+listModels :: (MonadIO m) => OllamaClient -> m (Either OllamaError ListResponse)+listModels client = request client "GET" "/api/tags" (Nothing :: Maybe Value)++{- | Fetch information and Modelfile content for a model (@POST /api/show@).++@since 1.0.0.0+-}+showModel :: (MonadIO m) => OllamaClient -> ModelName -> m (Either OllamaError ShowResponse)+showModel client model = request client "POST" "/api/show" (Just $ ShowRequest model Nothing)++{- | Duplicate an existing model under a new tag (@POST /api/copy@).++@since 1.0.0.0+-}+copyModel :: (MonadIO m) => OllamaClient -> ModelName -> ModelName -> m (Either OllamaError ())+copyModel client src dst = request client "POST" "/api/copy" (Just $ CopyRequest src dst)++{- | Delete a local model (@DELETE /api/delete@).++@since 1.0.0.0+-}+deleteModel :: (MonadIO m) => OllamaClient -> ModelName -> m (Either OllamaError ())+deleteModel client model = request client "DELETE" "/api/delete" (Just $ DeleteRequest model)
+ src/Ollama/API/Models/Create.hs view
@@ -0,0 +1,165 @@+{- |+Module      : Ollama.API.Models.Create+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model creation endpoint (@/api/create@).++@since 1.0.0.0+-}+module Ollama.API.Models.Create (+  CreateRequest (..),+  CreateResponse (..),+  QuantizationType (..),+  createModel,+  createModelStream,+  defaultCreateRequest,+) where++import Conduit (ConduitT)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Aeson+import Data.Int (Int64)+import Data.Map.Strict (Map)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request, requestStreaming)+import Ollama.Error (OllamaError)+import Ollama.Streaming (HasDone (..))+import Ollama.Types.Common (Digest, ModelName)+import Ollama.Types.Message (Message)+import Ollama.Types.Options (ModelOptions)++{- | Quantization precision options for model creation.++@since 1.0.0.0+-}+data QuantizationType = Q4_K_M | Q4_K_S | Q8_0+  deriving stock (Eq, Show, Bounded, Enum, 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" $ \case+    "q4_K_M" -> pure Q4_K_M+    "q4_K_S" -> pure Q4_K_S+    "q8_0" -> pure Q8_0+    other -> fail $ "Invalid QuantizationType: " <> show other++{- | Model creation request configuration payload.++@since 1.0.0.0+-}+data CreateRequest = CreateRequest+  { crqModel :: !ModelName+  , crqFrom :: !(Maybe ModelName)+  , crqFiles :: !(Maybe (Map Text Digest))+  , crqAdapters :: !(Maybe (Map Text Digest))+  , crqTemplate :: !(Maybe Text)+  , crqRenderer :: !(Maybe Text)+  , crqParser :: !(Maybe Text)+  , crqLicense :: !(Maybe [Text])+  , crqSystem :: !(Maybe Text)+  , crqParameters :: !(Maybe ModelOptions)+  , crqMessages :: !(Maybe [Message])+  , crqStream :: !(Maybe Bool)+  , crqQuantize :: !(Maybe QuantizationType)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON CreateRequest where+  toJSON CreateRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= crqModel+        , ("from" .=) <$> crqFrom+        , ("files" .=) <$> crqFiles+        , ("adapters" .=) <$> crqAdapters+        , ("template" .=) <$> crqTemplate+        , ("renderer" .=) <$> crqRenderer+        , ("parser" .=) <$> crqParser+        , ("license" .=) <$> crqLicense+        , ("system" .=) <$> crqSystem+        , ("parameters" .=) <$> crqParameters+        , ("messages" .=) <$> crqMessages+        , ("stream" .=) <$> crqStream+        , ("quantize" .=) <$> crqQuantize+        ]++{- | Smart constructor for a basic 'CreateRequest'.++@since 1.0.0.0+-}+defaultCreateRequest :: ModelName -> CreateRequest+defaultCreateRequest name =+  CreateRequest+    { crqModel = name+    , crqFrom = Nothing+    , crqFiles = Nothing+    , crqAdapters = Nothing+    , crqTemplate = Nothing+    , crqRenderer = Nothing+    , crqParser = Nothing+    , crqLicense = Nothing+    , crqSystem = Nothing+    , crqParameters = Nothing+    , crqMessages = Nothing+    , crqStream = Just False+    , crqQuantize = Nothing+    }++{- | Progress / status response during model creation.++@since 1.0.0.0+-}+data CreateResponse = CreateResponse+  { crsStatus :: !Text+  , crsDigest :: !(Maybe Digest)+  , crsTotal :: !(Maybe Int64)+  , crsCompleted :: !(Maybe Int64)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON CreateResponse where+  parseJSON = withObject "CreateResponse" $ \v ->+    CreateResponse+      <$> v .: "status"+      <*> v .:? "digest"+      <*> v .:? "total"+      <*> v .:? "completed"++instance ToJSON CreateResponse where+  toJSON CreateResponse {..} =+    object+      [ "status" .= crsStatus+      , "digest" .= crsDigest+      , "total" .= crsTotal+      , "completed" .= crsCompleted+      ]++instance HasDone CreateResponse where+  isDone CreateResponse {..} = crsStatus == "success"++{- | Create a model non-streaming.++@since 1.0.0.0+-}+createModel :: (MonadIO m) => OllamaClient -> CreateRequest -> m (Either OllamaError CreateResponse)+createModel client req = request client "POST" "/api/create" (Just req {crqStream = Just False})++{- | Create a model streaming progress updates.++@since 1.0.0.0+-}+createModelStream ::+  (MonadUnliftIO m) => OllamaClient -> CreateRequest -> ConduitT () CreateResponse m ()+createModelStream client req = requestStreaming client "/api/create" (req {crqStream = Just True})
+ src/Ollama/API/Models/Pull.hs view
@@ -0,0 +1,100 @@+{- |+Module      : Ollama.API.Models.Pull+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model pull endpoint (@/api/pull@).++@since 1.0.0.0+-}+module Ollama.API.Models.Pull (+  PullRequest (..),+  PullResponse (..),+  pull,+  pullStream,+) where++import Conduit (ConduitT)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Aeson+import Data.Int (Int64)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request, requestStreaming)+import Ollama.Error (OllamaError)+import Ollama.Streaming (HasDone (..))+import Ollama.Types.Common (Digest, ModelName)++{- | Pull model request configuration payload.++@since 1.0.0.0+-}+data PullRequest = PullRequest+  { prqModel :: !ModelName+  , prqInsecure :: !(Maybe Bool)+  , prqStream :: !(Maybe Bool)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON PullRequest where+  toJSON PullRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= prqModel+        , ("insecure" .=) <$> prqInsecure+        , ("stream" .=) <$> prqStream+        ]++{- | Pull progress/status response payload.++@since 1.0.0.0+-}+data PullResponse = PullResponse+  { prStatus :: !Text+  , prDigest :: !(Maybe Digest)+  , prTotal :: !(Maybe Int64)+  , prCompleted :: !(Maybe Int64)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON PullResponse where+  parseJSON = withObject "PullResponse" $ \v ->+    PullResponse+      <$> v .: "status"+      <*> v .:? "digest"+      <*> v .:? "total"+      <*> v .:? "completed"++instance ToJSON PullResponse where+  toJSON PullResponse {..} =+    object+      [ "status" .= prStatus+      , "digest" .= prDigest+      , "total" .= prTotal+      , "completed" .= prCompleted+      ]++instance HasDone PullResponse where+  isDone PullResponse {..} = prStatus == "success"++{- | Download / pull a model (non-streaming, blocks until complete).++@since 1.0.0.0+-}+pull :: (MonadIO m) => OllamaClient -> ModelName -> m (Either OllamaError PullResponse)+pull client model =+  request client "POST" "/api/pull" (Just $ PullRequest model Nothing (Just False))++{- | Download / pull a model streaming progress updates.++@since 1.0.0.0+-}+pullStream :: (MonadUnliftIO m) => OllamaClient -> ModelName -> ConduitT () PullResponse m ()+pullStream client model =+  requestStreaming client "/api/pull" (PullRequest model Nothing (Just True))
+ src/Ollama/API/Models/Push.hs view
@@ -0,0 +1,100 @@+{- |+Module      : Ollama.API.Models.Push+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model push endpoint (@/api/push@).++@since 1.0.0.0+-}+module Ollama.API.Models.Push (+  PushRequest (..),+  PushResponse (..),+  push,+  pushStream,+) where++import Conduit (ConduitT)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Aeson+import Data.Int (Int64)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request, requestStreaming)+import Ollama.Error (OllamaError)+import Ollama.Streaming (HasDone (..))+import Ollama.Types.Common (Digest, ModelName)++{- | Push model request payload.++@since 1.0.0.0+-}+data PushRequest = PushRequest+  { psqModel :: !ModelName+  , psqInsecure :: !(Maybe Bool)+  , psqStream :: !(Maybe Bool)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON PushRequest where+  toJSON PushRequest {..} =+    object $+      catMaybes+        [ Just $ "model" .= psqModel+        , ("insecure" .=) <$> psqInsecure+        , ("stream" .=) <$> psqStream+        ]++{- | Push progress response payload.++@since 1.0.0.0+-}+data PushResponse = PushResponse+  { psStatus :: !Text+  , psDigest :: !(Maybe Digest)+  , psTotal :: !(Maybe Int64)+  , psCompleted :: !(Maybe Int64)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON PushResponse where+  parseJSON = withObject "PushResponse" $ \v ->+    PushResponse+      <$> v .: "status"+      <*> v .:? "digest"+      <*> v .:? "total"+      <*> v .:? "completed"++instance ToJSON PushResponse where+  toJSON PushResponse {..} =+    object+      [ "status" .= psStatus+      , "digest" .= psDigest+      , "total" .= psTotal+      , "completed" .= psCompleted+      ]++instance HasDone PushResponse where+  isDone PushResponse {..} = psStatus == "success"++{- | Push a model to a remote library (non-streaming).++@since 1.0.0.0+-}+push :: (MonadIO m) => OllamaClient -> ModelName -> m (Either OllamaError PushResponse)+push client model =+  request client "POST" "/api/push" (Just $ PushRequest model Nothing (Just False))++{- | Push a model streaming upload progress updates.++@since 1.0.0.0+-}+pushStream :: (MonadUnliftIO m) => OllamaClient -> ModelName -> ConduitT () PushResponse m ()+pushStream client model =+  requestStreaming client "/api/push" (PushRequest model Nothing (Just True))
+ src/Ollama/API/Ps.hs view
@@ -0,0 +1,31 @@+{- |+Module      : Ollama.API.Ps+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Running models endpoint (@/api/ps@).++@since 1.0.0.0+-}+module Ollama.API.Ps (+  listRunning,+  RunningModelsResponse (..),+  RunningModel (..),+) where++import Control.Monad.IO.Class (MonadIO)+import Data.Aeson (Value)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request)+import Ollama.Error (OllamaError)+import Ollama.Types.Model (RunningModel (..), RunningModelsResponse (..))++{- | List models currently loaded into memory (@GET /api/ps@).++@since 1.0.0.0+-}+listRunning :: (MonadIO m) => OllamaClient -> m (Either OllamaError RunningModelsResponse)+listRunning client = request client "GET" "/api/ps" (Nothing :: Maybe Value)
+ src/Ollama/API/Version.hs view
@@ -0,0 +1,30 @@+{- |+Module      : Ollama.API.Version+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Version endpoint (@/api/version@).++@since 1.0.0.0+-}+module Ollama.API.Version (+  getVersion,+  Version (..),+) where++import Control.Monad.IO.Class (MonadIO)+import Data.Aeson (Value)+import Ollama.Client (OllamaClient)+import Ollama.Client.Internal (request)+import Ollama.Error (OllamaError)+import Ollama.Types.Common (Version (..))++{- | Retrieve Ollama server engine version (@GET /api/version@).++@since 1.0.0.0+-}+getVersion :: (MonadIO m) => OllamaClient -> m (Either OllamaError Version)+getVersion client = request client "GET" "/api/version" (Nothing :: Maybe Value)
+ src/Ollama/Client.hs view
@@ -0,0 +1,110 @@+{- |+Module      : Ollama.Client+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Opaque client management and construction functions.++@since 1.0.0.0+-}+module Ollama.Client (+  OllamaClient (..),+  newClient,+  defaultClient,+  clientFromEnv,+  closeClient,+  withClient,+) where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)+import Data.Text (Text)+import Data.Text qualified as T+import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Ollama.Client.Config (OllamaClientConfig (..), defaultConfig)+import System.Environment (lookupEnv)++{- | Opaque client handle for dispatching API calls.++@since 1.0.0.0+-}+data OllamaClient = OllamaClient+  { clientManager :: !Manager+  , clientConfig :: !OllamaClientConfig+  , clientOwned :: !Bool+  }++{- | Construct a client with custom configuration settings.++@since 1.0.0.0+-}+newClient :: (MonadIO m) => OllamaClientConfig -> m OllamaClient+newClient cfg = liftIO $ do+  case configManager cfg of+    Just mgr -> pure $ OllamaClient mgr cfg False+    Nothing -> do+      mgr <- newManager tlsManagerSettings+      pure $ OllamaClient mgr cfg True++{- | Construct a client with default settings (@http://127.0.0.1:11434@).++@since 1.0.0.0+-}+defaultClient :: (MonadIO m) => m OllamaClient+defaultClient = newClient defaultConfig++{- | Construct a client resolving host and credentials from environment variables+(@OLLAMA_HOST@, @OLLAMA_API_KEY@).++Parses @OLLAMA_HOST@ robustly, handling these formats:++  * @host:port@        → @http:\/\/host:port@+  * @http:\/\/host:port@ → used as-is+  * @host@             → @http:\/\/host:11434@++@since 1.0.0.0+-}+clientFromEnv :: (MonadIO m) => m OllamaClient+clientFromEnv = liftIO $ do+  mbHost <- lookupEnv "OLLAMA_HOST"+  mbKey <- lookupEnv "OLLAMA_API_KEY"+  let hostText = maybe "http://127.0.0.1:11434" (normalizeHost . T.pack) mbHost+      keyText = T.pack <$> mbKey+      cfg = defaultConfig {configBaseUrl = hostText, configApiKey = keyText}+  newClient cfg++{- | Normalize an @OLLAMA_HOST@ value to a full URL with scheme.++Handles: bare @host:port@, @http(s):\/\/host:port@, and bare @host@.++@since 1.0.0.0+-}+normalizeHost :: Text -> Text+normalizeHost raw+  | "http://" `T.isPrefixOf` raw || "https://" `T.isPrefixOf` raw = T.dropWhileEnd (== '/') raw+  | ":" `T.isInfixOf` raw = "http://" <> T.dropWhileEnd (== '/') raw+  | otherwise = "http://" <> T.dropWhileEnd (== '/') raw <> ":11434"++{- | Close the underlying HTTP connection manager if owned by this client.++Note: Connection managers in @http-client@ are automatically reclaimed by garbage collection.++@since 1.0.0.0+-}+closeClient :: (MonadIO m) => OllamaClient -> m ()+closeClient _ = pure ()++{- | Resource bracket helper to initialize, run a computation, and close client resources.++@since 1.0.0.0+-}+withClient :: (MonadUnliftIO m) => OllamaClientConfig -> (OllamaClient -> m a) -> m a+withClient cfg action = withRunInIO $ \run -> do+  client <- newClient cfg+  res <- run (action client)+  closeClient client+  pure res
+ src/Ollama/Client/Config.hs view
@@ -0,0 +1,103 @@+{- |+Module      : Ollama.Client.Config+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Client configuration settings, retry policies, and logging thresholds.++@since 0.3.0.0+-}+module Ollama.Client.Config (+  OllamaClientConfig (..),+  defaultConfig,+  RetryPolicy (..),+  noRetry,+  constantRetry,+  exponentialRetry,+  LogLevel (..),+) where++import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI)+import Data.Text (Text)+import Network.HTTP.Client (Manager)++{- | Logging levels for structured client events.++@since 0.3.0.0+-}+data LogLevel = Debug | Info | Warn | Error+  deriving stock (Eq, Ord, Show, Bounded, Enum)++{- | Configurable retry strategy for recoverable network errors.++@since 0.3.0.0+-}+data RetryPolicy+  = -- | Disable all retries+    NoRetry+  | -- | Retry up to @count@ times with fixed @delayMicros@ interval+    ConstantRetry !Int !Int+  | -- | Retry up to @count@ times with exponential backoff starting at @baseDelayMicros@+    ExponentialRetry !Int !Int+  deriving stock (Eq, Show)++{- | Helper constructor for 'NoRetry'.++@since 0.3.0.0+-}+noRetry :: RetryPolicy+noRetry = NoRetry++{- | Helper constructor for 'ConstantRetry'.++@since 0.3.0.0+-}+constantRetry :: Int -> Int -> RetryPolicy+constantRetry = ConstantRetry++{- | Helper constructor for 'ExponentialRetry'.++@since 0.3.0.0+-}+exponentialRetry :: Int -> Int -> RetryPolicy+exponentialRetry = ExponentialRetry++{- | Configuration settings for an 'Ollama.Client.OllamaClient'.++@since 0.3.0.0+-}+data OllamaClientConfig = OllamaClientConfig+  { configBaseUrl :: !Text+  , configTimeout :: !Int+  , configRetry :: !RetryPolicy+  , configManager :: !(Maybe Manager)+  , configHeaders :: ![(CI ByteString, ByteString)]+  , configApiKey :: !(Maybe Text)+  , configLogger :: !(Maybe (LogLevel -> Text -> IO ()))+  , configOnStart :: !(Maybe (IO ()))+  , configOnSuccess :: !(Maybe (IO ()))+  , configOnError :: !(Maybe (IO ()))+  }++{- | Default configuration connecting to @http://127.0.0.1:11434@ with 300s timeout and 'NoRetry'.++@since 0.3.0.0+-}+defaultConfig :: OllamaClientConfig+defaultConfig =+  OllamaClientConfig+    { configBaseUrl = "http://127.0.0.1:11434"+    , configTimeout = 300+    , configRetry = NoRetry+    , configManager = Nothing+    , configHeaders = []+    , configApiKey = Nothing+    , configLogger = Nothing+    , configOnStart = Nothing+    , configOnSuccess = Nothing+    , configOnError = Nothing+    }
+ src/Ollama/Client/Internal.hs view
@@ -0,0 +1,276 @@+{- |+Module      : Ollama.Client.Internal+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Low-level HTTP transport plumbing and request dispatchers.++Implements retry logic, lifecycle callbacks, structured logging,+authentication header injection, and conduit-based response streaming.++@since 1.0.0.0+-}+module Ollama.Client.Internal (+  request,+  requestRaw,+  requestStreaming,+) where++import Conduit (+  ConduitT,+  awaitForever,+  bracketP,+  filterC,+  takeWhileC,+  transPipe,+  yield,+  (.|),+ )+import Control.Exception (SomeException, catch, try)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Control.Monad.Trans.Resource (runResourceT)+import Control.Retry qualified as Retry+import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BSL+import Data.CaseInsensitive (CI)+import Data.Conduit.Binary qualified as CB+import Data.Conduit.Combinators (repeatM)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Network.HTTP.Client+import Network.HTTP.Types (statusCode)+import Ollama.Client (OllamaClient (..))+import Ollama.Client.Config (LogLevel (..), OllamaClientConfig (..), RetryPolicy (..))+import Ollama.Error (OllamaError (..), isRetryable)++-- ---------------------------------------------------------------------------+-- Public API+-- ---------------------------------------------------------------------------++{- | Dispatch a non-streaming JSON API request.++Applies authentication headers, retry policy, lifecycle callbacks,+and structured logging as configured on the client.++@since 1.0.0.0+-}+request ::+  (MonadIO m, ToJSON req, FromJSON resp) =>+  OllamaClient ->+  ByteString ->+  Text ->+  Maybe req ->+  m (Either OllamaError resp)+request client reqMethod endpoint mbPayload =+  liftIO $+    withRetry client endpoint $+      executeJsonRequest client reqMethod endpoint mbPayload++{- | Dispatch a raw (non-JSON) request returning raw bytes.++Used for blob endpoints where the response body is not JSON.+Applies authentication headers, retry policy, lifecycle callbacks,+and structured logging.++@since 1.0.0.0+-}+requestRaw ::+  (MonadIO m) =>+  OllamaClient ->+  ByteString ->+  Text ->+  Maybe ByteString ->+  m (Either OllamaError ByteString)+requestRaw client reqMethod endpoint mbPayload =+  liftIO $+    withRetry client endpoint $+      executeRawRequest client reqMethod endpoint mbPayload++{- | Dispatch a conduit-based streaming API request.++Opens an HTTP response stream, reads line-delimited JSON chunks as they arrive,+decodes each chunk, and yields values into a 'ConduitT'. Stops when the server+closes the connection.++@since 1.0.0.0+-}+requestStreaming ::+  (MonadUnliftIO m, ToJSON req, FromJSON resp) =>+  OllamaClient ->+  Text ->+  req ->+  ConduitT () resp m ()+requestStreaming OllamaClient {..} endpoint payload = do+  let fullUrl = T.unpack $ configBaseUrl clientConfig <> endpoint+      cfg = clientConfig+  initReq <- liftIO $ parseRequest fullUrl+  let req =+        initReq+          { method = "POST"+          , responseTimeout = responseTimeoutNone+          , requestHeaders =+              [ ("Content-Type", "application/json")+              , ("Accept", "application/x-ndjson, application/json")+              , ("Connection", "keep-alive")+              ]+                ++ authHeader cfg+                ++ configHeaders cfg+          , requestBody = RequestBodyLBS (encode payload)+          }+  transPipe runResourceT $+    bracketP+      (responseOpen req clientManager)+      responseClose+      ( \resp -> do+          let bodyReader = responseBody resp+              readChunk = liftIO $ brRead bodyReader `catch` \(_ :: HttpException) -> pure BS.empty+              source = repeatM readChunk .| takeWhileC (not . BS.null)+          source .| CB.lines .| filterC (not . BS.null) .| parseAndYield+      )+  where+    parseAndYield = awaitForever $ \line -> do+      case eitherDecode (BSL.fromStrict line) of+        Left _err -> pure ()+        Right val -> yield val++-- ---------------------------------------------------------------------------+-- Core request execution+-- ---------------------------------------------------------------------------++-- | Execute a JSON request without retry wrapping.+executeJsonRequest ::+  (ToJSON req, FromJSON resp) =>+  OllamaClient ->+  ByteString ->+  Text ->+  Maybe req ->+  IO (Either OllamaError resp)+executeJsonRequest OllamaClient {..} reqMethod endpoint mbPayload = do+  let fullUrl = T.unpack $ configBaseUrl clientConfig <> endpoint+      cfg = clientConfig+  initReq <- parseRequest fullUrl+  let timeoutMicro = configTimeout cfg * 1000000+      req =+        initReq+          { method = reqMethod+          , responseTimeout = responseTimeoutMicro timeoutMicro+          , requestHeaders =+              [("Content-Type", "application/json"), ("Accept", "application/json")]+                ++ authHeader cfg+                ++ configHeaders cfg+          , requestBody = maybe mempty (RequestBodyLBS . encode) mbPayload+          }+  result <- try @HttpException $ httpLbs req clientManager+  case result of+    Left httpErr -> pure $ Left $ HttpError httpErr+    Right resp -> do+      let status = statusCode (responseStatus resp)+          body = responseBody resp+      if status >= 200 && status < 300+        then+          if BSL.null body+            then case eitherDecode "null" of+              Left err -> pure $ Left $ DecodeError (T.pack err) (BSL.toStrict body)+              Right val -> pure $ Right val+            else case eitherDecode body of+              Left err -> pure $ Left $ DecodeError (T.pack err) (BSL.toStrict body)+              Right val -> pure $ Right val+        else pure $ Left $ ApiError status (TE.decodeUtf8 . BSL.toStrict $ body)++-- | Execute a raw byte request without retry wrapping.+executeRawRequest ::+  OllamaClient ->+  ByteString ->+  Text ->+  Maybe ByteString ->+  IO (Either OllamaError ByteString)+executeRawRequest OllamaClient {..} reqMethod endpoint mbPayload = do+  let fullUrl = T.unpack $ configBaseUrl clientConfig <> endpoint+      cfg = clientConfig+  initReq <- parseRequest fullUrl+  let timeoutMicro = configTimeout cfg * 1000000+      req =+        initReq+          { method = reqMethod+          , responseTimeout = responseTimeoutMicro timeoutMicro+          , requestHeaders = authHeader cfg ++ configHeaders cfg+          , requestBody = maybe mempty RequestBodyBS mbPayload+          }+  result <- try @HttpException $ httpLbs req clientManager+  case result of+    Left httpErr -> pure $ Left $ HttpError httpErr+    Right resp -> do+      let status = statusCode (responseStatus resp)+      if status >= 200 && status < 300+        then pure $ Right (BSL.toStrict $ responseBody resp)+        else pure $ Left $ ApiError status (TE.decodeUtf8 . BSL.toStrict $ body)+      where+        body = responseBody resp++-- ---------------------------------------------------------------------------+-- Retry logic+-- ---------------------------------------------------------------------------++{- | Wrap an IO action with the client's configured retry policy, lifecycle+callbacks, and structured logging.++Only retries when 'isRetryable' returns 'True' for the error.+-}+withRetry ::+  OllamaClient ->+  Text ->+  IO (Either OllamaError a) ->+  IO (Either OllamaError a)+withRetry OllamaClient {clientConfig = cfg} endpoint action = do+  let policy = toRetryPolicy (configRetry cfg)+      shouldRetry _status (Left err) = do+        logMsg cfg Warn $ "Retryable error on " <> endpoint <> ", will retry: " <> T.pack (show err)+        pure $ isRetryable err+      shouldRetry _status (Right _) = pure False+  fireCallback (configOnStart cfg)+  logMsg cfg Debug $ "Requesting " <> endpoint+  result <- Retry.retrying policy shouldRetry (const action)+  case result of+    Left err -> do+      fireCallback (configOnError cfg)+      logMsg cfg Error $ "Request failed: " <> endpoint <> " — " <> T.pack (show err)+    Right _ -> do+      fireCallback (configOnSuccess cfg)+      logMsg cfg Info $ "Request succeeded: " <> endpoint+  pure result++-- | Map our 'RetryPolicy' ADT to the @retry@ package's 'Retry.RetryPolicyM'.+toRetryPolicy :: RetryPolicy -> Retry.RetryPolicyM IO+toRetryPolicy NoRetry = Retry.limitRetries 0+toRetryPolicy (ConstantRetry count delaySec) =+  Retry.constantDelay (delaySec * 1000000) <> Retry.limitRetries count+toRetryPolicy (ExponentialRetry count initialDelayMs) =+  Retry.exponentialBackoff (initialDelayMs * 1000) <> Retry.limitRetries count++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++-- | Build the Authorization header if an API key is configured.+authHeader :: OllamaClientConfig -> [(CI ByteString, ByteString)]+authHeader cfg = case configApiKey cfg of+  Nothing -> []+  Just key -> [("Authorization", "Bearer " <> TE.encodeUtf8 key)]++-- | Fire an optional callback, silently ignoring exceptions.+fireCallback :: Maybe (IO ()) -> IO ()+fireCallback Nothing = pure ()+fireCallback (Just cb) = cb `catch` \(_ :: SomeException) -> pure ()++-- | Log a message via the configured logger, if present.+logMsg :: OllamaClientConfig -> LogLevel -> Text -> IO ()+logMsg cfg level msg = case configLogger cfg of+  Nothing -> pure ()+  Just logger -> logger level msg `catch` \(_ :: SomeException) -> pure ()
+ src/Ollama/Conversation.hs view
@@ -0,0 +1,110 @@+{- |+Module      : Ollama.Conversation+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Conversation store typeclass and in-memory transactional implementation.++@since 1.0.0.0+-}+module Ollama.Conversation (+  Conversation (..),+  ConversationStore (..),+  InMemoryStore (..),+  initInMemoryStore,+  saveConversationInMemory,+  loadConversationInMemory,+  listConversationsInMemory,+  deleteConversationInMemory,+) where++import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (ReaderT, ask)+import Data.Aeson (FromJSON, ToJSON)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Ollama.Types.Common (ModelName)+import Ollama.Types.Message (Message)++{- | Recorded chat conversation session.++@since 1.0.0.0+-}+data Conversation = Conversation+  { conversationId :: !Text+  , messages :: ![Message]+  , model :: !ModelName+  , createdAt :: !UTCTime+  , lastUpdated :: !UTCTime+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++{- | Abstract interface for persisting and managing chat conversations.++@since 1.0.0.0+-}+class (Monad m) => ConversationStore m where+  saveConversation :: Conversation -> m ()+  loadConversation :: Text -> m (Maybe Conversation)+  listConversations :: m [Conversation]+  deleteConversation :: Text -> m Bool++{- | Thread-safe transactional in-memory conversation store.++@since 1.0.0.0+-}+newtype InMemoryStore = InMemoryStore (TVar (Map Text Conversation))++{- | Initialize a new empty 'InMemoryStore'.++@since 1.0.0.0+-}+initInMemoryStore :: IO InMemoryStore+initInMemoryStore = InMemoryStore <$> newTVarIO Map.empty++{- | Save a conversation into an 'InMemoryStore'.++@since 1.0.0.0+-}+saveConversationInMemory :: (MonadIO m) => InMemoryStore -> Conversation -> m ()+saveConversationInMemory (InMemoryStore ref) conv = liftIO $ atomically $ do+  modifyTVar' ref (Map.insert (conversationId conv) conv)++{- | Load a conversation by ID from an 'InMemoryStore'.++@since 1.0.0.0+-}+loadConversationInMemory :: (MonadIO m) => InMemoryStore -> Text -> m (Maybe Conversation)+loadConversationInMemory (InMemoryStore ref) cid = liftIO $ Map.lookup cid <$> readTVarIO ref++{- | List all stored conversations from an 'InMemoryStore'.++@since 1.0.0.0+-}+listConversationsInMemory :: (MonadIO m) => InMemoryStore -> m [Conversation]+listConversationsInMemory (InMemoryStore ref) = liftIO $ Map.elems <$> readTVarIO ref++{- | Delete a conversation by ID from an 'InMemoryStore'.++@since 1.0.0.0+-}+deleteConversationInMemory :: (MonadIO m) => InMemoryStore -> Text -> m Bool+deleteConversationInMemory (InMemoryStore ref) cid = liftIO $ atomically $ do+  m <- readTVar ref+  if Map.member cid m+    then modifyTVar' ref (Map.delete cid) >> pure True+    else pure False++instance (MonadIO m) => ConversationStore (ReaderT InMemoryStore m) where+  saveConversation conv = ask >>= \store -> saveConversationInMemory store conv+  loadConversation cid = ask >>= \store -> loadConversationInMemory store cid+  listConversations = ask >>= \store -> listConversationsInMemory store+  deleteConversation cid = ask >>= \store -> deleteConversationInMemory store cid
+ src/Ollama/Error.hs view
@@ -0,0 +1,66 @@+{- |+Module      : Ollama.Error+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Core error type definitions for the Ollama library.++@since 3.0.0.0+-}+module Ollama.Error (+  OllamaError (..),+  isRetryable,+  throwOllama,+) where++import Control.Exception (Exception, throwIO)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Network.HTTP.Client (HttpException)++{- | Unified error type representing all failure modes in the Ollama client.++@since 3.0.0.0+-}+data OllamaError+  = -- | HTTP transport failure (connection error, DNS failure, etc.)+    HttpError !HttpException+  | -- | Ollama API returned an error response (HTTP status code + message)+    ApiError !Int !Text+  | -- | Failed to decode JSON response body+    DecodeError !Text !ByteString+  | -- | Request timed out waiting for a response+    TimeoutError+  | -- | Client-side validation failure before sending the request+    InvalidRequest !Text+  deriving stock (Show)++instance Exception OllamaError++instance Eq OllamaError where+  ApiError s1 t1 == ApiError s2 t2 = s1 == s2 && t1 == t2+  DecodeError t1 _ == DecodeError t2 _ = t1 == t2+  TimeoutError == TimeoutError = True+  InvalidRequest t1 == InvalidRequest t2 = t1 == t2+  HttpError _ == HttpError _ = False+  _ == _ = False++{- | Determine whether an error is transient and safe to retry.++@since 3.0.0.0+-}+isRetryable :: OllamaError -> Bool+isRetryable (HttpError _) = True+isRetryable TimeoutError = True+isRetryable (ApiError status _) | status >= 500 = True+isRetryable _ = False++{- | Helper to throw an 'OllamaError' as an exception.++@since 3.0.0.0+-}+throwOllama :: OllamaError -> IO a+throwOllama = throwIO
+ src/Ollama/MCP.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Ollama.MCP+Description : Model Context Protocol (MCP) tool conversion and server bridging for Ollama using mcp-server.+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Provides direct bidirectional conversion between Ollama function calling definitions ('Tool')+and Model Context Protocol ('ToolDefinition', 'Content', etc.) directly using the official+Hackage @mcp-server@ package.++@since 0.4.0.0+-}+module Ollama.MCP (+  -- * Re-exported MCP.Server Types & Functions+  Content (..),+  ContentImageData (..),+  ContentAudioData (..),+  ResourceContent (..),+  PromptDefinition (..),+  ResourceDefinition (..),+  ToolDefinition (..),+  ArgumentDefinition (..),+  type McpSchema,+  pattern McpSchema,+  SchemaType (..),+  schemaDescription,+  schemaShape,+  schema,+  describedSchema,+  mkToolDefinition,+  mkPromptDefinition,+  mkResourceDefinition,+  McpServerInfo (..),+  McpServerHandlers (..),+  ServerCapabilities (..),+  PromptCapabilities (..),+  ResourceCapabilities (..),+  ToolCapabilities (..),+  LoggingCapabilities (..),+  PromptListHandler,+  PromptGetHandler,+  ResourceListHandler,+  ResourceReadHandler,+  ToolListHandler,+  ToolCallHandler,+  PromptName,+  ToolName,+  ArgumentName,+  ArgumentValue,+  URI,+  parseURI,+  runMcpServerStdio,+  runMcpServerHttp,+  runMcpServerHttpWithConfig,+  HttpConfig (..),+  jsonValueToText,+  McpProtocolError,++  -- * Conversion between Ollama and mcp-server Types+  toolToMcpDefinition,+  mcpDefinitionToTool,+  toolCallToMcpArgs,+  mcpContentToToolOutput,+) where++import Data.Aeson (Value (..), encode)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding qualified as TEncoding+import MCP.Server (+  HttpConfig (..),+  runMcpServerHttp,+  runMcpServerHttpWithConfig,+  runMcpServerStdio,+ )+import MCP.Server.Types as ServerTypes (+  ArgumentDefinition (..),+  ArgumentName,+  ArgumentValue,+  Content (..),+  ContentAudioData (..),+  ContentImageData (..),+  Error (..),+  LoggingCapabilities (..),+  McpServerHandlers (..),+  McpServerInfo (..),+  PromptCapabilities (..),+  PromptDefinition (..),+  PromptGetHandler,+  PromptListHandler,+  PromptName,+  ResourceCapabilities (..),+  ResourceContent (..),+  ResourceDefinition (..),+  ResourceListHandler,+  ResourceReadHandler,+  Schema (..),+  SchemaType (..),+  ServerCapabilities (..),+  ToolCallHandler,+  ToolCapabilities (..),+  ToolDefinition (..),+  ToolListHandler,+  ToolName,+  URI,+  describedSchema,+  mkPromptDefinition,+  mkResourceDefinition,+  mkToolDefinition,+  parseURI,+  schema,+ )+import Ollama.Types.Tool (+  FunctionDef (..),+  FunctionParameters (..),+  Tool (..),+  ToolCall (..),+  ToolCallFunction (..),+ )++-- | Alias for 'MCP.Server.Types.Error' to prevent collisions with 'Ollama.Error'.+type McpProtocolError = ServerTypes.Error++-- | Alias for 'MCP.Server.Types.Schema' to avoid name collision with 'Ollama.Types.Format.SchemaBuilder.Schema'.+type McpSchema = ServerTypes.Schema++-- | Pattern synonym for matching or constructing an 'McpSchema' ('ServerTypes.Schema').+pattern McpSchema :: Maybe Text -> SchemaType -> McpSchema+pattern McpSchema desc shape = ServerTypes.Schema desc shape++{-# COMPLETE McpSchema #-}++-- | Convert an Aeson 'Value' to 'Text'. Strings are returned unquoted, while other JSON values are serialized.+jsonValueToText :: Value -> Text+jsonValueToText (String t) = t+jsonValueToText v = TL.toStrict (TEncoding.decodeUtf8 (encode v))++-- | Convert an Ollama 'Tool' into an MCP 'ToolDefinition' from @mcp-server@.+toolToMcpDefinition :: Tool -> ToolDefinition+toolToMcpDefinition Tool {toolFunction = FunctionDef {..}} =+  let desc = fromMaybe "" fnDescription+      convertParam :: FunctionParameters -> ServerTypes.Schema+      convertParam p =+        let pDesc = fpDescription p+            shape = case fpType p of+              "string" -> SchemaString (fpEnum p)+              "integer" -> SchemaInteger+              "number" -> SchemaNumber+              "boolean" -> SchemaBoolean+              "array" -> SchemaArray (ServerTypes.Schema Nothing (SchemaString Nothing))+              "object" ->+                let props = maybe [] (\pm -> [(k, convertParam v) | (k, v) <- Map.toList pm]) (fpProperties p)+                    req = fromMaybe [] (fpRequired p)+                 in SchemaObject props req+              _ -> SchemaString Nothing+         in ServerTypes.Schema pDesc shape+      inputSchema = case fnParameters of+        Just p -> convertParam p+        Nothing -> ServerTypes.Schema Nothing (SchemaObject [] [])+   in mkToolDefinition fnName desc inputSchema++-- | Convert an MCP 'ToolDefinition' from @mcp-server@ into an Ollama 'Tool'.+mcpDefinitionToTool :: ToolDefinition -> Tool+mcpDefinitionToTool ToolDefinition {..} =+  let convertSchema :: ServerTypes.Schema -> FunctionParameters+      convertSchema (ServerTypes.Schema mDesc shape) =+        case shape of+          SchemaString mEnum ->+            FunctionParameters+              { fpType = "string"+              , fpProperties = Nothing+              , fpRequired = Nothing+              , fpAdditionalProperties = Nothing+              , fpDescription = mDesc+              , fpEnum = mEnum+              }+          SchemaInteger ->+            FunctionParameters+              { fpType = "integer"+              , fpProperties = Nothing+              , fpRequired = Nothing+              , fpAdditionalProperties = Nothing+              , fpDescription = mDesc+              , fpEnum = Nothing+              }+          SchemaNumber ->+            FunctionParameters+              { fpType = "number"+              , fpProperties = Nothing+              , fpRequired = Nothing+              , fpAdditionalProperties = Nothing+              , fpDescription = mDesc+              , fpEnum = Nothing+              }+          SchemaBoolean ->+            FunctionParameters+              { fpType = "boolean"+              , fpProperties = Nothing+              , fpRequired = Nothing+              , fpAdditionalProperties = Nothing+              , fpDescription = mDesc+              , fpEnum = Nothing+              }+          SchemaArray _itemSchema ->+            FunctionParameters+              { fpType = "array"+              , fpProperties = Nothing+              , fpRequired = Nothing+              , fpAdditionalProperties = Nothing+              , fpDescription = mDesc+              , fpEnum = Nothing+              }+          SchemaObject props req ->+            let propMap = Map.fromList [(k, convertSchema s) | (k, s) <- props]+             in FunctionParameters+                  { fpType = "object"+                  , fpProperties = if Map.null propMap then Nothing else Just propMap+                  , fpRequired = if null req then Nothing else Just req+                  , fpAdditionalProperties = Nothing+                  , fpDescription = mDesc+                  , fpEnum = Nothing+                  }+      params = convertSchema toolDefinitionInputSchema+   in Tool+        { toolType = "function"+        , toolFunction =+            FunctionDef+              { fnName = toolDefinitionName+              , fnDescription = if T.null toolDefinitionDescription then Nothing else Just toolDefinitionDescription+              , fnParameters = Just params+              , fnStrict = Nothing+              }+        }++-- | Convert an Ollama 'ToolCall' into an MCP tool name and arguments list for @mcp-server@.+toolCallToMcpArgs :: ToolCall -> (Text, [(Text, Text)])+toolCallToMcpArgs (ToolCall (ToolCallFunction name args)) =+  (name, [(k, jsonValueToText v) | (k, v) <- Map.toList args])++-- | Extract textual output from an MCP 'Content' (from @mcp-server@).+mcpContentToToolOutput :: Content -> Text+mcpContentToToolOutput (ContentText t) = t+mcpContentToToolOutput (ContentImage (ContentImageData _ mime)) = "[Image: " <> mime <> "]"+mcpContentToToolOutput (ContentAudio (ContentAudioData _ mime)) = "[Audio: " <> mime <> "]"+mcpContentToToolOutput (ContentEmbeddedResource res) =+  "[Resource: " <> T.pack (show (resourceUri res)) <> "]"+mcpContentToToolOutput (ContentResourceLink resDef) =+  "[Resource: " <> resourceDefinitionURI resDef <> "]"+mcpContentToToolOutput (ContentAnnotated _ inner) = mcpContentToToolOutput inner
+ src/Ollama/Streaming.hs view
@@ -0,0 +1,41 @@+{- |+Module      : Ollama.Streaming+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Streaming pipeline utilities, stream combinators, and 'HasDone' class for API responses.++@since 1.0.0.0+-}+module Ollama.Streaming (+  HasDone (..),+  collectStream,+  foldStream,+) where++import Conduit (ConduitT, foldlC, runConduit, sinkList, (.|))+import Control.Monad.IO.Unlift (MonadUnliftIO)++{- | Typeclass for responses that indicate completion in a stream.++@since 1.0.0.0+-}+class HasDone a where+  isDone :: a -> Bool++{- | Collect all yielded items from a streaming conduit into a list.++@since 1.0.0.0+-}+collectStream :: (MonadUnliftIO m) => ConduitT () a m () -> m [a]+collectStream stream = runConduit $ stream .| sinkList++{- | Fold over all yielded items from a streaming conduit.++@since 1.0.0.0+-}+foldStream :: (MonadUnliftIO m) => (b -> a -> b) -> b -> ConduitT () a m () -> m b+foldStream f acc stream = runConduit $ stream .| foldlC f acc
+ src/Ollama/Testing.hs view
@@ -0,0 +1,162 @@+{- |+Module      : Ollama.Testing+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Mock client and test helpers for unit testing code without a live Ollama server.++@since 1.0.0.0+-}+module Ollama.Testing (+  newMockClient,+  withMockClient,+  mockGenerateResponse,+  mockChatResponse,+  mockEmbedResponse,+  mockListModelsResponse,+) where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.IORef (atomicModifyIORef, newIORef)+import Data.Text (Text)+import Data.Time (Day (..), UTCTime (..))+import Network.HTTP.Client (+  defaultManagerSettings,+  managerRawConnection,+  newManager,+ )+import Network.HTTP.Client.Internal (makeConnection)+import Ollama.API.Chat (ChatResponse (..))+import Ollama.API.Embed (EmbedResponse (..))+import Ollama.API.Generate (GenerateResponse (..))+import Ollama.Client (OllamaClient (..), closeClient)+import Ollama.Client.Config (defaultConfig)+import Ollama.Types.Common (Digest (..), Duration (..), ModelName (..))+import Ollama.Types.Message (assistantMessage)+import Ollama.Types.Model (ListResponse (..), ModelDetails (..), ModelInfo (..))++{- | Construct an 'OllamaClient' that returns mock HTTP response bytes for any request.++@since 1.0.0.0+-}+newMockClient :: (MonadIO m) => ByteString -> m OllamaClient+newMockClient bodyBytes = liftIO $ do+  let httpResponse =+        "HTTP/1.1 200 OK\r\nContent-Type: application/json\r\nContent-Length: "+          <> BS8.pack (show (BS8.length bodyBytes))+          <> "\r\n\r\n"+          <> bodyBytes+  ref <- newIORef [httpResponse]+  let mockConn =+        makeConnection+          ( atomicModifyIORef ref $ \case+              [] -> ([], "")+              (x : xs) -> (xs, x)+          )+          (\_ -> pure ())+          (pure ())+      settings = defaultManagerSettings {managerRawConnection = pure (\_ _ _ -> mockConn)}+  mgr <- newManager settings+  pure $ OllamaClient mgr defaultConfig True++{- | Resource bracket helper to create a mock client, execute an action, and close resources.++@since 1.0.0.0+-}+withMockClient :: (MonadUnliftIO m) => ByteString -> (OllamaClient -> m a) -> m a+withMockClient body action = do+  client <- newMockClient body+  res <- action client+  closeClient client+  pure res++{- | Construct a mock 'GenerateResponse'.++@since 1.0.0.0+-}+mockGenerateResponse :: ModelName -> Text -> GenerateResponse+mockGenerateResponse model text =+  GenerateResponse+    { grModel = model+    , grCreatedAt = UTCTime (ModifiedJulianDay 60000) 0+    , grResponse = text+    , grDone = True+    , grDoneReason = Just "stop"+    , grContext = Just [1, 2, 3]+    , grTotalDuration = Just (Duration 1000000000)+    , grLoadDuration = Just (Duration 100000000)+    , grPromptEvalCount = Just 10+    , grPromptEvalDuration = Just (Duration 200000000)+    , grEvalCount = Just 20+    , grEvalDuration = Just (Duration 700000000)+    , grThinking = Nothing+    , grImage = Nothing+    }++{- | Construct a mock 'ChatResponse'.++@since 1.0.0.0+-}+mockChatResponse :: ModelName -> Text -> ChatResponse+mockChatResponse model text =+  ChatResponse+    { crModel = model+    , crCreatedAt = UTCTime (ModifiedJulianDay 60000) 0+    , crMessage = Just (assistantMessage text)+    , crDone = True+    , crDoneReason = Just "stop"+    , crTotalDuration = Just (Duration 1000000000)+    , crLoadDuration = Just (Duration 100000000)+    , crPromptEvalCount = Just 10+    , crPromptEvalDuration = Just (Duration 200000000)+    , crEvalCount = Just 20+    , crEvalDuration = Just (Duration 700000000)+    }++{- | Construct a mock 'EmbedResponse'.++@since 1.0.0.0+-}+mockEmbedResponse :: ModelName -> [[Double]] -> EmbedResponse+mockEmbedResponse model vectors =+  EmbedResponse+    { erModel = model+    , erEmbeddings = vectors+    , erTotalDuration = Just (Duration 500000000)+    , erLoadDuration = Just (Duration 50000000)+    , erPromptEvalCount = Just 8+    }++{- | Construct a mock 'ListResponse'.++@since 1.0.0.0+-}+mockListModelsResponse :: [ModelName] -> ListResponse+mockListModelsResponse names =+  ListResponse+    { models = map mkModel names+    }+  where+    mkModel name =+      ModelInfo+        { miName = name+        , miModel = name+        , miModifiedAt = UTCTime (ModifiedJulianDay 60000) 0+        , miSize = 4000000000+        , miDigest = Digest "sha256:1234567890abcdef"+        , miDetails =+            ModelDetails+              { parentModel = Nothing+              , format = "gguf"+              , family = "llama"+              , families = ["llama"]+              , parameterSize = "7B"+              , quantizationLevel = "Q4_K_M"+              }+        }
+ src/Ollama/Types.hs view
@@ -0,0 +1,38 @@+{- |+Module      : Ollama.Types+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Re-export all domain types for convenience.++@since 3.0.0.0+-}+module Ollama.Types (+  module Ollama.Types.Common,+  Role (System, User, Assistant),+  Message (..),+  userMessage,+  systemMessage,+  assistantMessage,+  toolMessage,+  toolResultMessage,+  imageMessage,+  Tool (..),+  FunctionDef (..),+  FunctionParameters (..),+  ToolCall (..),+  ToolCallFunction (..),+  module Ollama.Types.Options,+  module Ollama.Types.Format,+  module Ollama.Types.Model,+) where++import Ollama.Types.Common+import Ollama.Types.Format+import Ollama.Types.Message+import Ollama.Types.Model+import Ollama.Types.Options+import Ollama.Types.Tool
+ src/Ollama/Types/Common.hs view
@@ -0,0 +1,152 @@+{- |+Module      : Ollama.Types.Common+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Common newtypes and domain primitives for the Ollama API.++@since 3.0.0.0+-}+module Ollama.Types.Common (+  ModelName (..),+  mkModelName,+  Digest (..),+  Base64Image (..),+  Duration (..),+  durationToSeconds,+  durationToMillis,+  tokensPerSecond,+  Version (..),+  Think (..),+  ThinkingLevel (..),+) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withText, (.:), (.=))+import Data.Aeson.Types (typeMismatch)+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.String (IsString)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics (Generic)++{- | Model name following the @model:tag@ format.++@since 3.0.0.0+-}+newtype ModelName = ModelName {unModelName :: Text}+  deriving newtype (Eq, Ord, Show, IsString, ToJSON, FromJSON, Hashable)++{- | Smart constructor that validates that a model name is non-empty.++@since 3.0.0.0+-}+mkModelName :: Text -> Either Text ModelName+mkModelName t+  | T.null t = Left "Model name cannot be empty"+  | otherwise = Right (ModelName t)++{- | SHA256 digest of a layer blob.++@since 3.0.0.0+-}+newtype Digest = Digest {unDigest :: Text}+  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON, Hashable)++{- | Base64-encoded image data for multimodal inputs.++@since 3.0.0.0+-}+newtype Base64Image = Base64Image {unBase64Image :: Text}+  deriving newtype (Eq, Show, ToJSON, FromJSON)++{- | Duration in nanoseconds as returned by the Ollama API.++@since 3.0.0.0+-}+newtype Duration = Duration {durationNanos :: Int64}+  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON, Num)++{- | Convert duration nanoseconds to seconds.++@since 3.0.0.0+-}+durationToSeconds :: Duration -> Double+durationToSeconds (Duration ns) = fromIntegral ns / 1e9++{- | Convert duration nanoseconds to milliseconds.++@since 1.0.0.0+-}+durationToMillis :: Duration -> Double+durationToMillis (Duration ns) = fromIntegral ns / 1e6++{- | Calculate tokens per second (tokens\/s) given a token count and a 'Duration'.++@since 1.0.0.0+-}+tokensPerSecond :: Int -> Duration -> Double+tokensPerSecond count dur =+  let secs = durationToSeconds dur+   in if secs <= 0 then 0.0 else fromIntegral count / secs++{- | Ollama server engine version string.++@since 3.0.0.0+-}+newtype Version = Version {unVersion :: Text}+  deriving stock (Eq, Show, Generic)++instance FromJSON Version where+  parseJSON = \case+    String s -> pure $ Version s+    Object v -> Version <$> v .: "version"+    v -> typeMismatch "Version" v++instance ToJSON Version where+  toJSON (Version s) = object ["version" .= s]++{- | Thinking level settings for reasoning models.++@since 3.0.0.0+-}+data ThinkingLevel = ThinkLow | ThinkMedium | ThinkHigh | ThinkMax+  deriving stock (Eq, Show, Bounded, Enum, Generic)++instance ToJSON ThinkingLevel where+  toJSON ThinkLow = String "low"+  toJSON ThinkMedium = String "medium"+  toJSON ThinkHigh = String "high"+  toJSON ThinkMax = String "max"++instance FromJSON ThinkingLevel where+  parseJSON = withText "ThinkingLevel" $ \case+    "low" -> pure ThinkLow+    "medium" -> pure ThinkMedium+    "high" -> pure ThinkHigh+    "max" -> pure ThinkMax+    other -> fail $ "Unknown thinking level: " <> T.unpack other++{- | Controls whether a thinking/reasoning model outputs its thoughts.++@since 3.0.0.0+-}+data Think+  = ThinkEnabled+  | ThinkDisabled+  | ThinkLevel !ThinkingLevel+  deriving stock (Eq, Show, Generic)++instance ToJSON Think where+  toJSON ThinkEnabled = Bool True+  toJSON ThinkDisabled = Bool False+  toJSON (ThinkLevel lvl) = toJSON lvl++instance FromJSON Think where+  parseJSON (Bool True) = pure ThinkEnabled+  parseJSON (Bool False) = pure ThinkDisabled+  parseJSON (String s) = ThinkLevel <$> parseJSON (String s)+  parseJSON v = typeMismatch "Think" v
+ src/Ollama/Types/Format.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++{- |+Module      : Ollama.Types.Format+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Response formatting specifications for structured model output.++@since 1.0.0.0+-}+module Ollama.Types.Format (+  Format (..),+  formatFor,+  module Ollama.Types.Format.SchemaBuilder,+  module Ollama.Types.Format.SchemaDerive,+) where++import Data.Aeson+import Ollama.Types.Format.SchemaBuilder+import Ollama.Types.Format.SchemaDerive++{- | Response output format hint.++@since 1.0.0.0+-}+data Format+  = -- | Constrain response output to generic valid JSON+    JsonFormat+  | -- | Constrain response output to a specific JSON Schema+    SchemaFormat !Schema+  deriving stock (Eq, Show)++instance ToJSON Format where+  toJSON JsonFormat = String "json"+  toJSON (SchemaFormat sch) = toJSON sch++instance FromJSON Format where+  parseJSON (String "json") = pure JsonFormat+  parseJSON v = SchemaFormat <$> parseJSON v++{- | Produce a 'Format' value suitable for the @genFormat@ \/ @chatFormat@+request fields.++@+req = (generateRequest model prompt)+        { genFormat = Just ('formatFor' \@Person) }+@++@since 0.4.0.0+-}+formatFor :: forall a. (ToSchema a) => Format+formatFor = SchemaFormat (schemaFor @a)
+ src/Ollama/Types/Format/SchemaBuilder.hs view
@@ -0,0 +1,223 @@+{- |+Module      : Ollama.Types.Format.SchemaBuilder+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++DSL for constructing structured JSON Schemas for Ollama's structured output API.++@since 1.0.0.0+-}+module Ollama.Types.Format.SchemaBuilder (+  JsonType (..),+  Property (..),+  Schema (..),+  SchemaBuilder,+  emptyObject,+  addProperty,+  addObjectProperty,+  requireField,+  requireFields,+  buildSchema,+  objectOf,+  arrayOf,+  printSchema,+  (|+),+  (|++),+  (|!),+  (|!!),+) 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 TEncoding+import GHC.Generics (Generic)++{- | Supported JSON primitive and compound types.++@since 1.0.0.0+-}+data JsonType+  = JString+  | JNumber+  | JInteger+  | JBoolean+  | JNull+  | JArray !JsonType+  | JObject !Schema+  deriving stock (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"++{- | Property metadata for schema properties.++@since 1.0.0.0+-}+newtype Property = Property JsonType+  deriving stock (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]++{- | JSON schema specification.++@since 1.0.0.0+-}+data Schema = Schema+  { schemaProperties :: !(HM.Map Text Property)+  , schemaRequired :: ![Text]+  }+  deriving stock (Show, Eq, Generic)++instance ToJSON Schema where+  toJSON (Schema props req) =+    object+      [ "type" .= ("object" :: Text)+      , "properties" .= props+      , "required" .= req+      ]++instance FromJSON JsonType where+  parseJSON = withText "JsonType" $ \case+    "string" -> pure JString+    "number" -> pure JNumber+    "integer" -> pure JInteger+    "boolean" -> pure JBoolean+    "null" -> pure JNull+    "array" -> pure (JArray JString)+    "object" -> pure (JObject (Schema HM.empty []))+    other -> fail $ "Unknown JsonType: " <> T.unpack other++instance FromJSON Property where+  parseJSON = withObject "Property" $ \v -> do+    t <- v .: "type"+    case (t :: Text) of+      "array" -> Property . JArray <$> (v .: "items" >>= parseJSON)+      "object" -> Property . JObject <$> parseJSON (Object v)+      _ -> Property <$> parseJSON (String t)++instance FromJSON Schema where+  parseJSON = withObject "Schema" $ \v ->+    Schema+      <$> v .:? "properties" .!= HM.empty+      <*> v .:? "required" .!= []++{- | Opaque builder for fluid schema construction.++@since 1.0.0.0+-}+newtype SchemaBuilder = SchemaBuilder Schema+  deriving stock (Show, Eq)++{- | Create an empty schema builder object.++@since 1.0.0.0+-}+emptyObject :: SchemaBuilder+emptyObject = SchemaBuilder $ Schema HM.empty []++{- | Add a primitive property to the schema builder.++@since 1.0.0.0+-}+addProperty :: Text -> JsonType -> SchemaBuilder -> SchemaBuilder+addProperty name typ (SchemaBuilder s) =+  SchemaBuilder $ s {schemaProperties = HM.insert name (Property typ) (schemaProperties s)}++{- | Add a nested object property to the schema builder.++@since 1.0.0.0+-}+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.++@since 1.0.0.0+-}+requireField :: Text -> SchemaBuilder -> SchemaBuilder+requireField name (SchemaBuilder s) =+  SchemaBuilder $ s {schemaRequired = name : schemaRequired s}++{- | Mark multiple fields as required.++@since 1.0.0.0+-}+requireFields :: [Text] -> SchemaBuilder -> SchemaBuilder+requireFields names builder = foldr requireField builder names++{- | Finalize a 'Schema' from a 'SchemaBuilder'.++@since 1.0.0.0+-}+buildSchema :: SchemaBuilder -> Schema+buildSchema (SchemaBuilder s) = s++{- | Treat a 'SchemaBuilder' as a nested object type.++@since 1.0.0.0+-}+objectOf :: SchemaBuilder -> JsonType+objectOf builder = JObject (buildSchema builder)++{- | Create an array schema type of an element type.++@since 1.0.0.0+-}+arrayOf :: JsonType -> JsonType+arrayOf = JArray++{- | Pretty-print a schema as formatted JSON.++@since 1.0.0.0+-}+printSchema :: Schema -> IO ()+printSchema = putStrLn . T.unpack . TL.toStrict . TEncoding.decodeUtf8 . encode++{- | Infix alias for 'addProperty'.++@since 1.0.0.0+-}+(|+) :: SchemaBuilder -> (Text, JsonType) -> SchemaBuilder+builder |+ (name, typ) = addProperty name typ builder++{- | Infix alias for 'addObjectProperty'.++@since 1.0.0.0+-}+(|++) :: SchemaBuilder -> (Text, Schema) -> SchemaBuilder+builder |++ (name, schema) = addObjectProperty name schema builder++{- | Infix alias for 'requireField'.++@since 1.0.0.0+-}+(|!) :: SchemaBuilder -> Text -> SchemaBuilder+builder |! name = requireField name builder++{- | Infix alias for 'requireFields'.++@since 1.0.0.0+-}+(|!!) :: SchemaBuilder -> [Text] -> SchemaBuilder+builder |!! names = requireFields names builder++infixl 7 |+, |+++infixl 6 |!, |!!
+ src/Ollama/Types/Format/SchemaDerive.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Module      : Ollama.Types.Format.SchemaDerive+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : experimental+Portability : portable++Generic derivation of JSON 'Schema' from Haskell record types.++This module provides the 'ToSchema' typeclass, which can automatically+derive a JSON Schema ('Schema') from any Haskell data type that has a+'GHC.Generics.Generic' instance.  This eliminates the need to manually+construct schemas using the 'Ollama.Types.Format.SchemaBuilder.SchemaBuilder' DSL when working with+Ollama's structured output API.++== Usage++Simply derive 'Generic' and declare a 'ToSchema' instance:++@+data Person = Person+  { name :: Text+  , age  :: Int+  } deriving stock ('GHC.Generics.Generic', Show)+    deriving anyclass ('ToSchema')++\-\- Use it:+\-\- >>> 'schemaFor' \@Person+\-\- >>> 'Ollama.Types.Format.formatFor' \@Person+@++== Supported types++* __Record types__: All fields become properties; non‑'Maybe' fields+  are marked as required.+* __'Maybe' fields__: Present in the schema properties but excluded+  from the @required@ array.+* __Nested records__: Recursively derived as nested @object@ schemas.+* __Lists__: Mapped to @array@ schemas.+* __Simple enums__: Sum types with all nullary constructors are+  represented as @{\"type\": \"string\", \"enum\": [...]}@.++@since 0.4.0.0+-}+module Ollama.Types.Format.SchemaDerive (+  -- * Typeclass+  ToSchema (..),+  ToJsonType (..),++  -- * Convenience functions+  schemaFor,++  -- * Generic Machinery (internal)+  GToSchema (..),+  GCollectFields (..),+  GEnumConstructors (..),+  GToSchemaDispatch (..),+) where++import Data.Int (Int16, Int32, Int64, Int8)+import Data.Kind (Type)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text qualified as T+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Generics+import GHC.TypeLits (KnownSymbol, symbolVal)+import Ollama.Types.Format.SchemaBuilder (JsonType (..), Property (..), Schema (..))++-- ---------------------------------------------------------------------------+-- Public API+-- ---------------------------------------------------------------------------++{- | Typeclass for types whose structure can be represented as a JSON 'Schema'.++A default implementation is provided via @GHC.Generics@, so you can derive+it for any record type that has a 'Generic' instance:++@+data MyType = MyType { field1 :: Text, field2 :: Int }+  deriving stock ('Generic')+  deriving anyclass ('ToSchema')+@++@since 0.4.0.0+-}+class ToSchema a where+  {- | Produce the JSON 'Schema' for type @a@.++  @since 0.4.0.0+  -}+  toSchema :: Schema+  default toSchema :: (GToSchema (Rep a)) => Schema+  toSchema = gToSchema @(Rep a)++{- | Convenience alias for @'toSchema' \@a@.++@since 0.4.0.0+-}+schemaFor :: forall a. (ToSchema a) => Schema+schemaFor = toSchema @a++{- | Map a Haskell type to its JSON Schema 'JsonType'.++Instances are provided for common primitive types ('Text', 'Int', 'Bool',+'Double', etc.), 'Maybe', lists, and any type with a 'ToSchema' instance+(which maps to a nested @object@ schema).++For nested record types, you don't need to write an instance manually —+simply ensure the nested type has a 'ToSchema' instance and the default+method will handle it:++@+data Address = Address { city :: Text, zip :: Text }+  deriving stock ('Generic')+  deriving anyclass ('ToSchema', 'ToJsonType')+@++@since 0.4.0.0+-}+class ToJsonType a where+  toJsonType :: JsonType+  default toJsonType :: (ToSchema a) => JsonType+  toJsonType = JObject (toSchema @a)++-- ---------------------------------------------------------------------------+-- GHC.Generics machinery (internal)+-- ---------------------------------------------------------------------------++-- | Walk a generic representation to produce a 'Schema'.+class GToSchema (f :: Type -> Type) where+  gToSchema :: Schema++-- | Collect fields (properties + required list) from a generic representation.+class GCollectFields (f :: Type -> Type) where+  gCollectFields :: ([(Text, Property)], [Text])++-- | Collect constructor names from a sum type for enum schemas.+class GEnumConstructors (f :: Type -> Type) where+  gEnumConstructors :: [Text]++-- ---------------------------------------------------------------------------+-- Datatype / Constructor / Sum dispatch+-- ---------------------------------------------------------------------------++-- | Strip datatype metadata wrapper.+instance (GToSchemaDispatch f) => GToSchema (M1 D meta f) where+  gToSchema = gToSchemaDispatch @f++-- | Dispatch: determine if this is a single-constructor record or a sum type.+class GToSchemaDispatch (f :: Type -> Type) where+  gToSchemaDispatch :: Schema++-- | Single constructor → collect fields into an object schema.+instance (GCollectFields f) => GToSchemaDispatch (M1 C meta f) where+  gToSchemaDispatch =+    let (props, req) = gCollectFields @f+     in Schema (Map.fromList props) req++{- | Sum type → try to build an enum schema.+We treat all-nullary sum types as string enums.+-}+instance (GEnumConstructors f, GEnumConstructors g) => GToSchemaDispatch (f :+: g) where+  gToSchemaDispatch =+    let constructors = gEnumConstructors @f <> gEnumConstructors @g+     in Schema Map.empty constructors++-- ---------------------------------------------------------------------------+-- Constructor / field collection+-- ---------------------------------------------------------------------------++-- | Strip constructor metadata wrapper.+instance (GCollectFields f) => GCollectFields (M1 C meta f) where+  gCollectFields = gCollectFields @f++-- | Product of fields: combine both sides.+instance (GCollectFields f, GCollectFields g) => GCollectFields (f :*: g) where+  gCollectFields =+    let (ps1, rs1) = gCollectFields @f+        (ps2, rs2) = gCollectFields @g+     in (ps1 <> ps2, rs1 <> rs2)++-- | Unit constructor (no fields).+instance GCollectFields U1 where+  gCollectFields = ([], [])++-- | Record field with a 'Maybe' type (optional — not required).+instance+  {-# OVERLAPPING #-}+  (KnownSymbol name, ToJsonType a) =>+  GCollectFields (M1 S ('MetaSel ('Just name) su ss ds) (K1 R (Maybe a)))+  where+  gCollectFields =+    let fieldName = T.pack $ symbolVal (Proxy @name)+        prop = Property (toJsonType @a)+     in ([(fieldName, prop)], [])++-- | Record field with a non-'Maybe' type (required).+instance+  {-# OVERLAPPABLE #-}+  (KnownSymbol name, ToJsonType a) =>+  GCollectFields (M1 S ('MetaSel ('Just name) su ss ds) (K1 R a))+  where+  gCollectFields =+    let fieldName = T.pack $ symbolVal (Proxy @name)+        prop = Property (toJsonType @a)+     in ([(fieldName, prop)], [fieldName])++-- ---------------------------------------------------------------------------+-- ToJsonType instances+-- ---------------------------------------------------------------------------++-- Strings+instance ToJsonType Text where toJsonType = JString+instance ToJsonType String where toJsonType = JString++-- Integers+instance ToJsonType Int where toJsonType = JInteger+instance ToJsonType Int8 where toJsonType = JInteger+instance ToJsonType Int16 where toJsonType = JInteger+instance ToJsonType Int32 where toJsonType = JInteger+instance ToJsonType Int64 where toJsonType = JInteger+instance ToJsonType Integer where toJsonType = JInteger+instance ToJsonType Word where toJsonType = JInteger+instance ToJsonType Word8 where toJsonType = JInteger+instance ToJsonType Word16 where toJsonType = JInteger+instance ToJsonType Word32 where toJsonType = JInteger+instance ToJsonType Word64 where toJsonType = JInteger++-- Floating point+instance ToJsonType Double where toJsonType = JNumber+instance ToJsonType Float where toJsonType = JNumber++-- Boolean+instance ToJsonType Bool where toJsonType = JBoolean++-- Maybe: unwrap to the inner type+instance (ToJsonType a) => ToJsonType (Maybe a) where+  toJsonType = toJsonType @a++-- Lists / arrays+instance (ToJsonType a) => ToJsonType [a] where+  toJsonType = JArray (toJsonType @a)++-- ---------------------------------------------------------------------------+-- Enum constructors+-- ---------------------------------------------------------------------------++-- | Sum of two branches.+instance (GEnumConstructors f, GEnumConstructors g) => GEnumConstructors (f :+: g) where+  gEnumConstructors = gEnumConstructors @f <> gEnumConstructors @g++-- | A nullary constructor (unit): extract constructor name.+instance (KnownSymbol name) => GEnumConstructors (M1 C ('MetaCons name fx 'False) U1) where+  gEnumConstructors = [T.toLower . T.pack $ symbolVal (Proxy @name)]++{- | A constructor with fields — not a simple enum. Produce a type error+at the instance level by not providing an instance (compile-time failure).+Users will get "No instance for GEnumConstructors ..." which is clear enough.+-}
+ src/Ollama/Types/Message.hs view
@@ -0,0 +1,129 @@+{- |+Module      : Ollama.Types.Message+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Chat message definitions and helper constructors.++@since 3.0.0.0+-}+module Ollama.Types.Message (+  Role (..),+  Message (..),+  userMessage,+  systemMessage,+  assistantMessage,+  toolMessage,+  toolResultMessage,+  imageMessage,+) where++import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Types.Common (Base64Image)+import Ollama.Types.Tool (ToolCall)++{- | Entity role in a conversation.++@since 3.0.0.0+-}+data Role = System | User | Assistant | Tool+  deriving stock (Eq, Ord, Show, Bounded, Enum, Generic)++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" $ \case+    "system" -> pure System+    "user" -> pure User+    "assistant" -> pure Assistant+    "tool" -> pure Tool+    other -> fail $ "Invalid Role: " <> show other++{- | Chat message within a conversation payload.++@since 3.0.0.0+-}+data Message = Message+  { messageRole :: !Role+  , messageContent :: !Text+  , messageImages :: !(Maybe [Base64Image])+  , messageToolCalls :: !(Maybe [ToolCall])+  , messageToolName :: !(Maybe Text)+  , messageThinking :: !(Maybe Text)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON Message where+  toJSON Message {..} =+    object $+      catMaybes+        [ Just $ "role" .= messageRole+        , Just $ "content" .= messageContent+        , ("images" .=) <$> messageImages+        , ("tool_calls" .=) <$> messageToolCalls+        , ("tool_name" .=) <$> messageToolName+        , ("thinking" .=) <$> messageThinking+        ]++instance FromJSON Message where+  parseJSON = withObject "Message" $ \v ->+    Message+      <$> v .: "role"+      <*> v .: "content"+      <*> v .:? "images"+      <*> v .:? "tool_calls"+      <*> v .:? "tool_name"+      <*> v .:? "thinking"++{- | Create a 'User' role message.++@since 3.0.0.0+-}+userMessage :: Text -> Message+userMessage t = Message User t Nothing Nothing Nothing Nothing++{- | Create a 'System' role message.++@since 3.0.0.0+-}+systemMessage :: Text -> Message+systemMessage t = Message System t Nothing Nothing Nothing Nothing++{- | Create an 'Assistant' role message.++@since 3.0.0.0+-}+assistantMessage :: Text -> Message+assistantMessage t = Message Assistant t Nothing Nothing Nothing Nothing++{- | Create a 'Tool' role message.++@since 3.0.0.0+-}+toolMessage :: Text -> Message+toolMessage t = Message Tool t Nothing Nothing Nothing Nothing++{- | Create a 'Tool' role message with specific @tool_name@ informing the model of tool execution.++@since 3.0.0.0+-}+toolResultMessage :: Text -> Text -> Message+toolResultMessage content toolName =+  Message Tool content Nothing Nothing (Just toolName) Nothing++{- | Create a 'User' message with attached Base64 image data.++@since 3.0.0.0+-}+imageMessage :: Text -> [Base64Image] -> Message+imageMessage t imgs = Message User t (Just imgs) Nothing Nothing Nothing
+ src/Ollama/Types/Model.hs view
@@ -0,0 +1,161 @@+{- |+Module      : Ollama.Types.Model+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model info, details, listing, and metadata types.++@since 1.0.0.0+-}+module Ollama.Types.Model (+  ModelDetails (..),+  ModelInfo (..),+  ListResponse (..),+  RunningModel (..),+  RunningModelsResponse (..),+) where++import Data.Aeson+import Data.Int (Int64)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Ollama.Types.Common (Digest, ModelName)++{- | Detailed specifications of a model's architecture and family.++@since 1.0.0.0+-}+data ModelDetails = ModelDetails+  { parentModel :: !(Maybe Text)+  , format :: !Text+  , family :: !Text+  , families :: ![Text]+  , parameterSize :: !Text+  , quantizationLevel :: !Text+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON ModelDetails where+  parseJSON = withObject "ModelDetails" $ \v ->+    ModelDetails+      <$> v .:? "parent_model"+      <*> v .:? "format" .!= ""+      <*> v .:? "family" .!= ""+      <*> v .:? "families" .!= []+      <*> v .:? "parameter_size" .!= ""+      <*> v .:? "quantization_level" .!= ""++instance ToJSON ModelDetails where+  toJSON ModelDetails {..} =+    object+      [ "parent_model" .= parentModel+      , "format" .= format+      , "family" .= family+      , "families" .= families+      , "parameter_size" .= parameterSize+      , "quantization_level" .= quantizationLevel+      ]++{- | Summary information for an installed local model.++@since 1.0.0.0+-}+data ModelInfo = ModelInfo+  { miName :: !ModelName+  , miModel :: !ModelName+  , miModifiedAt :: !UTCTime+  , miSize :: !Int64+  , miDigest :: !Digest+  , miDetails :: !ModelDetails+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON ModelInfo where+  parseJSON = withObject "ModelInfo" $ \v ->+    ModelInfo+      <$> v .: "name"+      <*> v .: "model"+      <*> v .: "modified_at"+      <*> v .: "size"+      <*> v .: "digest"+      <*> v .: "details"++instance ToJSON ModelInfo where+  toJSON ModelInfo {..} =+    object+      [ "name" .= miName+      , "model" .= miModel+      , "modified_at" .= miModifiedAt+      , "size" .= miSize+      , "digest" .= miDigest+      , "details" .= miDetails+      ]++{- | Response listing available local models.++@since 1.0.0.0+-}+newtype ListResponse = ListResponse+  { models :: [ModelInfo]+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON, FromJSON)++{- | Summary information for a model currently loaded in memory.++@since 1.0.0.0+-}+data RunningModel = RunningModel+  { rmName :: !ModelName+  , rmModel :: !ModelName+  , rmSize :: !Int64+  , rmDigest :: !Digest+  , rmDetails :: !ModelDetails+  , rmExpiresAt :: !UTCTime+  , rmSizeVram :: !Int64+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON RunningModel where+  parseJSON = withObject "RunningModel" $ \v ->+    RunningModel+      <$> v .: "name"+      <*> v .: "model"+      <*> v .: "size"+      <*> v .: "digest"+      <*> v .: "details"+      <*> v .: "expires_at"+      <*> v .: "size_vram"++instance ToJSON RunningModel where+  toJSON RunningModel {..} =+    object+      [ "name" .= rmName+      , "model" .= rmModel+      , "size" .= rmSize+      , "digest" .= rmDigest+      , "details" .= rmDetails+      , "expires_at" .= rmExpiresAt+      , "size_vram" .= rmSizeVram+      ]++{- | Response listing loaded running models.++@since 1.0.0.0+-}+newtype RunningModelsResponse = RunningModelsResponse+  { runningModels :: [RunningModel]+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON RunningModelsResponse where+  parseJSON = withObject "RunningModelsResponse" $ \v ->+    RunningModelsResponse <$> v .: "models"++instance ToJSON RunningModelsResponse where+  toJSON RunningModelsResponse {..} =+    object ["models" .= runningModels]
+ src/Ollama/Types/Options.hs view
@@ -0,0 +1,135 @@+{- |+Module      : Ollama.Types.Options+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Model parameters and runtime execution options.++@since 3.0.0.0+-}+module Ollama.Types.Options (+  ModelOptions (..),+  defaultOptions,+) where++import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:?), (.=))+import Data.Maybe (catMaybes)+import Data.Text (Text)+import GHC.Generics (Generic)++{- | Optional inference and hardware tuning parameters.++@since 3.0.0.0+-}+data ModelOptions = ModelOptions+  { optNumKeep :: !(Maybe Int)+  , optSeed :: !(Maybe Int)+  , optNumPredict :: !(Maybe Int)+  , optDraftNumPredict :: !(Maybe Int)+  , optTopK :: !(Maybe Int)+  , optTopP :: !(Maybe Double)+  , optMinP :: !(Maybe Double)+  , optTypicalP :: !(Maybe Double)+  , optRepeatLastN :: !(Maybe Int)+  , optTemperature :: !(Maybe Double)+  , optRepeatPenalty :: !(Maybe Double)+  , optPresencePenalty :: !(Maybe Double)+  , optFrequencyPenalty :: !(Maybe Double)+  , optPenalizeNewline :: !(Maybe Bool)+  , optStop :: !(Maybe [Text])+  , optNuma :: !(Maybe Bool)+  , optNumCtx :: !(Maybe Int)+  , optNumBatch :: !(Maybe Int)+  , optNumGpu :: !(Maybe Int)+  , optMainGpu :: !(Maybe Int)+  , optUseMmap :: !(Maybe Bool)+  , optNumThread :: !(Maybe Int)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ModelOptions where+  toJSON opts =+    object $+      catMaybes+        [ ("num_keep" .=) <$> optNumKeep opts+        , ("seed" .=) <$> optSeed opts+        , ("num_predict" .=) <$> optNumPredict opts+        , ("draft_num_predict" .=) <$> optDraftNumPredict opts+        , ("top_k" .=) <$> optTopK opts+        , ("top_p" .=) <$> optTopP opts+        , ("min_p" .=) <$> optMinP opts+        , ("typical_p" .=) <$> optTypicalP opts+        , ("repeat_last_n" .=) <$> optRepeatLastN opts+        , ("temperature" .=) <$> optTemperature opts+        , ("repeat_penalty" .=) <$> optRepeatPenalty opts+        , ("presence_penalty" .=) <$> optPresencePenalty opts+        , ("frequency_penalty" .=) <$> optFrequencyPenalty opts+        , ("penalize_newline" .=) <$> optPenalizeNewline opts+        , ("stop" .=) <$> optStop opts+        , ("numa" .=) <$> optNuma opts+        , ("num_ctx" .=) <$> optNumCtx opts+        , ("num_batch" .=) <$> optNumBatch opts+        , ("num_gpu" .=) <$> optNumGpu opts+        , ("main_gpu" .=) <$> optMainGpu opts+        , ("use_mmap" .=) <$> optUseMmap opts+        , ("num_thread" .=) <$> optNumThread opts+        ]++instance FromJSON ModelOptions where+  parseJSON = withObject "ModelOptions" $ \v ->+    ModelOptions+      <$> v .:? "num_keep"+      <*> v .:? "seed"+      <*> v .:? "num_predict"+      <*> v .:? "draft_num_predict"+      <*> v .:? "top_k"+      <*> v .:? "top_p"+      <*> v .:? "min_p"+      <*> v .:? "typical_p"+      <*> v .:? "repeat_last_n"+      <*> v .:? "temperature"+      <*> v .:? "repeat_penalty"+      <*> v .:? "presence_penalty"+      <*> v .:? "frequency_penalty"+      <*> v .:? "penalize_newline"+      <*> v .:? "stop"+      <*> v .:? "numa"+      <*> v .:? "num_ctx"+      <*> v .:? "num_batch"+      <*> v .:? "num_gpu"+      <*> v .:? "main_gpu"+      <*> v .:? "use_mmap"+      <*> v .:? "num_thread"++{- | Default empty options (all settings default to server Modelfile values).++@since 3.0.0.0+-}+defaultOptions :: ModelOptions+defaultOptions =+  ModelOptions+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing+    Nothing
+ src/Ollama/Types/Tool.hs view
@@ -0,0 +1,148 @@+{- |+Module      : Ollama.Types.Tool+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Tool calling and structured function interfaces for the Ollama API.++@since 3.0.0.0+-}+module Ollama.Types.Tool (+  Tool (..),+  FunctionDef (..),+  FunctionParameters (..),+  ToolCall (..),+  ToolCallFunction (..),+) where++import Data.Aeson+import Data.Map.Strict (Map)+import Data.Text (Text)+import GHC.Generics (Generic)++{- | Tool definition provided to the model.++@since 3.0.0.0+-}+data Tool = Tool+  { toolType :: !Text+  , toolFunction :: !FunctionDef+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON Tool where+  toJSON Tool {..} =+    object+      [ "type" .= toolType+      , "function" .= toolFunction+      ]++instance FromJSON Tool where+  parseJSON = withObject "Tool" $ \v ->+    Tool+      <$> v .: "type"+      <*> v .: "function"++{- | Definition of a function that can be called by the model.++@since 3.0.0.0+-}+data FunctionDef = FunctionDef+  { fnName :: !Text+  , fnDescription :: !(Maybe Text)+  , fnParameters :: !(Maybe FunctionParameters)+  , fnStrict :: !(Maybe Bool)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON FunctionDef where+  toJSON FunctionDef {..} =+    object $+      ["name" .= fnName]+        ++ maybe [] (\d -> ["description" .= d]) fnDescription+        ++ maybe [] (\p -> ["parameters" .= p]) fnParameters+        ++ maybe [] (\s -> ["strict" .= s]) fnStrict++instance FromJSON FunctionDef where+  parseJSON = withObject "FunctionDef" $ \v ->+    FunctionDef+      <$> v .: "name"+      <*> v .:? "description"+      <*> v .:? "parameters"+      <*> v .:? "strict"++{- | Parameters schema for a function call.++@since 3.0.0.0+-}+data FunctionParameters = FunctionParameters+  { fpType :: !Text+  , fpProperties :: !(Maybe (Map Text FunctionParameters))+  , fpRequired :: !(Maybe [Text])+  , fpAdditionalProperties :: !(Maybe Bool)+  , fpDescription :: !(Maybe Text)+  , fpEnum :: !(Maybe [Text])+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON FunctionParameters where+  toJSON FunctionParameters {..} =+    object $+      ["type" .= fpType]+        ++ maybe [] (\p -> ["properties" .= p]) fpProperties+        ++ maybe [] (\r -> ["required" .= r]) fpRequired+        ++ maybe [] (\a -> ["additionalProperties" .= a]) fpAdditionalProperties+        ++ maybe [] (\d -> ["description" .= d]) fpDescription+        ++ maybe [] (\e -> ["enum" .= e]) fpEnum++instance FromJSON FunctionParameters where+  parseJSON = withObject "FunctionParameters" $ \v ->+    FunctionParameters+      <$> v .: "type"+      <*> v .:? "properties"+      <*> v .:? "required"+      <*> v .:? "additionalProperties"+      <*> v .:? "description"+      <*> v .:? "enum"++{- | Tool call returned in model's assistant response.++@since 3.0.0.0+-}+newtype ToolCall = ToolCall+  { tcFunction :: ToolCallFunction+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ToolCall where+  toJSON ToolCall {..} = object ["function" .= tcFunction]++instance FromJSON ToolCall where+  parseJSON = withObject "ToolCall" $ \v ->+    ToolCall <$> v .: "function"++{- | Function invocation payload inside a tool call.++@since 3.0.0.0+-}+data ToolCallFunction = ToolCallFunction+  { tcfName :: !Text+  , tcfArguments :: !(Map Text Value)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ToolCallFunction where+  toJSON ToolCallFunction {..} =+    object+      [ "name" .= tcfName+      , "arguments" .= tcfArguments+      ]++instance FromJSON ToolCallFunction where+  parseJSON = withObject "ToolCallFunction" $ \v ->+    ToolCallFunction+      <$> v .: "name"+      <*> v .: "arguments"
+ test-integration/Main.hs view
@@ -0,0 +1,176 @@+module Main (main) where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Text qualified as T+import Data.Time (getCurrentTime)+import Ollama+import Test.Tasty+import Test.Tasty.HUnit++testModel :: ModelName+testModel = "qwen3.5:2b"++fastOptions :: Maybe ModelOptions+fastOptions = Just (defaultOptions {optNumPredict = Just 15})++tests :: TestTree+tests =+  testGroup+    "ollama-haskell Live Server End-to-End Test Suite"+    [ testCase "GET /api/version — getVersion" $ do+        client <- defaultClient+        res <- getVersion client+        case res of+          Left err -> assertFailure $ "Version request failed: " <> show err+          Right ver -> assertBool "Version non-empty" (not $ T.null $ unVersion ver)+    , testCase "GET /api/tags — listModels" $ do+        client <- defaultClient+        res <- listModels client+        case res of+          Left err -> assertFailure $ "List models failed: " <> show err+          Right (ListResponse ms) ->+            assertBool "Has installed models" (not $ null ms)+    , testCase "POST /api/show — showModel" $ do+        client <- defaultClient+        res <- showModel client testModel+        case res of+          Left err -> assertFailure $ "Show model failed: " <> show err+          Right resp ->+            assertBool "Modelfile or details present" (not $ T.null $ srsModelfile resp)+    , testCase "GET /api/ps — listRunning" $ do+        client <- defaultClient+        res <- listRunning client+        case res of+          Left err -> assertFailure $ "List running failed: " <> show err+          Right _ -> pure ()+    , testCase "POST /api/chat — non-streaming chat" $ do+        client <- defaultClient+        let msgs = systemMessage "You are a helpful assistant." :| [userMessage "Say hello in one word."]+            req = (chatRequest testModel msgs) {chatOptions = fastOptions, chatThink = Just ThinkDisabled}+        res <- chat client req+        case res of+          Left err -> assertFailure $ "Chat request failed: " <> show err+          Right resp -> do+            assertBool "Chat response done" (crDone resp)+            case crMessage resp of+              Nothing -> assertFailure "Expected message in response"+              Just msg ->+                assertBool+                  "Message content or thinking present"+                  (not (T.null (messageContent msg)) || maybe False (not . T.null) (messageThinking msg))+    , testCase "POST /api/chat — streaming chat with conduit" $ do+        client <- defaultClient+        let req = (chatRequest testModel (userMessage "Count from 1 to 5." :| [])) {chatThink = Just ThinkDisabled}+        chunks <- collectStream (chatStream client req)+        assertBool "Stream produced response chunks" (not $ null chunks)+    , testCase "POST /api/generate — non-streaming generate" $ do+        client <- defaultClient+        let req =+              (generateRequest testModel "Write 3 words.")+                { genOptions = fastOptions+                , genThink = Just ThinkDisabled+                }+        res <- generate client req+        case res of+          Left err -> assertFailure $ "Generate request failed: " <> show err+          Right resp -> do+            assertBool "Generate response done" (grDone resp)+            assertBool "Generated response non-empty" (not $ T.null $ grResponse resp)+    , testCase "POST /api/generate — streaming generate with conduit" $ do+        client <- defaultClient+        let req = (generateRequest testModel "Say hi.") {genThink = Just ThinkDisabled}+        chunks <- collectStream (generateStream client req)+        assertBool "Stream produced generate chunks" (not $ null chunks)+    , testCase "POST /api/generate — thinking model support" $ do+        client <- defaultClient+        let req =+              (generateRequest testModel "What is 2 + 2?")+                { genThink = Just ThinkEnabled+                , genOptions = fastOptions+                }+        res <- generate client req+        case res of+          Left err -> assertFailure $ "Thinking generate failed: " <> show err+          Right resp -> assertBool "Response done" (grDone resp)+    , testCase "POST /api/chat — tool calling definition and execution" $ do+        client <- defaultClient+        let weatherTool =+              Tool+                { toolType = "function"+                , toolFunction =+                    FunctionDef+                      { fnName = "get_current_weather"+                      , fnDescription = Just "Get current weather for a city"+                      , fnParameters =+                          Just+                            FunctionParameters+                              { fpType = "object"+                              , fpProperties = Nothing+                              , fpRequired = Just ["location"]+                              , fpAdditionalProperties = Nothing+                              , fpDescription = Nothing+                              , fpEnum = Nothing+                              }+                      , fnStrict = Nothing+                      }+                }+            req =+              (chatRequest testModel (userMessage "What is the weather in Tokyo?" :| []))+                { chatTools = Just [weatherTool]+                , chatOptions = fastOptions+                , chatThink = Just ThinkDisabled+                }+        res <- chat client req+        case res of+          Left err -> assertFailure $ "Tool chat request failed: " <> show err+          Right resp -> assertBool "Chat response completed" (crDone resp)+    , testCase "POST /api/chat — structured output format" $ do+        client <- defaultClient+        let req =+              (chatRequest testModel (userMessage "Respond with JSON listing 2 colors" :| []))+                { chatFormat = Just JsonFormat+                , chatOptions = fastOptions+                , chatThink = Just ThinkDisabled+                }+        res <- chat client req+        case res of+          Left err -> assertFailure $ "Structured chat failed: " <> show err+          Right resp -> assertBool "Response done" (crDone resp)+    , testCase "POST /api/embed — vector embeddings" $ do+        client <- defaultClient+        let req = embedRequest testModel ["Hello world", "Haskell LLM client"]+        res <- embed client req+        case res of+          Left (ApiError 501 _) -> pure ()+          Left err -> assertFailure $ "Embed request failed: " <> show err+          Right resp ->+            assertBool "Embeddings non-empty" (not $ null $ erEmbeddings resp)+    , testCase "POST /api/copy & DELETE /api/delete — model lifecycle" $ do+        client <- defaultClient+        let copyTarget = "qwen3.5:2b-test-copy"+        copyRes <- copyModel client testModel copyTarget+        case copyRes of+          Left err -> assertFailure $ "Copy model failed: " <> show err+          Right () -> do+            delRes <- deleteModel client copyTarget+            case delRes of+              Left err -> assertFailure $ "Delete model failed: " <> show err+              Right () -> pure ()+    , testCase "ConversationStore — InMemoryStore with real conversation" $ do+        store <- initInMemoryStore+        now <- getCurrentTime+        let cid = "test-conv-1"+            conv =+              Conversation+                cid+                [systemMessage "You are a concise assistant.", userMessage "My favorite color is green."]+                testModel+                now+                now+        saveConversationInMemory store conv+        mConv <- loadConversationInMemory store cid+        assertEqual "Loaded saved conversation" (Just conv) mConv+    ]++main :: IO ()+main = defaultMain tests
test/Main.hs view
@@ -1,212 +1,36 @@-{-# LANGUAGE OverloadedStrings #-}- 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 Test.Ollama.Golden.Chat qualified as GoldenChat+import Test.Ollama.Golden.Embed qualified as GoldenEmbed+import Test.Ollama.Golden.Generate qualified as GoldenGenerate+import Test.Ollama.Golden.Models qualified as GoldenModels+import Test.Ollama.Property.Roundtrip qualified as PropertyRoundtrip+import Test.Ollama.Unit.Config qualified as UnitConfig+import Test.Ollama.Unit.Error qualified as UnitError+import Test.Ollama.Unit.MCP qualified as UnitMCP+import Test.Ollama.Unit.SchemaBuilder qualified as UnitSchemaBuilder+import Test.Ollama.Unit.SchemaDerive qualified as UnitSchemaDerive+import Test.Ollama.Unit.Testing qualified as UnitTesting+import Test.Ollama.Unit.Types qualified as UnitTypes 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)+    "ollama-haskell Pure Test Suite"+    [ UnitTypes.tests+    , UnitError.tests+    , UnitConfig.tests+    , UnitSchemaBuilder.tests+    , UnitSchemaDerive.tests+    , UnitTesting.testingTests+    , UnitMCP.tests+    , PropertyRoundtrip.tests+    , GoldenChat.tests+    , GoldenGenerate.tests+    , GoldenEmbed.tests+    , GoldenModels.tests     ]  main :: IO ()-main = do-  mRes <- Ollama.list-  case mRes of-    Nothing -> pure () -- Ollama is likely not running. Not running tests.-    Just _ -> defaultMain tests+main = defaultMain tests
+ test/Test/Ollama/Golden/Chat.hs view
@@ -0,0 +1,25 @@+module Test.Ollama.Golden.Chat (tests) where++import Data.Aeson (encode)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Ollama+import Test.Tasty+import Test.Tasty.Golden++tests :: TestTree+tests =+  testGroup+    "Golden JSON Serialization Tests"+    [ goldenVsString+        "ChatRequest JSON wire format matches golden fixture"+        "test/golden/chat_request.golden"+        (pure $ encode $ chatRequest "llama3.2" (userMessage "Why is the sky blue?" :| []))+    , goldenVsString+        "GenerateRequest JSON wire format matches golden fixture"+        "test/golden/generate_request.golden"+        (pure $ encode $ generateRequest "llama3.2" "Why is the sky blue?")+    , goldenVsString+        "EmbedRequest JSON wire format matches golden fixture"+        "test/golden/embed_request.golden"+        (pure $ encode $ embedRequest "nomic-embed-text" ["hello", "world"])+    ]
+ test/Test/Ollama/Golden/Embed.hs view
@@ -0,0 +1,16 @@+module Test.Ollama.Golden.Embed (tests) where++import Data.Aeson (encode)+import Ollama+import Test.Tasty+import Test.Tasty.Golden++tests :: TestTree+tests =+  testGroup+    "Embed Golden JSON Serialization Tests"+    [ goldenVsString+        "EmbedRequest golden serialization"+        "test/golden/embed_request.golden"+        (pure $ encode $ embedRequest "nomic-embed-text" ["hello", "world"])+    ]
+ test/Test/Ollama/Golden/Generate.hs view
@@ -0,0 +1,16 @@+module Test.Ollama.Golden.Generate (tests) where++import Data.Aeson (encode)+import Ollama+import Test.Tasty+import Test.Tasty.Golden++tests :: TestTree+tests =+  testGroup+    "Generate Golden JSON Serialization Tests"+    [ goldenVsString+        "GenerateRequest golden serialization"+        "test/golden/generate_request.golden"+        (pure $ encode $ generateRequest "llama3.2" "Why is the sky blue?")+    ]
+ test/Test/Ollama/Golden/Models.hs view
@@ -0,0 +1,16 @@+module Test.Ollama.Golden.Models (tests) where++import Data.Aeson (encode)+import Ollama+import Test.Tasty+import Test.Tasty.Golden++tests :: TestTree+tests =+  testGroup+    "Model Management Golden JSON Serialization Tests"+    [ goldenVsString+        "CreateRequest golden serialization"+        "test/golden/create_request.golden"+        (pure $ encode $ defaultCreateRequest "custom-model")+    ]
+ test/Test/Ollama/Property/Arbitrary.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.Ollama.Property.Arbitrary () where++import Data.Text (Text)+import Data.Text qualified as T+import Ollama+import Ollama.Types.Message qualified as M+import Test.QuickCheck++genNonEmptyText :: Gen Text+genNonEmptyText = T.pack <$> listOf1 (elements ['a' .. 'z'])++instance Arbitrary Role where+  arbitrary = elements [System, User, Assistant, M.Tool]++instance Arbitrary ModelName where+  arbitrary = ModelName <$> genNonEmptyText++instance Arbitrary Digest where+  arbitrary = Digest . ("sha256:" <>) <$> genNonEmptyText++instance Arbitrary Base64Image where+  arbitrary = Base64Image <$> genNonEmptyText++instance Arbitrary Duration where+  arbitrary = Duration <$> choose (1, 1000000000)++instance Arbitrary ThinkingLevel where+  arbitrary = elements [ThinkLow, ThinkMedium, ThinkHigh, ThinkMax]++instance Arbitrary Think where+  arbitrary =+    oneof+      [ pure ThinkEnabled+      , pure ThinkDisabled+      , ThinkLevel <$> arbitrary+      ]++instance Arbitrary Message where+  arbitrary =+    Message+      <$> arbitrary+      <*> genNonEmptyText+      <*> pure Nothing+      <*> pure Nothing+      <*> pure Nothing+      <*> pure Nothing++instance Arbitrary Format where+  arbitrary = pure JsonFormat
+ test/Test/Ollama/Property/Roundtrip.hs view
@@ -0,0 +1,34 @@+module Test.Ollama.Property.Roundtrip (tests) where++import Data.Aeson (decode, encode)+import Data.Text qualified as T+import Ollama+import Test.Ollama.Property.Arbitrary ()+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+  testGroup+    "Property & Roundtrip QuickCheck Tests"+    [ testProperty "Role JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(r :: Role) -> decode (encode r) === Just r+    , testProperty "Message JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(msg :: Message) -> decode (encode msg) === Just msg+    , testProperty "ModelName JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(m :: ModelName) -> decode (encode m) === Just m+    , testProperty "Think JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(t :: Think) -> decode (encode t) === Just t+    , testProperty "Digest JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(d :: Digest) -> decode (encode d) === Just d+    , testProperty "Duration JSON roundtrip: ∀ x. decode (encode x) == Just x" $+        \(dur :: Duration) -> decode (encode dur) === Just dur+    , testProperty "Idempotency property: ∀ x. encode (decoded x) == encode x" $+        \(msg :: Message) -> case decode (encode msg) :: Maybe Message of+          Nothing -> property False+          Just decoded -> encode decoded === encode msg+    , testProperty "Smart constructor invariant: mkModelName never returns empty ModelName" $+        \txt -> case mkModelName (T.pack txt) of+          Left err -> err === "Model name cannot be empty"+          Right (ModelName name) -> not (T.null name) === True+    ]
+ test/Test/Ollama/Unit/Config.hs view
@@ -0,0 +1,19 @@+module Test.Ollama.Unit.Config (tests) where++import Ollama.Client.Config+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Unit Config Tests"+    [ testCase "defaultConfig settings" $ do+        assertEqual "Default base URL" "http://127.0.0.1:11434" (configBaseUrl defaultConfig)+        assertEqual "Default timeout" 300 (configTimeout defaultConfig)+        assertEqual "Default retry policy" NoRetry (configRetry defaultConfig)+    , testCase "RetryPolicy smart constructors" $ do+        assertEqual "noRetry" NoRetry noRetry+        assertEqual "constantRetry" (ConstantRetry 3 1000000) (constantRetry 3 1000000)+        assertEqual "exponentialRetry" (ExponentialRetry 5 500000) (exponentialRetry 5 500000)+    ]
+ test/Test/Ollama/Unit/Error.hs view
@@ -0,0 +1,22 @@+module Test.Ollama.Unit.Error (tests) where++import Control.Exception (try)+import Ollama.Error+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Unit Error Tests"+    [ testCase "isRetryable correctly classifies transient vs non-transient errors" $ do+        assertBool "TimeoutError is retryable" (isRetryable TimeoutError)+        assertBool "ApiError is not retryable" (not $ isRetryable (ApiError 404 "Not Found"))+        assertBool "InvalidRequest is not retryable" (not $ isRetryable (InvalidRequest "Bad model"))+    , testCase "OllamaError Eq instance compares ApiError and TimeoutError" $ do+        assertEqual "ApiError equal" (ApiError 500 "Server Error") (ApiError 500 "Server Error")+        assertBool "ApiError not equal to TimeoutError" (ApiError 500 "Server Error" /= TimeoutError)+    , testCase "throwOllama raises OllamaError as an Exception" $ do+        res <- try (throwOllama TimeoutError) :: IO (Either OllamaError ())+        assertEqual "Caught thrown OllamaError" (Left TimeoutError) res+    ]
+ test/Test/Ollama/Unit/MCP.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Ollama.Unit.MCP (tests) where++import Data.Map.Strict qualified as Map+import MCP.Server.Types (+  Content (..),+  ContentImageData (..),+  ResourceContent (..),+  ToolDefinition (..),+  describedSchema,+  mkToolDefinition,+  parseURI,+  schema,+ )+import Ollama.MCP (+  SchemaType (..),+  mcpContentToToolOutput,+  mcpDefinitionToTool,+  schemaDescription,+  schemaShape,+  toolCallToMcpArgs,+  toolToMcpDefinition,+ )+import Ollama.Types.Tool (+  FunctionDef (..),+  FunctionParameters (..),+  Tool (..),+  ToolCall (..),+  ToolCallFunction (..),+ )+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Unit MCP Integration Tests (mcp-server)"+    [ testCase "toolToMcpDefinition converts Ollama Tool to mcp-server ToolDefinition" $ do+        let propMap =+              Map.fromList+                [ ("query", FunctionParameters "string" Nothing Nothing Nothing (Just "Search query") Nothing)+                , ("limit", FunctionParameters "integer" Nothing Nothing Nothing (Just "Max results") Nothing)+                ]+            params = FunctionParameters "object" (Just propMap) (Just ["query"]) Nothing Nothing Nothing+            ollamaTool = Tool "function" $ FunctionDef "search" (Just "Search codebase") (Just params) Nothing+            mcpDef = toolToMcpDefinition ollamaTool++        toolDefinitionName mcpDef @?= "search"+        toolDefinitionDescription mcpDef @?= "Search codebase"+        case schemaShape (toolDefinitionInputSchema mcpDef) of+          SchemaObject props req -> do+            req @?= ["query"]+            length props @?= 2+            case lookup "query" props of+              Just s -> do+                schemaDescription s @?= Just "Search query"+                schemaShape s @?= SchemaString Nothing+              Nothing -> assertFailure "Expected query in props"+          _ -> assertFailure "Expected SchemaObject"+    , testCase "mcpDefinitionToTool converts mcp-server ToolDefinition to Ollama Tool" $ do+        let props =+              [ ("path", describedSchema "File path" (SchemaString Nothing))+              , ("content", describedSchema "File content" (SchemaString Nothing))+              ]+            s = schema (SchemaObject props ["path", "content"])+            mcpDef = mkToolDefinition "write_file" "Write file to disk" s+            ollamaTool = mcpDefinitionToTool mcpDef++        toolType ollamaTool @?= "function"+        let fn = toolFunction ollamaTool+        fnName fn @?= "write_file"+        fnDescription fn @?= Just "Write file to disk"+        case fnParameters fn of+          Just FunctionParameters {..} -> do+            fpType @?= "object"+            fpRequired @?= Just ["path", "content"]+            case fpProperties of+              Just pm -> Map.member "path" pm @?= True+              Nothing -> assertFailure "Expected properties"+          Nothing -> assertFailure "Expected parameters"+    , testCase "toolCallToMcpArgs converts Ollama ToolCall to mcp-server argument pairs" $ do+        let call = ToolCall (ToolCallFunction "greet" (Map.fromList [("name", "Alice")]))+            (fn, args) = toolCallToMcpArgs call+        fn @?= "greet"+        lookup "name" args @?= Just "Alice"+    , testCase "mcpContentToToolOutput extracts text from mcp-server Content" $ do+        let textContent = ContentText "Execution output"+        mcpContentToToolOutput textContent @?= "Execution output"++        let imgContent = ContentImage (ContentImageData "base64..." "image/png")+        mcpContentToToolOutput imgContent @?= "[Image: image/png]"++        case parseURI "file:///workspace/test.txt" of+          Just uri -> do+            let resContent = ContentEmbeddedResource (ResourceText uri "text/plain" "file contents")+            mcpContentToToolOutput resContent @?= "[Resource: file:///workspace/test.txt]"+          Nothing -> assertFailure "Failed to parse URI"+    ]
+ test/Test/Ollama/Unit/SchemaBuilder.hs view
@@ -0,0 +1,33 @@+module Test.Ollama.Unit.SchemaBuilder (tests) where++import Data.Aeson (decode, encode)+import Ollama.Types.Format+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Unit SchemaBuilder DSL Tests"+    [ testCase "Build object schema with required and optional fields" $ do+        let builder =+              emptyObject+                |+ ("name", JString)+                |+ ("age", JInteger)+                |+ ("is_student", JBoolean)+                |! "name"+            sch = buildSchema builder+            encoded = encode sch+        assertBool "Non-empty JSON schema" (not $ null $ show encoded)+    , testCase "Build array schema" $ do+        let itemType = arrayOf JString+            builder = emptyObject |+ ("items", itemType)+            sch = buildSchema builder+            encoded = encode sch+        assertBool "Non-empty array schema" (not $ null $ show encoded)+    , testCase "SchemaFormat wrapping & JSON roundtrip" $ do+        let builder = emptyObject |+ ("count", JInteger) |! "count"+            sch = buildSchema builder+            fmt = SchemaFormat sch+        assertEqual "SchemaFormat JSON roundtrip check" (Just fmt) (decode $ encode fmt)+    ]
+ test/Test/Ollama/Unit/SchemaDerive.hs view
@@ -0,0 +1,170 @@+module Test.Ollama.Unit.SchemaDerive (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import GHC.Generics (Generic)+import Ollama.Types.Format+import Test.Tasty+import Test.Tasty.HUnit++-- ---------------------------------------------------------------------------+-- Test types+-- ---------------------------------------------------------------------------++data SimplePerson = SimplePerson+  { name :: Text+  , age :: Int+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema)++data PersonWithOptional = PersonWithOptional+  { personName :: Text+  , personAge :: Int+  , personNickname :: Maybe Text+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema)++data Address = Address+  { city :: Text+  , zipCode :: Text+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema, ToJsonType)++data PersonWithAddress = PersonWithAddress+  { fullName :: Text+  , homeAddress :: Address+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema)++data PersonWithHobbies = PersonWithHobbies+  { hobbyName :: Text+  , hobbies :: [Text]+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema)++data Color = Red | Green | Blue+  deriving stock (Generic)+  deriving anyclass (ToSchema)++data PersonWithMaybeInt = PersonWithMaybeInt+  { pmName :: Text+  , pmScore :: Maybe Int+  }+  deriving stock (Generic)+  deriving anyclass (ToSchema)++-- ---------------------------------------------------------------------------+-- Tests+-- ---------------------------------------------------------------------------++tests :: TestTree+tests =+  testGroup+    "Unit SchemaDerive Tests"+    [ testSimpleRecord+    , testOptionalFields+    , testNestedRecord+    , testArrayFields+    , testEnumType+    , testMaybeUnwrapsType+    , testSchemaForAlias+    , testFormatFor+    , testMatchesManualSchema+    ]++testSimpleRecord :: TestTree+testSimpleRecord = testCase "Simple record produces correct schema" $ do+  let schema = schemaFor @SimplePerson+      props = schemaProperties schema+      req = schemaRequired schema+  assertEqual "Has 'name' property" (Just (Property JString)) (Map.lookup "name" props)+  assertEqual "Has 'age' property" (Just (Property JInteger)) (Map.lookup "age" props)+  assertEqual "Has 2 properties" 2 (Map.size props)+  assertBool "'name' is required" ("name" `elem` req)+  assertBool "'age' is required" ("age" `elem` req)+  assertEqual "2 required fields" 2 (length req)++testOptionalFields :: TestTree+testOptionalFields = testCase "Maybe fields are not required" $ do+  let schema = schemaFor @PersonWithOptional+      props = schemaProperties schema+      req = schemaRequired schema+  assertEqual "Has 3 properties" 3 (Map.size props)+  assertEqual+    "'personNickname' maps to JString"+    (Just (Property JString))+    (Map.lookup "personNickname" props)+  assertBool "'personName' is required" ("personName" `elem` req)+  assertBool "'personAge' is required" ("personAge" `elem` req)+  assertBool "'personNickname' is NOT required" ("personNickname" `notElem` req)+  assertEqual "2 required fields" 2 (length req)++testNestedRecord :: TestTree+testNestedRecord = testCase "Nested record becomes JObject" $ do+  let schema = schemaFor @PersonWithAddress+      props = schemaProperties schema+  case Map.lookup "homeAddress" props of+    Just (Property (JObject innerSchema)) -> do+      let innerProps = schemaProperties innerSchema+      assertEqual "Inner has 'city'" (Just (Property JString)) (Map.lookup "city" innerProps)+      assertEqual "Inner has 'zipCode'" (Just (Property JString)) (Map.lookup "zipCode" innerProps)+    other -> assertFailure $ "Expected JObject for homeAddress, got: " <> show other++testArrayFields :: TestTree+testArrayFields = testCase "List fields become JArray" $ do+  let schema = schemaFor @PersonWithHobbies+      props = schemaProperties schema+  assertEqual+    "'hobbies' maps to JArray JString"+    (Just (Property (JArray JString)))+    (Map.lookup "hobbies" props)++testEnumType :: TestTree+testEnumType = testCase "Simple enum produces schema with constructor names" $ do+  let schema = schemaFor @Color+      req = schemaRequired schema+  -- Enum constructors are stored in required list (as enum values)+  assertBool "Contains 'red'" ("red" `elem` req)+  assertBool "Contains 'green'" ("green" `elem` req)+  assertBool "Contains 'blue'" ("blue" `elem` req)+  assertEqual "3 enum values" 3 (length req)+  assertEqual "No properties" 0 (Map.size $ schemaProperties schema)++testMaybeUnwrapsType :: TestTree+testMaybeUnwrapsType = testCase "Maybe Int field maps to JInteger" $ do+  let schema = schemaFor @PersonWithMaybeInt+      props = schemaProperties schema+  assertEqual "'pmScore' maps to JInteger" (Just (Property JInteger)) (Map.lookup "pmScore" props)++testSchemaForAlias :: TestTree+testSchemaForAlias = testCase "schemaFor is equivalent to toSchema" $ do+  let s1 = schemaFor @SimplePerson+      s2 = toSchema @SimplePerson+  assertEqual "schemaFor == toSchema" s1 s2++testFormatFor :: TestTree+testFormatFor = testCase "formatFor wraps in SchemaFormat" $ do+  let fmt = formatFor @SimplePerson+      expected = SchemaFormat (schemaFor @SimplePerson)+  assertEqual "formatFor wraps schema" expected fmt++testMatchesManualSchema :: TestTree+testMatchesManualSchema = testCase "Derived schema matches manual DSL schema" $ do+  let derived = schemaFor @SimplePerson+      manual =+        buildSchema $+          emptyObject+            |+ ("name", JString)+            |+ ("age", JInteger)+            |!! ["name", "age"]+  assertEqual "Properties match" (schemaProperties manual) (schemaProperties derived)+  -- Required fields should contain the same elements (order may differ)+  let derivedReq = schemaRequired derived+      manualReq = schemaRequired manual+  assertBool "All derived required fields in manual" (all (`elem` manualReq) derivedReq)+  assertBool "All manual required fields in derived" (all (`elem` derivedReq) manualReq)
+ test/Test/Ollama/Unit/Testing.hs view
@@ -0,0 +1,87 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++{- |+Module      : Test.Ollama.Unit.Testing+Copyright   : (c) 2024-2026 Tushar Adhatrao+License     : MIT+Maintainer  : tusharadhatrao@gmail.com+Stability   : stable+Portability : portable++Unit tests for Ollama.Testing mock client and helper functions.++@since 1.0.0.0+-}+module Test.Ollama.Unit.Testing (testingTests) where++import Data.Aeson (encode)+import Data.ByteString.Lazy qualified as LBS+import Data.List.NonEmpty (NonEmpty ((:|)))+import Ollama.API.Chat (ChatResponse (..), chat, chatRequest)+import Ollama.API.Embed (+  EmbedResponse (..),+  EmbeddingsRequest (..),+  EmbeddingsResponse (..),+  embed,+  embedRequest,+  embeddings,+ )+import Ollama.API.Generate (GenerateResponse (..), generate, generateRequest)+import Ollama.API.Models (ListResponse (..), listModels)+import Ollama.Testing (+  mockChatResponse,+  mockEmbedResponse,+  mockGenerateResponse,+  mockListModelsResponse,+  withMockClient,+ )+import Ollama.Types.Common (ModelName (..))+import Ollama.Types.Message (userMessage)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++testingTests :: TestTree+testingTests =+  testGroup+    "Unit Testing Infrastructure Tests"+    [ testCase "Mock generate response" $ do+        let respPayload = mockGenerateResponse (ModelName "llama3.2") "Sky is blue"+            encoded = encode respPayload+        withMockClient (LBS.toStrict encoded) $ \client -> do+          res <- generate client (generateRequest (ModelName "llama3.2") "Why?")+          case res of+            Left err -> fail $ "Expected success, got: " <> show err+            Right resp -> assertEqual "Matching text" "Sky is blue" (grResponse resp)+    , testCase "Mock chat response" $ do+        let respPayload = mockChatResponse (ModelName "llama3.2") "Hello there"+            encoded = encode respPayload+        withMockClient (LBS.toStrict encoded) $ \client -> do+          res <- chat client (chatRequest (ModelName "llama3.2") (userMessage "Hi" :| []))+          case res of+            Left err -> fail $ "Expected success, got: " <> show err+            Right resp -> assertEqual "Matching model" (ModelName "llama3.2") (crModel resp)+    , testCase "Mock embed response" $ do+        let respPayload = mockEmbedResponse (ModelName "nomic") [[0.1, 0.2]]+            encoded = encode respPayload+        withMockClient (LBS.toStrict encoded) $ \client -> do+          res <- embed client (embedRequest (ModelName "nomic") ["test"])+          case res of+            Left err -> fail $ "Expected success, got: " <> show err+            Right resp -> assertEqual "Matching embeddings" [[0.1, 0.2]] (erEmbeddings resp)+    , testCase "Mock deprecated embeddings endpoint" $ do+        let respPayload = EmbeddingsResponse [0.5, 0.6]+            encoded = encode respPayload+        withMockClient (LBS.toStrict encoded) $ \client -> do+          res <- embeddings client (EmbeddingsRequest (ModelName "nomic") "test" Nothing Nothing)+          case res of+            Left err -> fail $ "Expected success, got: " <> show err+            Right resp -> assertEqual "Matching embedding" [0.5, 0.6] (ebrEmbedding resp)+    , testCase "Mock list models response" $ do+        let respPayload = mockListModelsResponse [ModelName "llama3.2", ModelName "nomic"]+            encoded = encode respPayload+        withMockClient (LBS.toStrict encoded) $ \client -> do+          res <- listModels client+          case res of+            Left err -> fail $ "Expected success, got: " <> show err+            Right resp -> assertEqual "Matching count" 2 (length (models resp))+    ]
+ test/Test/Ollama/Unit/Types.hs view
@@ -0,0 +1,72 @@+module Test.Ollama.Unit.Types (tests) where++import Conduit (yield)+import Data.Aeson (decode, encode)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Time (getCurrentTime)+import Ollama+import Ollama.Types.Message qualified as M+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Unit Types & API Tests"+    [ testCase "ModelName smart constructor validation" $ do+        assertEqual "Empty name invalid" (Left "Model name cannot be empty") (mkModelName "")+        assertEqual "Valid name" (Right "llama3.2") (mkModelName "llama3.2")+    , testCase "GenerateRequest smart constructor" $ do+        let req = generateRequest "llama3.2" "Hello world"+        assertEqual "Model match" (ModelName "llama3.2") (genModel req)+        assertEqual "Prompt match" "Hello world" (genPrompt req)+        assertEqual "Stream default" (Just False) (genStream req)+    , testCase "ChatRequest smart constructor" $ do+        let msg = userMessage "Hi"+            req = chatRequest "llama3.2" (msg :| [])+        assertEqual "Model match" (ModelName "llama3.2") (chatModel req)+        assertEqual "Messages length" 1 (length (chatMessages req))+    , testCase "EmbedRequest smart constructor" $ do+        let req = embedRequest "nomic-embed-text" ["hello", "world"]+        assertEqual "Model match" (ModelName "nomic-embed-text") (embModel req)+        assertEqual "Input match" (Right ["hello", "world"]) (embInput req)+    , testCase "CreateRequest smart constructor" $ do+        let req = defaultCreateRequest "custom-model"+        assertEqual "Model match" (ModelName "custom-model") (crqModel req)+    , testCase "Role JSON roundtrip" $ do+        assertEqual "User role" (Just User) (decode (encode User))+        assertEqual "Assistant role" (Just Assistant) (decode (encode Assistant))+        assertEqual "System role" (Just System) (decode (encode System))+        assertEqual "Tool role" (Just M.Tool) (decode (encode M.Tool))+    , testCase "InMemoryStore operations" $ do+        store <- initInMemoryStore+        now <- getCurrentTime+        let conv =+              Conversation+                { conversationId = "c1"+                , messages = [userMessage "hi"]+                , model = "llama3.2"+                , createdAt = now+                , lastUpdated = now+                }+        saveConversationInMemory store conv+        mLoaded <- loadConversationInMemory store "c1"+        assertEqual "Load conversation" (Just conv) mLoaded++        allConvs <- listConversationsInMemory store+        assertEqual "List conversations" [conv] allConvs++        deleted <- deleteConversationInMemory store "c1"+        assertBool "Delete succeeded" deleted++        mLoadedAfter <- loadConversationInMemory store "c1"+        assertEqual "Load after delete" Nothing mLoadedAfter+    , testCase "Streaming collectStream helper" $ do+        let mockStream = mapM_ yield [1 .. 5 :: Int]+        items <- collectStream mockStream+        assertEqual "Collected list" [1, 2, 3, 4, 5] items+    , testCase "Streaming foldStream helper" $ do+        let mockStream = mapM_ yield [1 .. 5 :: Int]+        sumVal <- foldStream (+) 0 mockStream+        assertEqual "Folded sum" 15 sumVal+    ]