├── .github └── workflows │ └── haskell.yaml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── default.nix ├── examples ├── ollama-example │ ├── .gitignore │ ├── CHANGELOG.md │ ├── LICENSE │ ├── README.md │ ├── Setup.hs │ ├── app │ │ └── Main.hs │ ├── knowledge_base.json │ ├── ollama-example.cabal │ ├── package.yaml │ ├── src │ │ └── Example │ │ │ ├── ChatConversation.hs │ │ │ ├── ChatStructuredOutput.hs │ │ │ ├── ChatStructuredOutputImage.hs │ │ │ ├── ChatWithImage.hs │ │ │ ├── ChatWithToolCall.hs │ │ │ ├── Embeddings.hs │ │ │ ├── GenerateStream.hs │ │ │ ├── GenerateThinking.hs │ │ │ ├── GenerateWithConfig.hs │ │ │ ├── GenerateWithModelOptions.hs │ │ │ ├── KnowledgeApp.hs │ │ │ ├── List.hs │ │ │ ├── SimpleChat.hs │ │ │ └── SimpleGenerate.hs │ ├── stack.yaml │ ├── stack.yaml.lock │ └── test │ │ └── Spec.hs └── sample.png ├── fourmolu.yaml ├── makefile ├── ollama-haskell.cabal ├── package.yaml ├── src ├── Data │ └── Ollama │ │ ├── Chat.hs │ │ ├── Common │ │ ├── Config.hs │ │ ├── Error.hs │ │ ├── SchemaBuilder.hs │ │ ├── Types.hs │ │ └── Utils.hs │ │ ├── Conversation.hs │ │ ├── Copy.hs │ │ ├── Create.hs │ │ ├── Delete.hs │ │ ├── Embeddings.hs │ │ ├── Generate.hs │ │ ├── List.hs │ │ ├── Load.hs │ │ ├── Ps.hs │ │ ├── Pull.hs │ │ ├── Push.hs │ │ └── Show.hs └── Ollama.hs ├── stack-lts-19.33.yaml ├── stack-lts-19.33.yaml.lock ├── stack-lts-20.26.yaml ├── stack-lts-20.26.yaml.lock ├── stack-lts-21.25.yaml ├── stack-lts-21.25.yaml.lock ├── stack-lts-22.43.yaml ├── stack-lts-22.43.yaml.lock ├── stack-lts-23.19.yaml ├── stack-lts-23.19.yaml.lock ├── stack.yaml ├── stack.yaml.lock └── test ├── Main.hs └── Test └── Ollama ├── Chat.hs ├── Embedding.hs ├── Generate.hs └── Show.hs /.github/workflows/haskell.yaml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | pull_request: 7 | branches: [ "main" ] 8 | 9 | permissions: 10 | contents: read 11 | 12 | jobs: 13 | generate: 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@v4 17 | - id: generate 18 | uses: freckle/stack-action/generate-matrix@v5 19 | outputs: 20 | stack-yamls: ${{ steps.generate.outputs.stack-yamls }} 21 | 22 | build: 23 | needs: generate 24 | strategy: 25 | matrix: 26 | stack-yaml: ${{ fromJSON(needs.generate.outputs.stack-yamls) }} 27 | fail-fast: false 28 | 29 | runs-on: ubuntu-22.04 30 | defaults: 31 | run: 32 | shell: bash 33 | 34 | steps: 35 | - name: Copy repo into actions 36 | uses: actions/checkout@v4 37 | 38 | - name: install dependancies, build and test stack project. 39 | uses: freckle/stack-action@v5 40 | with: 41 | stack-arguments: --stack-yaml ${{ matrix.stack-yaml }} 42 | test: false 43 | 44 | tests: 45 | needs: build 46 | 47 | runs-on: ubuntu-22.04 48 | defaults: 49 | run: 50 | shell: bash 51 | 52 | steps: 53 | - name: Copy repo into actions 54 | uses: actions/checkout@v4 55 | 56 | - name: Installing ollama 57 | uses: pydantic/ollama-action@v3 58 | with: 59 | model: gemma3:latest 60 | 61 | - name: Installing ollama 62 | uses: pydantic/ollama-action@v3 63 | with: 64 | model: qwen3:0.6b 65 | 66 | - name: Warming up ollama models 67 | run: | 68 | ollama run gemma3 "Hey, how are you?" 69 | ollama run qwen3:0.6b "Hey, how are you?" 70 | 71 | - name: install dependancies, build and test stack project. 72 | uses: freckle/stack-action@v5 73 | 74 | build-examples: 75 | needs: tests 76 | 77 | runs-on: ubuntu-22.04 78 | defaults: 79 | run: 80 | shell: bash 81 | 82 | steps: 83 | - name: Copy repo into actions 84 | uses: actions/checkout@v4 85 | 86 | - name: install dependancies, build and test stack project. 87 | uses: freckle/stack-action@v5 88 | with: 89 | working-directory: "./examples/ollama-example" 90 | test: false 91 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | .stack-work/ 3 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for ollama-haskell 2 | 3 | ## Unreleased 4 | 5 | ## 0.2.0.0 -- 2025-06-05 6 | 7 | * Added stack matrix to ensure lib is buildable from lts-19.33 8 | * Made parameters & template fields optional in `ShowModelResponse`. 9 | * Added extra parameters fields in `ModelInfo`. 10 | * Added strict annotations for all fields. 11 | * Fixed ToJSON instance for delete model request body. 12 | * Removed duplicate code by using unified `withOllamaRequest` function for all API calls. 13 | * Added unified config type `OllamaConfig` to hold common configuration options. 14 | * Added validation for generate and chat functions to ensure required fields are present. 15 | * Added convience functions for generating Message and ToolCall types. 16 | * Added thinking field for chat and generate function. 17 | * Added ModelOptions type to encapsulate model options. 18 | * Added get ollama version function. 19 | * Added Common Manager, Callback functions and retry option in OllamaConfig. 20 | * Fixed tool_calls. 21 | * Added MonadIO versions of api functions. 22 | * Added more comprehensive error handling for API calls. 23 | * Added more comprehensive test cases for all functions. 24 | * Added schema builder for passing json format for structured output. 25 | 26 | ## 0.1.3.0 -- 2025-03-25 27 | 28 | * Added options, tools and tool_calls fields in chat and generate. 29 | * Exported EmbeddingResponse. 30 | * Added Format argument in chat and generate function for structured output. 31 | 32 | ## 0.1.2.0 -- 2024-11-20 33 | 34 | * Added hostUrl and responseTimeOut options in generate function. 35 | * Added hostUrl and responseTimeOut options in chat function. 36 | 37 | ## 0.1.1.3 -- 2024-11-08 38 | 39 | * Increase response timeout to 15 minutes 40 | * Added encodeImage utility function that converts image filePath to base64 image data. 41 | * Added generateJson and chatJson. High level function to return response in Haskell type. 42 | 43 | ## 0.1.0.3 -- 2024-11-05 44 | 45 | * Moving to stack instead of cabal. 46 | 47 | ## 0.1.0.2 -- 2024-10-18 48 | 49 | * Increased response timeout time for chat function. 50 | 51 | ## 0.1.0.1 -- 2024-10-18 52 | 53 | * Renaming Lib.hs to OllamaExamples.hs as it was conflicting `Lib.hs` name 54 | 55 | ## 0.1.0.0 -- YYYY-mm-dd 56 | 57 | * First version. Released on an unsuspecting world. 58 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2024 Tushar Adhatrao 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 🦙 Ollama Haskell 2 | 3 | **`ollama-haskell`** is an unofficial Haskell client for [Ollama](https://ollama.com), inspired by [`ollama-python`](https://github.com/ollama/ollama-python). It enables interaction with locally running LLMs through the Ollama HTTP API — directly from Haskell. 4 | 5 | --- 6 | 7 | ## ✨ Features 8 | 9 | * 💬 Chat with models 10 | * ✍️ Text generation (with streaming) 11 | * ✅ Chat with structured messages and tools 12 | * 🧠 Embeddings 13 | * 🧰 Model management (list, pull, push, show, delete) 14 | * 🗃️ In-memory conversation history 15 | * ⚙️ Configurable timeouts, retries, streaming handlers 16 | 17 | --- 18 | 19 | ## ⚡ Quick Example 20 | 21 | ```haskell 22 | {-# LANGUAGE OverloadedStrings #-} 23 | module Main where 24 | 25 | import Data.Ollama.Generate 26 | import qualified Data.Text.IO as T 27 | 28 | main :: IO () 29 | main = do 30 | let ops = 31 | defaultGenerateOps 32 | { modelName = "gemma3" 33 | , prompt = "What is the meaning of life?" 34 | } 35 | eRes <- generate ops Nothing 36 | case eRes of 37 | Left err -> putStrLn $ "Something went wrong: " ++ show err 38 | Right r -> do 39 | putStr "LLM response: " 40 | T.putStrLn (genResponse r) 41 | ``` 42 | 43 | --- 44 | 45 | ## 📦 Installation 46 | 47 | Add to your `.cabal` file: 48 | 49 | ```cabal 50 | build-depends: 51 | base >=4.7 && <5, 52 | ollama-haskell 53 | ``` 54 | 55 | Or use with `stack`/`nix-shell`. 56 | 57 | --- 58 | 59 | ## 📚 More Examples 60 | 61 | See [`examples/OllamaExamples.hs`](examples/OllamaExamples.hs) for: 62 | 63 | * Chat with conversation memory 64 | * Structured JSON output 65 | * Embeddings 66 | * Tool/function calling 67 | * Multimodal input 68 | * Streaming and non-streaming variants 69 | 70 | --- 71 | 72 | ## 🛠 Prerequisite 73 | 74 | Make sure you have [Ollama installed and running locally](https://ollama.com/download). Run `ollama pull llama3` to download a model. 75 | 76 | --- 77 | 78 | ## 🧪 Dev & Nix Support 79 | 80 | Use Nix: 81 | 82 | ```bash 83 | nix-shell 84 | ``` 85 | 86 | This will install `stack` and Ollama. 87 | 88 | --- 89 | 90 | ## 👨‍💻 Author 91 | 92 | Created and maintained by [@tusharad](https://github.com/tusharad). PRs and feedback are welcome! 93 | 94 | --- 95 | 96 | ## 🤝 Contributing 97 | 98 | Have ideas or improvements? Feel free to [open an issue](https://github.com/tusharad/ollama-haskell/issues) or submit a PR! 99 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | nixpkgs = fetchTarball { 3 | url = "https://github.com/NixOS/nixpkgs/tarball/nixos-unstable"; 4 | }; 5 | pkgs = import nixpkgs { config = {}; overlays = []; }; 6 | ollama = pkgs.ollama; 7 | haskellPkgs = pkgs.haskell.packages.ghc984; 8 | stack = pkgs.haskellPackages.stack; 9 | in 10 | pkgs.mkShell { 11 | name = "ollama-haskell-dev"; 12 | buildInputs = [ 13 | pkgs.ollama 14 | stack 15 | haskellPkgs.ghc 16 | pkgs.zlib # Common dependency for Haskell projects 17 | pkgs.pkg-config # Useful for native dependencies 18 | ]; 19 | 20 | shellHook = '' 21 | export STACK_YAML=stack.yaml 22 | export NIX_GHC="${haskellPkgs.ghc}/bin/ghc" 23 | export NIX_GHCPKG="${haskellPkgs.ghc}/bin/ghc-pkg" 24 | export NIX_GHC_LIBDIR="${haskellPkgs.ghc}/lib/ghc" 25 | echo "Development environment for ollama-haskell ready!" 26 | echo "Run 'stack build' to build the project." 27 | ''; 28 | } 29 | -------------------------------------------------------------------------------- /examples/ollama-example/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /examples/ollama-example/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `ollama-example` 2 | 3 | All notable changes to this project will be documented in this file. 4 | 5 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 6 | and this project adheres to the 7 | [Haskell Package Versioning Policy](https://pvp.haskell.org/). 8 | 9 | ## Unreleased 10 | 11 | ## 0.1.0.0 - YYYY-MM-DD 12 | -------------------------------------------------------------------------------- /examples/ollama-example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2025 tushar 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /examples/ollama-example/README.md: -------------------------------------------------------------------------------- 1 | # Ollama Haskell Examples 2 | 3 | This project provides example Haskell code for interacting with [Ollama](https://ollama.com) using its HTTP API. These examples demonstrate how to chat with models, generate text, use structured output, handle multimodal input, and more — all from Haskell. 4 | 5 | > **Note**: These examples require that the Ollama server is running locally. See [Ollama API Docs](https://github.com/ollama/ollama/blob/main/docs/api.md) for full API reference. 6 | 7 | ## ▶️ Running Examples 8 | 9 | You can run individual examples using `stack` or `cabal`. For example: 10 | 11 | ```sh 12 | stack run 13 | ``` 14 | 15 | ## ✨ Examples Overview 16 | 17 | ### 💬 Chat - Chat with a model 18 | 19 | * [Basic chat example](./src/Example/SimpleChat.hs) 20 | * [Chat with multi-turn conversation](./src/Example/ChatConversation.hs) 21 | * [Chat using function/tool call](./src/Example/ChatWithToolCall.hs) 22 | 23 | ### 📝 Generate - Generate text with a model 24 | 25 | * [Simple text generation](./src/Example/SimpleGenerate.hs) 26 | * [Streamed text generation](./src/Example/GenerateStream.hs) 27 | * [Text generation with thinking mode](./src/Example/GenerateThinking.hs) 28 | * [Text generation with custom config](./src/Example/GenerateWithConfig.hs) 29 | * [Text generation with model options](./src/Example/GenerateWithModelOptions.hs) 30 | 31 | ### 🧰 Structured Outputs 32 | 33 | * [Structured output from chat](./src/Example/ChatStructuredOutput.hs) 34 | * [Structured output including image](./src/Example/ChatStructuredOutputImage.hs) 35 | 36 | ### 🖼️ Multimodal - Chat with images 37 | 38 | * [Chat with image input](./src/Example/ChatWithImage.hs) 39 | 40 | ### 🧠 Embeddings 41 | 42 | * [Generate embeddings](./src/Example/Embeddings.hs) 43 | 44 | ### 📚 Knowledge Integration 45 | 46 | * [Knowledge-based question answering](./src/Example/KnowledgeApp.hs) 47 | 48 | ### 📋 Model Management 49 | 50 | * [List available models](./src/Example/List.hs) 51 | 52 | ## 🛠 Requirements 53 | 54 | * [Haskell Stack](https://docs.haskellstack.org/en/stable/README/) or Cabal 55 | * [Ollama](https://ollama.com/) installed and running locally 56 | 57 | ## 📄 License 58 | 59 | This project is licensed under the terms of the [MIT License](LICENSE). 60 | -------------------------------------------------------------------------------- /examples/ollama-example/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/ollama-example/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | -- import qualified Example.KnowledgeApp as KA 4 | import qualified Example.GenerateThinking as Ex 5 | 6 | main :: IO () 7 | main = do 8 | Ex.runApp 9 | -------------------------------------------------------------------------------- /examples/ollama-example/knowledge_base.json: -------------------------------------------------------------------------------- 1 | {"nextId":4,"notes":[{"noteContent":"Try making: Thai green curry, homemade pasta, chocolate chip cookies","noteCreated":"2025-05-30T11:39:16.510634385Z","noteId":3,"noteModified":"2025-05-30T11:39:16.510634385Z","noteTags":["cooking","recipes","food"],"noteTitle":"Recipe Ideas"},{"noteContent":"Books to read: Clean Code, Design Patterns, Haskell Programming from First Principles","noteCreated":"2025-05-30T11:39:16.50770053Z","noteId":2,"noteModified":"2025-05-30T11:39:16.50770053Z","noteTags":["books","learning","programming"],"noteTitle":"Reading List"},{"noteContent":"We need to complete the MVP by Q2. Key features include user authentication, data visualization, and reporting.","noteCreated":"2025-05-30T11:39:16.507256692Z","noteId":1,"noteModified":"2025-05-30T11:39:16.507256692Z","noteTags":["work","project","planning"],"noteTitle":"Project Planning"}]} -------------------------------------------------------------------------------- /examples/ollama-example/ollama-example.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.38.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: ollama-example 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/tusharad/ollama-example#readme 11 | bug-reports: https://github.com/tusharad/ollama-example/issues 12 | author: tushar 13 | maintainer: tusharadhatrao@gmail.com 14 | copyright: 2025 tushar 15 | license: BSD-3-Clause 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | CHANGELOG.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/tusharad/ollama-example 25 | 26 | library 27 | exposed-modules: 28 | Example.ChatConversation 29 | Example.ChatStructuredOutput 30 | Example.ChatStructuredOutputImage 31 | Example.ChatWithImage 32 | Example.ChatWithToolCall 33 | Example.Embeddings 34 | Example.GenerateStream 35 | Example.GenerateThinking 36 | Example.GenerateWithConfig 37 | Example.GenerateWithModelOptions 38 | Example.KnowledgeApp 39 | Example.List 40 | Example.SimpleChat 41 | Example.SimpleGenerate 42 | other-modules: 43 | Paths_ollama_example 44 | autogen-modules: 45 | Paths_ollama_example 46 | hs-source-dirs: 47 | src 48 | ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints 49 | build-depends: 50 | aeson 51 | , base >=4.7 && <5 52 | , bytestring 53 | , containers 54 | , directory 55 | , filepath 56 | , ollama-haskell 57 | , scientific 58 | , text 59 | , time 60 | default-language: Haskell2010 61 | 62 | executable ollama-example-exe 63 | main-is: Main.hs 64 | other-modules: 65 | Paths_ollama_example 66 | autogen-modules: 67 | Paths_ollama_example 68 | hs-source-dirs: 69 | app 70 | 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 71 | build-depends: 72 | aeson 73 | , base >=4.7 && <5 74 | , bytestring 75 | , containers 76 | , directory 77 | , filepath 78 | , ollama-example 79 | , ollama-haskell 80 | , scientific 81 | , text 82 | , time 83 | default-language: Haskell2010 84 | 85 | test-suite ollama-example-test 86 | type: exitcode-stdio-1.0 87 | main-is: Spec.hs 88 | other-modules: 89 | Paths_ollama_example 90 | autogen-modules: 91 | Paths_ollama_example 92 | hs-source-dirs: 93 | test 94 | 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 95 | build-depends: 96 | aeson 97 | , base >=4.7 && <5 98 | , bytestring 99 | , containers 100 | , directory 101 | , filepath 102 | , ollama-example 103 | , ollama-haskell 104 | , scientific 105 | , text 106 | , time 107 | default-language: Haskell2010 108 | -------------------------------------------------------------------------------- /examples/ollama-example/package.yaml: -------------------------------------------------------------------------------- 1 | name: ollama-example 2 | version: 0.1.0.0 3 | github: "tusharad/ollama-example" 4 | license: BSD-3-Clause 5 | author: "tushar" 6 | maintainer: "tusharadhatrao@gmail.com" 7 | copyright: "2025 tushar" 8 | 9 | extra-source-files: 10 | - README.md 11 | - CHANGELOG.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | 24 | - base >= 4.7 && < 5 25 | - ollama-haskell 26 | - text 27 | - filepath 28 | - time 29 | - aeson 30 | - bytestring 31 | - directory 32 | - scientific 33 | - containers 34 | 35 | ghc-options: 36 | - -Wall 37 | - -Wcompat 38 | - -Widentities 39 | - -Wincomplete-record-updates 40 | - -Wincomplete-uni-patterns 41 | - -Wmissing-export-lists 42 | - -Wmissing-home-modules 43 | - -Wpartial-fields 44 | - -Wredundant-constraints 45 | 46 | library: 47 | source-dirs: src 48 | 49 | executables: 50 | ollama-example-exe: 51 | main: Main.hs 52 | source-dirs: app 53 | ghc-options: 54 | - -threaded 55 | - -rtsopts 56 | - -with-rtsopts=-N 57 | dependencies: 58 | - ollama-example 59 | 60 | tests: 61 | ollama-example-test: 62 | main: Spec.hs 63 | source-dirs: test 64 | ghc-options: 65 | - -threaded 66 | - -rtsopts 67 | - -with-rtsopts=-N 68 | dependencies: 69 | - ollama-example 70 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/ChatConversation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.ChatConversation (runApp) where 4 | 5 | import Data.List.NonEmpty (NonEmpty (..)) 6 | import qualified Data.List.NonEmpty as NE 7 | import Data.Ollama.Chat 8 | import qualified Data.Text.IO as T 9 | import System.IO (hFlush, stdout) 10 | 11 | 12 | repl :: NE.NonEmpty Message -> IO () 13 | repl msgList = do 14 | putStr "> " 15 | hFlush stdout 16 | userQuestion <- T.getLine 17 | let msgListWithUser = msgList `NE.appendList` [userMessage userQuestion] 18 | eRes <- chat (defaultChatOps {chatModelName = "gemma3", messages = msgListWithUser}) Nothing 19 | case eRes of 20 | Left err -> putStrLn $ "Something went wrong: " ++ show err 21 | Right r -> do 22 | case message r of 23 | Nothing -> putStrLn "Something went wrong" 24 | Just aiMessage -> do 25 | T.putStrLn $ content aiMessage 26 | repl (msgListWithUser `NE.appendList` [aiMessage]) 27 | 28 | runApp :: IO () 29 | runApp = repl (systemMessage "You are a chatbot" :| []) 30 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/ChatStructuredOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.ChatStructuredOutput (runApp) where 4 | 5 | import qualified Data.List.NonEmpty as NE 6 | import Data.Ollama.Chat 7 | import Data.Ollama.Common.SchemaBuilder 8 | import qualified Data.Text.IO as T 9 | 10 | {- 11 | # schema = {'type': 'object', 'properties': {'friends': {'type': 'array', 'items': {'type': 'object', 'properties': {'name': {'type': 'string'}, 'age': {'type': 'integer'}, 'is_available': {'type': 'boolean'}}, 'required': ['name', 'age', 'is_available']}}}, 'required': ['friends']} 12 | 13 | -} 14 | runApp :: IO () 15 | runApp = do 16 | let schema = 17 | buildSchema $ 18 | emptyObject 19 | |+ ( "friends" 20 | , JArray 21 | ( JObject 22 | ( buildSchema $ 23 | emptyObject 24 | |+ ("name", JString) 25 | |+ ("age", JNumber) 26 | |+ ("isAvailable", JBoolean) 27 | |! "name" 28 | |! "age" 29 | |! "isAvailable" 30 | ) 31 | ) 32 | ) 33 | 34 | let prompt = 35 | "I have two friends. The first is Ollama 22 years old busy saving the world," 36 | <> "and the second is Alonso 23 years old and wants to hang out." 37 | <> "Return a list of friends in JSON format" 38 | let messageList = NE.singleton (userMessage prompt) 39 | let ops = 40 | defaultChatOps 41 | { chatModelName = "gemma3" 42 | , messages = messageList 43 | , format = Just $ SchemaFormat schema 44 | } 45 | eRes <- chat ops Nothing 46 | case eRes of 47 | Left err -> putStrLn $ "Something went wrong: " ++ show err 48 | Right r -> do 49 | putStrLn "LLM response" 50 | case message r of 51 | Nothing -> putStrLn "Something went wrong" 52 | Just (Message _ res _ _ _) -> T.putStrLn res 53 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/ChatStructuredOutputImage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.ChatStructuredOutputImage (runApp) where 4 | 5 | import qualified Data.List.NonEmpty as NE 6 | import Data.Ollama.Chat 7 | import Data.Ollama.Common.SchemaBuilder 8 | import Data.Ollama.Common.Utils (encodeImage) 9 | import qualified Data.Text.IO as T 10 | 11 | runApp :: IO () 12 | runApp = do 13 | mbEncodedImage <- encodeImage "../sample.png" 14 | case mbEncodedImage of 15 | Nothing -> putStrLn "Failed to load image" 16 | Just encodedImage -> do 17 | let schema = 18 | buildSchema $ 19 | emptyObject 20 | |+ ("summary", JString) 21 | |+ ("text_color", JString) 22 | |+ ("background_color", JString) 23 | |! "summary" 24 | |! "background_color" 25 | 26 | let prompt = 27 | "Analyze this image and return a detailed JSON description including objects," 28 | <> "colors and any text detected. If you cannot determine certain details," 29 | <> " leave those fields empty." 30 | let userMsg = 31 | Message 32 | { role = User 33 | , content = prompt 34 | , images = Just [encodedImage] 35 | , tool_calls = Nothing 36 | , thinking = Nothing 37 | } 38 | let messageList = NE.singleton userMsg 39 | let ops = 40 | defaultChatOps 41 | { chatModelName = "gemma3" 42 | , messages = messageList 43 | , format = Just $ SchemaFormat schema 44 | } 45 | eRes <- chat ops Nothing 46 | case eRes of 47 | Left err -> putStrLn $ "Something went wrong: " ++ show err 48 | Right r -> do 49 | putStrLn "LLM response" 50 | case message r of 51 | Nothing -> putStrLn "Something went wrong" 52 | Just (Message _ res _ _ _) -> T.putStrLn res 53 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/ChatWithImage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.ChatWithImage (runApp) where 4 | 5 | import qualified Data.List.NonEmpty as NE 6 | import Data.Ollama.Chat 7 | import qualified Data.Text.IO as T 8 | import Data.Ollama.Common.Utils (encodeImage) 9 | 10 | runApp :: IO () 11 | runApp = do 12 | mbEncodedImage <- encodeImage "../sample.png" 13 | case mbEncodedImage of 14 | Nothing -> putStrLn "Failed to load image" 15 | Just encodedImage -> do 16 | let userMsg = Message { 17 | role = User 18 | , content = "What does this image say?" 19 | , images = Just [encodedImage] 20 | , tool_calls = Nothing 21 | , thinking = Nothing 22 | } 23 | let messageList = NE.singleton userMsg 24 | let ops = 25 | defaultChatOps 26 | { chatModelName = "gemma3" 27 | , messages = messageList 28 | } 29 | eRes <- chat ops Nothing 30 | case eRes of 31 | Left err -> putStrLn $ "Something went wrong: " ++ show err 32 | Right r -> do 33 | putStrLn "LLM response" 34 | case message r of 35 | Nothing -> putStrLn "Something went wrong" 36 | Just (Message _ res _ _ _) -> T.putStrLn res 37 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/ChatWithToolCall.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.ChatWithToolCall (runApp) where 4 | 5 | import Data.Aeson 6 | import qualified Data.List.NonEmpty as NE 7 | import qualified Data.Map as HM 8 | import Data.Ollama.Chat 9 | import Data.Scientific 10 | 11 | addTwoNumbers :: Int -> Int -> Int 12 | addTwoNumbers = (+) 13 | 14 | runApp :: IO () 15 | runApp = do 16 | let messageList = NE.singleton (userMessage "What is 23+46? (Use tool)") 17 | paramProp = 18 | HM.fromList 19 | [ ("a", FunctionParameters "number" Nothing Nothing Nothing) 20 | , ("b", FunctionParameters "number" Nothing Nothing Nothing) 21 | ] 22 | functionParams = 23 | FunctionParameters 24 | { parameterType = "object" 25 | , requiredParams = Just ["a", "b"] 26 | , parameterProperties = Just paramProp 27 | , additionalProperties = Just False 28 | } 29 | functionDef = 30 | FunctionDef 31 | { functionName = "addTwoNumbers" 32 | , functionDescription = Just "Add two numbers" 33 | , functionParameters = Just functionParams 34 | , functionStrict = Nothing 35 | } 36 | inputTool = 37 | InputTool 38 | { toolType = "function" 39 | , function = functionDef 40 | } 41 | ops = 42 | defaultChatOps 43 | { chatModelName = "qwen3:0.6b" 44 | , messages = messageList 45 | , tools = Just [inputTool] 46 | } 47 | eRes <- chat ops Nothing 48 | case eRes of 49 | Left err -> putStrLn $ "Error from chat: " ++ show err 50 | Right r -> do 51 | putStrLn "LLM response" 52 | case message r of 53 | Nothing -> putStrLn "Message not found from chat response" 54 | Just msg@(Message _ _ _ mbToolCalls _) -> do 55 | case mbToolCalls of 56 | Nothing -> putStrLn $ "No tool calls received from Message" <> show msg 57 | Just toolCallList -> do 58 | mapM_ executeFunction toolCallList 59 | 60 | convertToNumber :: Value -> Maybe Int 61 | convertToNumber (Number n) = toBoundedInteger n 62 | convertToNumber _ = Nothing 63 | 64 | executeFunction :: ToolCall -> IO () 65 | executeFunction (ToolCall func) = do 66 | if outputFunctionName func == "addTwoNumbers" 67 | then do 68 | case HM.lookup "a" (arguments func) >>= convertToNumber of 69 | Nothing -> putStrLn "Parameter a not found" 70 | Just firstNum_ -> do 71 | case HM.lookup "b" (arguments func) >>= convertToNumber of 72 | Nothing -> putStrLn "Parameter b not found" 73 | Just secondNum_ -> do 74 | let firstNum = firstNum_ 75 | let secondNum = secondNum_ 76 | let res = addTwoNumbers firstNum secondNum 77 | print ("result: " :: String, res) 78 | else 79 | putStrLn "Expected function name to be addTwoNumbers" 80 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/Embeddings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.Embeddings (runApp) where 4 | 5 | import Data.Ollama.Embeddings 6 | 7 | runApp :: IO () 8 | runApp = do 9 | eRes <- embedding "qwen3:0.6b" ["Hello World", "Nice to meet you"] 10 | case eRes of 11 | Left err -> putStrLn $ "Something went wrong: " ++ show err 12 | Right r -> do 13 | putStrLn "LLM response" 14 | print (respondedEmbeddings r) 15 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/GenerateStream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.GenerateStream (runApp) where 4 | 5 | import Data.Ollama.Generate 6 | import qualified Data.Text.IO as T 7 | import System.IO (hFlush, stdout) 8 | 9 | runApp :: IO () 10 | runApp = do 11 | let -- Callback to specify what to do with each response chunk 12 | streamHandler resp = do 13 | T.putStr $ genResponse resp 14 | hFlush stdout 15 | ops = 16 | defaultGenerateOps 17 | { modelName = "gemma3" 18 | , prompt = "What is the meaning of life?" 19 | , stream = Just streamHandler 20 | } 21 | eRes <- generate ops Nothing 22 | case eRes of 23 | Left err -> putStrLn $ "Something went wrong: " ++ show err 24 | Right _ -> putStrLn "LLM response completed" 25 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/GenerateThinking.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.GenerateThinking (runApp) where 4 | 5 | import Data.Ollama.Generate 6 | import qualified Data.Text.IO as T 7 | import Data.Maybe (fromMaybe) 8 | 9 | runApp :: IO () 10 | runApp = do 11 | let ops = 12 | defaultGenerateOps 13 | { modelName = "qwen3:0.6b" 14 | , prompt = "Why is sky blue?" 15 | , think = Just True 16 | } 17 | eRes <- generate ops Nothing 18 | case eRes of 19 | Left err -> putStrLn $ "Something went wrong: " ++ show err 20 | Right r -> do 21 | putStrLn "LLM response" 22 | T.putStrLn (genResponse r) 23 | putStrLn "LLM thinking" 24 | T.putStrLn (fromMaybe "" (thinking r)) 25 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/GenerateWithConfig.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.GenerateWithConfig (runApp) where 4 | 5 | import Data.Ollama.Generate 6 | import qualified Data.Text.IO as T 7 | 8 | runApp :: IO () 9 | runApp = do 10 | let ops = 11 | defaultGenerateOps 12 | { modelName = "gemma3" 13 | , prompt = "What is the meaning of life?" 14 | } 15 | let ollamaCfg = 16 | defaultOllamaConfig 17 | { timeout = 120 -- LLMs usally takes a lot of time for generation; 18 | -- this sets the timeout time for LLM response (in seconds); default 90 seconds 19 | , retryCount = Just 2 -- Retry 2 times after failing 20 | , retryDelay = Just 2 -- Wait 2 seconds before retrying 21 | } 22 | eRes <- generate ops (Just ollamaCfg) 23 | case eRes of 24 | Left err -> putStrLn $ "Something went wrong: " ++ show err 25 | Right r -> do 26 | putStrLn "LLM response" 27 | T.putStrLn (genResponse r) 28 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/GenerateWithModelOptions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.GenerateWithModelOptions (runApp) where 4 | 5 | import Data.Ollama.Generate 6 | import qualified Data.Text.IO as T 7 | 8 | runApp :: IO () 9 | runApp = do 10 | let modelOps = 11 | defaultModelOptions 12 | { numCtx = Just 10000 -- By default Ollama have a small context window 13 | , temperature = Just 0.8 14 | } 15 | 16 | let ops = 17 | defaultGenerateOps 18 | { modelName = "gemma3" 19 | , prompt = "What is the meaning of life?" 20 | , options = Just modelOps 21 | } 22 | eRes <- generate ops Nothing 23 | case eRes of 24 | Left err -> putStrLn $ "Something went wrong: " ++ show err 25 | Right r -> do 26 | putStrLn "LLM response" 27 | T.putStrLn (genResponse r) 28 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/KnowledgeApp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DeriveAnyClass #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | module Example.KnowledgeApp (runApp, exampleUsage) where 7 | 8 | import Data.Text (Text) 9 | import qualified Data.Text as T 10 | import qualified Data.Text.IO as TIO 11 | import Data.List.NonEmpty (NonEmpty(..)) 12 | import Control.Monad 13 | import System.Directory 14 | import Data.Time 15 | import GHC.Generics 16 | import Ollama 17 | import Data.Ollama.Chat 18 | import Data.Aeson 19 | import qualified Data.ByteString.Lazy as L 20 | 21 | data Note = Note 22 | { noteId :: !Int 23 | , noteTitle :: !Text 24 | , noteContent :: !Text 25 | , noteTags :: ![Text] 26 | , noteCreated :: !UTCTime 27 | , noteModified :: !UTCTime 28 | } deriving (Show, Eq, Generic, ToJSON, FromJSON) 29 | 30 | data KnowledgeBase = KnowledgeBase 31 | { notes :: ![Note] 32 | , nextId :: !Int 33 | } deriving (Show, Eq, Generic, ToJSON, FromJSON) 34 | 35 | data Command 36 | = AddNote Text Text [Text] 37 | | SearchNotes Text 38 | | ListNotes 39 | | AskQuestion Text 40 | | SummarizeNotes [Text] 41 | | Help 42 | | Quit 43 | deriving (Show, Eq) 44 | 45 | knowledgeBaseFile :: FilePath 46 | knowledgeBaseFile = "knowledge_base.json" 47 | 48 | loadKnowledgeBase :: IO KnowledgeBase 49 | loadKnowledgeBase = do 50 | exists <- doesFileExist knowledgeBaseFile 51 | if exists 52 | then do 53 | content <- L.readFile knowledgeBaseFile 54 | case decode content of 55 | Just kb -> return kb 56 | Nothing -> return emptyKnowledgeBase 57 | else return emptyKnowledgeBase 58 | 59 | saveKnowledgeBase :: KnowledgeBase -> IO () 60 | saveKnowledgeBase kb = L.writeFile knowledgeBaseFile (encode kb) 61 | 62 | emptyKnowledgeBase :: KnowledgeBase 63 | emptyKnowledgeBase = KnowledgeBase [] 1 64 | 65 | addNote :: Text -> Text -> [Text] -> KnowledgeBase -> IO KnowledgeBase 66 | addNote title content tags kb = do 67 | now <- getCurrentTime 68 | let note = Note 69 | { noteId = nextId kb 70 | , noteTitle = title 71 | , noteContent = content 72 | , noteTags = tags 73 | , noteCreated = now 74 | , noteModified = now 75 | } 76 | let newKb = kb { notes = note : notes kb, nextId = nextId kb + 1 } 77 | saveKnowledgeBase newKb 78 | putStrLn $ "✓ Added note: " ++ T.unpack title 79 | return newKb 80 | 81 | searchNotes :: Text -> KnowledgeBase -> IO [Note] 82 | searchNotes query kb = do 83 | let matchingNotes = filter (matchesQuery query) (notes kb) 84 | putStrLn $ "Found " ++ show (length matchingNotes) ++ " matching notes:" 85 | mapM_ printNotePreview matchingNotes 86 | return matchingNotes 87 | where 88 | matchesQuery q note = 89 | T.isInfixOf (T.toLower q) (T.toLower $ noteTitle note) || 90 | T.isInfixOf (T.toLower q) (T.toLower $ noteContent note) || 91 | any (T.isInfixOf (T.toLower q) . T.toLower) (noteTags note) 92 | 93 | listNotes :: KnowledgeBase -> IO () 94 | listNotes kb = do 95 | putStrLn $ "Total notes: " ++ show (length $ notes kb) 96 | mapM_ printNotePreview (take 10 $ notes kb) 97 | when (length (notes kb) > 10) $ 98 | putStrLn "... (showing first 10 notes)" 99 | 100 | printNotePreview :: Note -> IO () 101 | printNotePreview note = do 102 | putStrLn $ " [" ++ show (noteId note) ++ "] " ++ T.unpack (noteTitle note) 103 | putStrLn $ " Tags: " ++ T.unpack (T.intercalate ", " (noteTags note)) 104 | putStrLn $ " " ++ T.unpack (T.take 100 (noteContent note)) ++ "..." 105 | putStrLn "" 106 | 107 | getAnsweredMessage :: ChatResponse -> Maybe Text 108 | getAnsweredMessage ChatResponse{..} = do 109 | case message of 110 | Nothing -> Nothing 111 | Just Message{..} -> Just content 112 | 113 | askQuestion :: Text -> KnowledgeBase -> IO () 114 | askQuestion question kb = do 115 | putStrLn "🤔 Thinking..." 116 | 117 | let context = createContext kb 118 | print ("context is ":: String, context) 119 | let systemPrompt = "You are a helpful personal knowledge assistant. " <> 120 | "Use the provided context from the user's notes to answer their question. " <> 121 | "If the answer isn't in the context, say so politely. " <> 122 | "Context:\n" <> context 123 | 124 | let chatOps = defaultChatOps 125 | { chatModelName = "gemma3" 126 | , messages = 127 | genMessage System systemPrompt :| [genMessage User question] 128 | } 129 | 130 | result <- chat chatOps Nothing 131 | case result of 132 | Left err -> putStrLn $ "Error: " ++ show err 133 | Right response -> do 134 | case getAnsweredMessage response of 135 | Nothing -> putStrLn "Something went wrong" 136 | Just r -> do 137 | putStrLn "🤖 Assistant:" 138 | TIO.putStrLn r 139 | 140 | createContext :: KnowledgeBase -> Text 141 | createContext kb = 142 | let relevantNotes = notes kb 143 | noteTexts = map formatNoteForContext relevantNotes 144 | in T.intercalate "\n---\n" noteTexts 145 | where 146 | formatNoteForContext note = 147 | "Title: " <> noteTitle note <> "\n" <> 148 | "Tags: " <> T.intercalate ", " (noteTags note) <> "\n" <> 149 | "Content: " <> noteContent note 150 | 151 | summarizeNotes :: [Text] -> KnowledgeBase -> IO () 152 | summarizeNotes tags kb = do 153 | let filteredNotes = if null tags 154 | then notes kb 155 | else filter (hasAnyTag tags) (notes kb) 156 | 157 | if null filteredNotes 158 | then putStrLn "No notes found with the specified tags." 159 | else do 160 | putStrLn "📝 Generating summary..." 161 | 162 | let notesText = T.intercalate "\n---\n" $ map formatNoteForSummary filteredNotes 163 | let prompt = "Please provide a concise summary of these notes, highlighting key themes and insights:\n\n" <> notesText 164 | 165 | let chatOps = defaultChatOps 166 | { chatModelName = "gemma3" 167 | , messages = genMessage User prompt :| [] 168 | } 169 | 170 | result <- chat chatOps Nothing 171 | case result of 172 | Left err -> putStrLn $ "Error: " ++ show err 173 | Right response -> do 174 | case getAnsweredMessage response of 175 | Nothing -> putStrLn "Something went wrong" 176 | Just r -> do 177 | putStrLn "📋 Summary:" 178 | TIO.putStrLn r 179 | where 180 | hasAnyTag targetTags note = any (`elem` noteTags note) targetTags 181 | formatNoteForSummary note = 182 | noteTitle note <> "\n" <> noteContent note 183 | 184 | parseCommand :: Text -> Maybe Command 185 | parseCommand input = 186 | case T.words input of 187 | ["add", title] -> Just $ AddNote title "" [] 188 | "add":title:rest -> Just $ AddNote title (T.unwords rest) [] 189 | ["search", query] -> Just $ SearchNotes query 190 | "search":terms -> Just $ SearchNotes (T.unwords terms) 191 | ["list"] -> Just ListNotes 192 | ["ask"] -> Nothing 193 | "ask":question -> Just $ AskQuestion (T.unwords question) 194 | ["summarize"] -> Just $ SummarizeNotes [] 195 | "summarize":tags -> Just $ SummarizeNotes tags 196 | ["help"] -> Just Help 197 | ["quit"] -> Just Quit 198 | ["exit"] -> Just Quit 199 | _ -> Nothing 200 | 201 | processCommand :: Command -> KnowledgeBase -> IO KnowledgeBase 202 | processCommand cmd kb = case cmd of 203 | AddNote title content tags -> do 204 | if T.null content 205 | then do 206 | putStrLn "Enter note content (end with empty line):" 207 | noteContent <- readMultilineInput 208 | addNote title noteContent tags kb 209 | else addNote title content tags kb 210 | 211 | SearchNotes query -> do 212 | _ <- searchNotes query kb 213 | return kb 214 | 215 | ListNotes -> do 216 | listNotes kb 217 | return kb 218 | 219 | AskQuestion question -> do 220 | askQuestion question kb 221 | return kb 222 | 223 | SummarizeNotes tags -> do 224 | summarizeNotes tags kb 225 | return kb 226 | 227 | Help -> do 228 | showHelp 229 | return kb 230 | 231 | Quit -> return kb 232 | 233 | readMultilineInput :: IO Text 234 | readMultilineInput = do 235 | lines' <- readLines [] 236 | return $ T.intercalate "\n" (reverse lines') 237 | where 238 | readLines acc = do 239 | line <- TIO.getLine 240 | if T.null line 241 | then return acc 242 | else readLines (line : acc) 243 | 244 | showHelp :: IO () 245 | showHelp = putStrLn $ unlines 246 | [ "Personal Knowledge Assistant Commands:" 247 | , "" 248 | , " add [content] - Add a new note" 249 | , " search <query> - Search notes by content" 250 | , " list - List all notes" 251 | , " ask <question> - Ask AI about your notes" 252 | , " summarize [tags...] - Generate AI summary of notes" 253 | , " help - Show this help" 254 | , " quit/exit - Exit the application" 255 | , "" 256 | , "Examples:" 257 | , " add \"Meeting Notes\" Today we discussed the project timeline" 258 | , " search project" 259 | , " ask What did we decide about the timeline?" 260 | , " summarize meeting work" 261 | ] 262 | 263 | -- Main application loop 264 | mainLoop :: KnowledgeBase -> IO () 265 | mainLoop kb = do 266 | putStr "Knowledge> " 267 | input <- TIO.getLine 268 | 269 | case parseCommand input of 270 | Nothing -> do 271 | putStrLn "Invalid command. Type 'help' for available commands." 272 | mainLoop kb 273 | 274 | Just Quit -> putStrLn "Goodbye!" 275 | 276 | Just cmd -> do 277 | newKb <- processCommand cmd kb 278 | mainLoop newKb 279 | 280 | runApp :: IO () 281 | runApp = do 282 | putStrLn "Personal Knowledge Assistant with Ollama" 283 | putStrLn "Loading knowledge base..." 284 | kb <- loadKnowledgeBase 285 | putStrLn $ "Loaded " ++ show (length $ notes kb) ++ " notes." 286 | putStrLn "Type 'help' for available commands.\n" 287 | mainLoop kb 288 | 289 | exampleUsage :: IO () 290 | exampleUsage = do 291 | let kb = emptyKnowledgeBase 292 | kb1 <- addNote "Project Planning" 293 | "We need to complete the MVP by Q2. Key features include user authentication, data visualization, and reporting." 294 | ["work", "project", "planning"] 295 | kb 296 | 297 | kb2 <- addNote "Reading List" 298 | "Books to read: Clean Code, Design Patterns, Haskell Programming from First Principles" 299 | ["books", "learning", "programming"] 300 | kb1 301 | 302 | kb3 <- addNote "Recipe Ideas" 303 | "Try making: Thai green curry, homemade pasta, chocolate chip cookies" 304 | ["cooking", "recipes", "food"] 305 | kb2 306 | 307 | putStrLn "\n=== Demo: Searching for 'project' ===" 308 | _ <- searchNotes "project" kb3 309 | 310 | putStrLn "\n=== Demo: Asking AI about project timeline ===" 311 | askQuestion "What's the timeline for the MVP?" kb3 312 | 313 | putStrLn "\n=== Demo: Summarizing work-related notes ===" 314 | summarizeNotes ["work", "project"] kb3 315 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.List (runApp) where 4 | 5 | import Data.Ollama.List 6 | import qualified Data.Text.IO as T 7 | 8 | runApp :: IO () 9 | runApp = do 10 | eList <- list Nothing 11 | case eList of 12 | Left err -> putStrLn $ "Something went wrong: " ++ show err 13 | Right (Models modelInfoList) -> do 14 | mapM_ (T.putStrLn . name) modelInfoList 15 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/SimpleChat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.SimpleChat (runApp) where 4 | 5 | import qualified Data.List.NonEmpty as NE 6 | import Data.Ollama.Chat 7 | import qualified Data.Text.IO as T 8 | 9 | runApp :: IO () 10 | runApp = do 11 | let messageList = NE.singleton (userMessage "What is the meaning of life?") 12 | let ops = 13 | defaultChatOps 14 | { chatModelName = "gemma3" 15 | , messages = messageList 16 | } 17 | eRes <- chat ops Nothing 18 | case eRes of 19 | Left err -> putStrLn $ "Something went wrong: " ++ show err 20 | Right r -> do 21 | putStrLn "LLM response" 22 | case message r of 23 | Nothing -> putStrLn "Something went wrong" 24 | Just (Message _ res _ _ _) -> T.putStrLn res 25 | -------------------------------------------------------------------------------- /examples/ollama-example/src/Example/SimpleGenerate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Example.SimpleGenerate (runApp) where 4 | 5 | import Data.Ollama.Generate 6 | import qualified Data.Text.IO as T 7 | 8 | runApp :: IO () 9 | runApp = do 10 | let ops = 11 | defaultGenerateOps 12 | { modelName = "gemma3" 13 | , prompt = "What is the meaning of life?" 14 | } 15 | eRes <- generate ops Nothing 16 | case eRes of 17 | Left err -> putStrLn $ "Something went wrong: " ++ show err 18 | Right r -> do 19 | putStrLn "LLM response" 20 | T.putStrLn (genResponse r) 21 | -------------------------------------------------------------------------------- /examples/ollama-example/stack.yaml: -------------------------------------------------------------------------------- 1 | snapshot: lts-23.14 2 | 3 | packages: 4 | - . 5 | 6 | extra-deps: 7 | - ../../ 8 | -------------------------------------------------------------------------------- /examples/ollama-example/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 1964d439d2a152be4238053f3f997a09fb348391984daab86d724975ef9a423f 10 | size: 683814 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/14.yaml 12 | original: lts-23.14 13 | -------------------------------------------------------------------------------- /examples/ollama-example/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /examples/sample.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tusharad/ollama-haskell/c46f7e62e02f4750447346f6ae21e23b16b125ae/examples/sample.png -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | indentation: 2 3 | column-limit: 100 4 | function-arrows: trailing 5 | comma-style: leading 6 | import-export-style: leading 7 | indent-wheres: true 8 | record-brace-space: true 9 | newlines-between-decls: 1 10 | haddock-style: multi-line 11 | haddock-style-module: null 12 | let-style: inline 13 | in-style: right-align 14 | single-constraint-parens: auto 15 | unicode: never 16 | respectful: true 17 | fixities: [] 18 | reexports: [] -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | sayHello: 2 | echo "hello" 3 | 4 | install-ollama: 5 | curl -fsSL https://ollama.com/install.sh | sh 6 | ollama 7 | ollama pull llama3.2 8 | -------------------------------------------------------------------------------- /ollama-haskell.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.38.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: ollama-haskell 8 | version: 0.2.0.0 9 | synopsis: Haskell client for ollama. 10 | description: Ollama client for Haskell 11 | category: Web 12 | homepage: https://github.com/tusharad/ollama-haskell#readme 13 | bug-reports: https://github.com/tusharad/ollama-haskell/issues 14 | author: tushar 15 | maintainer: tusharadhatrao@gmail.com 16 | copyright: 2024 tushar 17 | license: MIT 18 | license-file: LICENSE 19 | build-type: Simple 20 | extra-source-files: 21 | README.md 22 | CHANGELOG.md 23 | 24 | source-repository head 25 | type: git 26 | location: https://github.com/tusharad/ollama-haskell 27 | 28 | library 29 | exposed-modules: 30 | Data.Ollama.Chat 31 | Data.Ollama.Common.Config 32 | Data.Ollama.Common.Error 33 | Data.Ollama.Common.SchemaBuilder 34 | Data.Ollama.Common.Types 35 | Data.Ollama.Common.Utils 36 | Data.Ollama.Conversation 37 | Data.Ollama.Copy 38 | Data.Ollama.Create 39 | Data.Ollama.Delete 40 | Data.Ollama.Embeddings 41 | Data.Ollama.Generate 42 | Data.Ollama.List 43 | Data.Ollama.Load 44 | Data.Ollama.Ps 45 | Data.Ollama.Pull 46 | Data.Ollama.Push 47 | Data.Ollama.Show 48 | Ollama 49 | other-modules: 50 | Paths_ollama_haskell 51 | hs-source-dirs: 52 | src 53 | default-extensions: 54 | ImportQualifiedPost 55 | ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints 56 | build-depends: 57 | aeson ==2.* 58 | , base >=4.7 && <5 59 | , base64-bytestring ==1.* 60 | , bytestring >=0.10 && <0.13 61 | , containers >=0.6 && <0.9 62 | , directory >=1 && <1.4 63 | , filepath >=1 && <1.6 64 | , http-client >=0.6 && <0.8 65 | , http-client-tls >=0.2 && <0.4 66 | , http-types >=0.7 && <0.13 67 | , mtl ==2.* 68 | , stm ==2.* 69 | , text >=1 && <3 70 | , time ==1.* 71 | default-language: Haskell2010 72 | 73 | test-suite ollama-haskell-test 74 | type: exitcode-stdio-1.0 75 | main-is: Main.hs 76 | other-modules: 77 | Test.Ollama.Chat 78 | Test.Ollama.Embedding 79 | Test.Ollama.Generate 80 | Test.Ollama.Show 81 | Paths_ollama_haskell 82 | hs-source-dirs: 83 | test 84 | default-extensions: 85 | ImportQualifiedPost 86 | 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 87 | build-depends: 88 | aeson 89 | , base >=4.7 && <5 90 | , base64-bytestring ==1.* 91 | , bytestring >=0.10 && <0.13 92 | , containers >=0.6 && <0.9 93 | , directory >=1 && <1.4 94 | , filepath >=1 && <1.6 95 | , http-client >=0.6 && <0.8 96 | , http-client-tls >=0.2 && <0.4 97 | , http-types >=0.7 && <0.13 98 | , mtl ==2.* 99 | , ollama-haskell 100 | , scientific 101 | , silently 102 | , stm ==2.* 103 | , tasty >=1.5 104 | , tasty-hunit 105 | , text 106 | , time ==1.* 107 | default-language: Haskell2010 108 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: ollama-haskell 2 | version: 0.2.0.0 3 | github: "tusharad/ollama-haskell" 4 | license: MIT 5 | author: "tushar" 6 | maintainer: "tusharadhatrao@gmail.com" 7 | copyright: "2024 tushar" 8 | 9 | extra-source-files: 10 | - README.md 11 | - CHANGELOG.md 12 | 13 | synopsis: Haskell client for ollama. 14 | category: Web 15 | description: Ollama client for Haskell 16 | 17 | dependencies: 18 | - base >= 4.7 && < 5 19 | - aeson >= 2 && < 3 20 | - bytestring >= 0.10 && < 0.13 21 | - text >= 1 && < 3 22 | - time >= 1 && < 2 23 | - http-client >= 0.6 && < 0.8 24 | - http-client-tls >= 0.2 && < 0.4 25 | - http-types >= 0.7 && < 0.13 26 | - base64-bytestring >= 1 && < 2 27 | - filepath >= 1 && < 1.6 28 | - directory >= 1 && < 1.4 29 | - containers >= 0.6 && < 0.9 30 | - stm >= 2 && < 3 31 | - mtl >= 2 && < 3 32 | 33 | ghc-options: 34 | - -Wall 35 | - -Wcompat 36 | - -Widentities 37 | - -Wincomplete-record-updates 38 | - -Wincomplete-uni-patterns 39 | - -Wmissing-export-lists 40 | - -Wmissing-home-modules 41 | - -Wpartial-fields 42 | - -Wredundant-constraints 43 | 44 | library: 45 | source-dirs: src 46 | default-extensions: 47 | - ImportQualifiedPost 48 | 49 | tests: 50 | ollama-haskell-test: 51 | main: Main.hs 52 | source-dirs: test 53 | default-extensions: 54 | - ImportQualifiedPost 55 | ghc-options: 56 | - -threaded 57 | - -rtsopts 58 | - -with-rtsopts=-N 59 | dependencies: 60 | - ollama-haskell 61 | - tasty >= 1.5 62 | - tasty-hunit 63 | - text 64 | - silently 65 | - aeson 66 | - scientific 67 | -------------------------------------------------------------------------------- /src/Data/Ollama/Chat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | 5 | Module : Data.Ollama.Chat 6 | Copyright : (c) 2025 Tushar Adhatrao 7 | License : MIT 8 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 9 | Stability : experimental 10 | Description : Chat functionality for interacting with the Ollama API. 11 | 12 | This module provides functions and types for initiating and managing chat interactions with an Ollama model. 13 | It includes APIs for sending chat requests, constructing messages with different roles, and configuring chat 14 | operations. The module supports both streaming and non-streaming responses, as well as optional tools and 15 | structured output formats. 16 | 17 | The primary functions are 'chat' and 'chatM' for sending chat requests, and helper functions like 18 | 'systemMessage', 'userMessage', 'assistantMessage', and 'toolMessage' for constructing messages. 19 | The 'ChatOps' type allows customization of chat parameters, and 'defaultChatOps' provides a convenient 20 | starting point for configuration. 21 | 22 | Example: 23 | 24 | >>> let ops = defaultChatOps { chatModelName = "customModel", messages = userMessage "Hello!" :| [] } 25 | >>> chat ops Nothing 26 | Either OllamaError ChatResponse 27 | -} 28 | module Data.Ollama.Chat 29 | ( -- * Chat APIs 30 | chat 31 | , chatM 32 | 33 | -- * Message Types 34 | , Message (..) 35 | , Role (..) 36 | , systemMessage 37 | , userMessage 38 | , assistantMessage 39 | , toolMessage 40 | , genMessage 41 | 42 | -- * Chat Configuration 43 | , defaultChatOps 44 | , ChatOps (..) 45 | 46 | -- * Response Types 47 | , ChatResponse (..) 48 | , Format (..) 49 | 50 | -- * Configuration and Error Types 51 | , OllamaConfig (..) 52 | , defaultOllamaConfig 53 | , OllamaError (..) 54 | , ModelOptions (..) 55 | , defaultModelOptions 56 | 57 | -- * Tool and Function Types 58 | , InputTool (..) 59 | , FunctionDef (..) 60 | , FunctionParameters (..) 61 | , OutputFunction (..) 62 | , ToolCall (..) 63 | ) where 64 | 65 | import Control.Monad.IO.Class (MonadIO (liftIO)) 66 | import Data.Aeson 67 | import Data.List.NonEmpty as NonEmpty 68 | import Data.Maybe (isNothing) 69 | import Data.Ollama.Common.Config 70 | import Data.Ollama.Common.Error (OllamaError (..)) 71 | import Data.Ollama.Common.Types 72 | ( ChatResponse (..) 73 | , Format (..) 74 | , FunctionDef (..) 75 | , FunctionParameters (..) 76 | , InputTool (..) 77 | , Message (..) 78 | , ModelOptions (..) 79 | , OutputFunction (..) 80 | , Role (..) 81 | , ToolCall (..) 82 | ) 83 | import Data.Ollama.Common.Utils as CU 84 | import Data.Text (Text) 85 | import Data.Text qualified as T 86 | 87 | {- | Constructs a 'Message' with the specified role and content. 88 | 89 | Creates a 'Message' with the given 'Role' and textual content, setting optional fields 90 | ('images', 'tool_calls', 'thinking') to 'Nothing'. 91 | 92 | Example: 93 | 94 | >>> genMessage User "What's the weather like?" 95 | Message {role = User, content = "What's the weather like?", images = Nothing, tool_calls = Nothing, thinking = Nothing} 96 | -} 97 | genMessage :: Role -> Text -> Message 98 | genMessage r c = 99 | Message 100 | { role = r 101 | , content = c 102 | , images = Nothing 103 | , tool_calls = Nothing 104 | , thinking = Nothing 105 | } 106 | 107 | {- | Creates a 'Message' with the 'System' role. 108 | 109 | Example: 110 | 111 | >>> systemMessage "You are a helpful assistant." 112 | Message {role = System, content = "You are a helpful assistant.", images = Nothing, tool_calls = Nothing, thinking = Nothing} 113 | -} 114 | systemMessage :: Text -> Message 115 | systemMessage c = genMessage System c 116 | 117 | {- | Creates a 'Message' with the 'User' role. 118 | 119 | Example: 120 | 121 | >>> userMessage "What's 2+2?" 122 | Message {role = User, content = "What's 2+2?", images = Nothing, tool_calls = Nothing, thinking = Nothing} 123 | -} 124 | userMessage :: Text -> Message 125 | userMessage c = genMessage User c 126 | 127 | {- | Creates a 'Message' with the 'Assistant' role. 128 | 129 | Example: 130 | 131 | >>> assistantMessage "2+2 equals 4." 132 | Message {role = Assistant, content = "2+2 equals 4.", images = Nothing, tool_calls = Nothing, thinking = Nothing} 133 | -} 134 | assistantMessage :: Text -> Message 135 | assistantMessage c = genMessage Assistant c 136 | 137 | {- | Creates a 'Message' with the 'Tool' role. 138 | 139 | Example: 140 | 141 | >>> toolMessage "Tool output: success" 142 | Message {role = Tool, content = "Tool output: success", images = Nothing, tool_calls = Nothing, thinking = Nothing} 143 | -} 144 | toolMessage :: Text -> Message 145 | toolMessage c = genMessage Tool c 146 | 147 | {- | Validates 'ChatOps' to ensure required fields are non-empty. 148 | 149 | Checks that the 'chatModelName' is not empty and that no 'Message' in 'messages' has empty content. 150 | Returns 'Right' with the validated 'ChatOps' or 'Left' with an 'OllamaError' if validation fails. 151 | 152 | @since 0.2.0.0 153 | -} 154 | validateChatOps :: ChatOps -> Either OllamaError ChatOps 155 | validateChatOps ops 156 | | T.null (chatModelName ops) = Left $ InvalidRequest "Chat model name cannot be empty" 157 | | any (T.null . content) (messages ops) = 158 | Left $ InvalidRequest "Messages cannot have empty content" 159 | | otherwise = Right ops 160 | 161 | {- | Configuration for initiating a chat with an Ollama model. 162 | 163 | Defines the parameters for a chat request, including the model name, messages, and optional settings 164 | for tools, response format, streaming, timeout, and model options. 165 | -} 166 | data ChatOps = ChatOps 167 | { chatModelName :: !Text 168 | -- ^ The name of the chat model to be used (e.g., "gemma3"). 169 | , messages :: !(NonEmpty Message) 170 | -- ^ A non-empty list of messages forming the conversation context. 171 | , tools :: !(Maybe [InputTool]) 172 | -- ^ Optional tools that may be used in the chat. 173 | , format :: !(Maybe Format) 174 | -- ^ Optional format for the chat response (e.g., JSON or JSON schema). 175 | -- 176 | -- @since 0.1.3.0 177 | , stream :: !(Maybe (ChatResponse -> IO ())) 178 | -- ^ Optional callback function to be called with each incoming response. 179 | , keepAlive :: !(Maybe Int) 180 | -- ^ Optional override for the response timeout in minutes (default: 15 minutes). 181 | , options :: !(Maybe ModelOptions) 182 | -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile. 183 | -- 184 | -- @since 0.1.3.0 185 | , think :: !(Maybe Bool) 186 | -- ^ Optional flag to enable thinking mode. 187 | -- 188 | -- @since 0.2.0.0 189 | } 190 | 191 | instance Show ChatOps where 192 | show 193 | ( ChatOps 194 | { chatModelName = m 195 | , messages = ms 196 | , tools = t 197 | , format = f 198 | , keepAlive = ka 199 | , think = th 200 | } 201 | ) = 202 | let messagesStr = show (toList ms) 203 | toolsStr = show t 204 | formatStr = show f 205 | keepAliveStr = show ka 206 | thinkStr = show th 207 | in T.unpack m 208 | ++ "\nMessages:\n" 209 | ++ messagesStr 210 | ++ "\n" 211 | ++ toolsStr 212 | ++ "\n" 213 | ++ formatStr 214 | ++ "\n" 215 | ++ keepAliveStr 216 | ++ "\n" 217 | ++ thinkStr 218 | 219 | instance Eq ChatOps where 220 | (==) a b = 221 | chatModelName a == chatModelName b 222 | && messages a == messages b 223 | && tools a == tools b 224 | && format a == format b 225 | && keepAlive a == keepAlive b 226 | 227 | instance ToJSON ChatOps where 228 | toJSON (ChatOps model_ messages_ tools_ format_ stream_ keepAlive_ options think_) = 229 | object 230 | [ "model" .= model_ 231 | , "messages" .= messages_ 232 | , "tools" .= tools_ 233 | , "format" .= format_ 234 | , "stream" .= if isNothing stream_ then Just False else Just True 235 | , "keep_alive" .= keepAlive_ 236 | , "options" .= options 237 | , "think" .= think_ 238 | ] 239 | 240 | {- | Default configuration for initiating a chat. 241 | 242 | Provides a default 'ChatOps' with the "gemma3" model and a sample user message ("What is 2+2?"). 243 | Can be customized by modifying fields as needed. 244 | 245 | Example: 246 | 247 | >>> let ops = defaultChatOps { chatModelName = "customModel", messages = userMessage "Hello!" :| [] } 248 | >>> chat ops Nothing 249 | Either OllamaError ChatResponse 250 | -} 251 | defaultChatOps :: ChatOps 252 | defaultChatOps = 253 | ChatOps 254 | { chatModelName = "gemma3" 255 | , messages = userMessage "What is 2+2?" :| [] 256 | , tools = Nothing 257 | , format = Nothing 258 | , stream = Nothing 259 | , keepAlive = Nothing 260 | , options = Nothing 261 | , think = Nothing 262 | } 263 | 264 | {- | Sends a chat request to the Ollama API. 265 | 266 | Validates the 'ChatOps' configuration and sends a POST request to the @\/api\/chat@ endpoint. 267 | Supports both streaming and non-streaming responses based on the 'stream' field in 'ChatOps'. 268 | Returns an 'Either' containing an 'OllamaError' on failure or a 'ChatResponse' on success. 269 | 270 | Example: 271 | 272 | >>> let ops = defaultChatOps { chatModelName = "gemma3", messages = userMessage "What's the capital of France?" :| [] } 273 | >>> chat ops Nothing 274 | Either OllamaError ChatResponse 275 | -} 276 | chat :: ChatOps -> Maybe OllamaConfig -> IO (Either OllamaError ChatResponse) 277 | chat ops mbConfig = 278 | case validateChatOps ops of 279 | Left err -> return $ Left err 280 | Right _ -> withOllamaRequest "/api/chat" "POST" (Just ops) mbConfig handler 281 | where 282 | handler = case stream ops of 283 | Nothing -> commonNonStreamingHandler 284 | Just sendChunk -> commonStreamHandler sendChunk 285 | 286 | {- | MonadIO version of 'chat' for use in monadic contexts. 287 | 288 | Lifts the 'chat' function into a 'MonadIO' context, allowing it to be used in monadic computations. 289 | 290 | Example: 291 | 292 | >>> import Control.Monad.IO.Class 293 | >>> let ops = defaultChatOps { chatModelName = "gemma3", messages = userMessage "Hello!" :| [] } 294 | >>> runReaderT (chatM ops Nothing) someContext 295 | Either OllamaError ChatResponse 296 | -} 297 | chatM :: MonadIO m => ChatOps -> Maybe OllamaConfig -> m (Either OllamaError ChatResponse) 298 | chatM ops mbCfg = liftIO $ chat ops mbCfg 299 | -------------------------------------------------------------------------------- /src/Data/Ollama/Common/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {- | 5 | Module : Data.Ollama.Common.Config 6 | Copyright : (c) 2025 Tushar Adhatrao 7 | License : MIT 8 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 9 | Stability : experimental 10 | Description : A unified configuration type for controlling Ollama client behavior. 11 | 12 | == Overview 13 | 14 | This module defines the core configuration record used throughout the Ollama Haskell client. 15 | 16 | Use 'defaultOllamaConfig' as a starting point and customize it with helper functions 17 | like 'withOnModelStart', 'withOnModelFinish', or 'withOnModelError'. 18 | 19 | Includes settings for base URL, timeout, retry logic, and custom HTTP managers. 20 | -} 21 | module Data.Ollama.Common.Config 22 | ( -- * Configuration Type 23 | OllamaConfig (..) 24 | 25 | -- * Default Config 26 | , defaultOllamaConfig 27 | 28 | -- * Hook Helpers 29 | , withOnModelStart 30 | , withOnModelFinish 31 | , withOnModelError 32 | ) where 33 | 34 | import Data.Text (Text) 35 | import GHC.Generics 36 | import Network.HTTP.Client 37 | 38 | {- | Configuration for the Ollama client. 39 | Used across all requests to customize behavior such as timeouts, retries, 40 | custom HTTP manager, and lifecycle hooks. 41 | 42 | @since 0.2.0.0 43 | -} 44 | data OllamaConfig = OllamaConfig 45 | { hostUrl :: Text 46 | -- ^ Base URL for the Ollama server (default: @http://127.0.0.1:11434@) 47 | , timeout :: Int 48 | -- ^ Timeout in seconds for API requests (ignored if 'commonManager' is set) 49 | , onModelStart :: Maybe (IO ()) 50 | -- ^ Callback executed when a model starts 51 | , onModelError :: Maybe (IO ()) 52 | -- ^ Callback executed if a model encounters an error 53 | , onModelFinish :: Maybe (IO ()) 54 | -- ^ Callback executed when a model finishes (not called on error) 55 | , retryCount :: Maybe Int 56 | -- ^ Number of retries on failure (default: @0@ if 'Nothing') 57 | , retryDelay :: Maybe Int 58 | -- ^ Delay between retries in seconds (if applicable) 59 | , commonManager :: Maybe Manager 60 | -- ^ Shared HTTP manager; disables timeout and retry settings 61 | } 62 | deriving (Generic) 63 | 64 | {- | A default configuration pointing to @localhost:11434@ with 90s timeout 65 | and no hooks or retry logic. 66 | -} 67 | defaultOllamaConfig :: OllamaConfig 68 | defaultOllamaConfig = 69 | OllamaConfig 70 | { hostUrl = "http://127.0.0.1:11434" 71 | , timeout = 90 72 | , onModelStart = Nothing 73 | , onModelError = Nothing 74 | , onModelFinish = Nothing 75 | , retryCount = Nothing 76 | , retryDelay = Nothing 77 | , commonManager = Nothing 78 | } 79 | 80 | -- | Add a callback to be executed when a model starts. 81 | withOnModelStart :: IO () -> OllamaConfig -> OllamaConfig 82 | withOnModelStart f cfg = cfg {onModelStart = Just f} 83 | 84 | -- | Add a callback to be executed when a model errors. 85 | withOnModelError :: IO () -> OllamaConfig -> OllamaConfig 86 | withOnModelError f cfg = cfg {onModelError = Just f} 87 | 88 | -- | Add a callback to be executed when a model finishes successfully. 89 | withOnModelFinish :: IO () -> OllamaConfig -> OllamaConfig 90 | withOnModelFinish f cfg = cfg {onModelFinish = Just f} 91 | -------------------------------------------------------------------------------- /src/Data/Ollama/Common/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | 3 | {- | 4 | Module : Data.Ollama.Common.Error 5 | Copyright : (c) 2025 Tushar Adhatrao 6 | License : MIT 7 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 8 | Stability : experimental 9 | Description : Unified error type for handling failures across the Ollama client. 10 | 11 | == Overview 12 | 13 | Defines the core 'OllamaError' type that wraps all potential errors 14 | encountered while interacting with the Ollama API, including HTTP errors, 15 | JSON decoding failures, API-specific errors, file I/O errors, and timeouts. 16 | -} 17 | module Data.Ollama.Common.Error 18 | ( -- * Error Types 19 | OllamaError (..) 20 | 21 | -- * Decoding Utilities 22 | , DecodingErrorMessage 23 | , DecodingFailedValue 24 | ) where 25 | 26 | import Control.Exception (Exception, IOException) 27 | import Data.Text (Text) 28 | import GHC.Generics 29 | import Network.HTTP.Client (HttpException) 30 | 31 | -- | Type alias for a decoding error message string. 32 | type DecodingErrorMessage = String 33 | 34 | -- | Type alias for the value that failed to decode. 35 | type DecodingFailedValue = String 36 | 37 | -- | Represents all possible errors that may occur when using the Ollama client. 38 | -- 39 | -- @since 0.2.0.0 40 | data OllamaError 41 | = -- | Low-level HTTP exception (connection failure, etc.) 42 | HttpError HttpException 43 | | -- | Failure to decode a JSON response, includes message and raw value 44 | DecodeError DecodingErrorMessage DecodingFailedValue 45 | | -- | Error returned from Ollama's HTTP API 46 | ApiError Text 47 | | -- | Error during file operations (e.g., loading an image) 48 | FileError IOException 49 | | -- | Mismatch in expected JSON schema or structure 50 | JsonSchemaError String 51 | | -- | Request timed out 52 | TimeoutError String 53 | | -- | Request is malformed or violates input constraints 54 | InvalidRequest String 55 | deriving (Show, Generic) 56 | 57 | instance Eq OllamaError where 58 | (HttpError _) == (HttpError _) = True 59 | x == y = eqOllamaError x y 60 | where 61 | eqOllamaError :: OllamaError -> OllamaError -> Bool 62 | eqOllamaError = (==) 63 | 64 | instance Exception OllamaError 65 | -------------------------------------------------------------------------------- /src/Data/Ollama/Common/SchemaBuilder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Data.Ollama.Common.SchemaBuilder 7 | Copyright : (c) 2025 Tushar Adhatrao 8 | License : MIT 9 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 10 | Stability : experimental 11 | Description : DSL for constructing structured JSON Schemas for Ollama's structured output API. 12 | 13 | == Overview 14 | 15 | This module defines a simple schema builder DSL for programmatically constructing 16 | JSON Schemas compatible with the structured output features in the Ollama API. 17 | 18 | It supports nested objects, arrays, required fields, and custom types, and 19 | provides infix operators for a fluent and expressive syntax. 20 | 21 | == Example 22 | 23 | @ 24 | import Data.Ollama.Common.SchemaBuilder 25 | 26 | let schema = 27 | emptyObject 28 | |+ ("name", JString) 29 | |+ ("age", JInteger) 30 | |++ ("address", buildSchema $ 31 | emptyObject 32 | |+ ("city", JString) 33 | |+ ("zip", JInteger) 34 | |! "city" 35 | ) 36 | |!! ["name", "age"] 37 | & buildSchema 38 | 39 | printSchema schema 40 | @ 41 | -} 42 | module Data.Ollama.Common.SchemaBuilder 43 | ( -- * Core Types 44 | JsonType (..) 45 | , Property (..) 46 | , Schema (..) 47 | 48 | -- * Schema Construction 49 | , emptyObject 50 | , addProperty 51 | , addObjectProperty 52 | , requireField 53 | , requireFields 54 | , buildSchema 55 | 56 | -- * Schema Utilities 57 | , objectOf 58 | , arrayOf 59 | , toOllamaFormat 60 | , printSchema 61 | 62 | -- * Infix Schema DSL 63 | , (|+) 64 | , (|++) 65 | , (|!) 66 | , (|!!) 67 | ) where 68 | 69 | import Data.Aeson 70 | import Data.Map.Strict qualified as HM 71 | import Data.Text (Text) 72 | import Data.Text qualified as T 73 | import Data.Text.Lazy qualified as TL 74 | import Data.Text.Lazy.Encoding qualified as T 75 | import GHC.Generics 76 | 77 | -- | Supported JSON types for schema generation. 78 | data JsonType 79 | = JString 80 | | JNumber 81 | | JInteger 82 | | JBoolean 83 | | JNull 84 | | -- | Array of a specific type 85 | JArray JsonType 86 | | -- | Nested object schema 87 | JObject Schema 88 | deriving (Show, Eq, Generic) 89 | 90 | instance ToJSON JsonType where 91 | toJSON JString = "string" 92 | toJSON JNumber = "number" 93 | toJSON JInteger = "integer" 94 | toJSON JBoolean = "boolean" 95 | toJSON JNull = "null" 96 | toJSON (JArray _) = "array" 97 | toJSON (JObject _) = "object" 98 | 99 | -- | A named property with a given type (supports nested values). 100 | newtype Property = Property JsonType 101 | deriving (Show, Eq, Generic) 102 | 103 | instance ToJSON Property where 104 | toJSON (Property (JArray itemType)) = 105 | object ["type" .= ("array" :: Text), "items" .= Property itemType] 106 | toJSON (Property (JObject schema)) = toJSON schema 107 | toJSON (Property typ) = object ["type" .= typ] 108 | 109 | -- | Complete schema representation. 110 | -- 111 | -- @since 0.2.0.0 112 | data Schema = Schema 113 | { schemaProperties :: HM.Map Text Property 114 | , schemaRequired :: [Text] 115 | } 116 | deriving (Show, Eq, Generic) 117 | 118 | instance ToJSON Schema where 119 | toJSON (Schema props req) = 120 | object 121 | [ "type" .= ("object" :: Text) 122 | , "properties" .= props 123 | , "required" .= req 124 | ] 125 | 126 | -- | Internal builder for schema DSL. 127 | newtype SchemaBuilder = SchemaBuilder Schema 128 | deriving (Show, Eq) 129 | 130 | -- | Create an empty schema object. 131 | emptyObject :: SchemaBuilder 132 | emptyObject = SchemaBuilder $ Schema HM.empty [] 133 | 134 | -- | Add a simple field with a given name and type. 135 | addProperty :: Text -> JsonType -> SchemaBuilder -> SchemaBuilder 136 | addProperty name typ (SchemaBuilder s) = 137 | SchemaBuilder $ s {schemaProperties = HM.insert name (Property typ) (schemaProperties s)} 138 | 139 | -- | Add a nested object field with its own schema. 140 | addObjectProperty :: Text -> Schema -> SchemaBuilder -> SchemaBuilder 141 | addObjectProperty name nestedSchema (SchemaBuilder s) = 142 | SchemaBuilder $ 143 | s {schemaProperties = HM.insert name (Property (JObject nestedSchema)) (schemaProperties s)} 144 | 145 | -- | Mark a field as required. 146 | requireField :: Text -> SchemaBuilder -> SchemaBuilder 147 | requireField name (SchemaBuilder s) = 148 | SchemaBuilder $ s {schemaRequired = name : schemaRequired s} 149 | 150 | -- | Mark multiple fields as required. 151 | requireFields :: [Text] -> SchemaBuilder -> SchemaBuilder 152 | requireFields names builder = foldr requireField builder names 153 | 154 | -- | Finalize the schema from a builder. 155 | buildSchema :: SchemaBuilder -> Schema 156 | buildSchema (SchemaBuilder s) = s 157 | 158 | -- | Wrap a 'SchemaBuilder' as a nested object type. 159 | objectOf :: SchemaBuilder -> JsonType 160 | objectOf builder = JObject (buildSchema builder) 161 | 162 | -- | Create an array of a given JSON type. 163 | arrayOf :: JsonType -> JsonType 164 | arrayOf = JArray 165 | 166 | -- | Convert schema into a JSON 'Value' suitable for API submission. 167 | toOllamaFormat :: Schema -> Value 168 | toOllamaFormat = toJSON 169 | 170 | -- | Pretty print a schema as formatted JSON. 171 | printSchema :: Schema -> IO () 172 | printSchema = putStrLn . T.unpack . TL.toStrict . T.decodeUtf8 . encode 173 | 174 | -- | Infix alias for 'addProperty'. 175 | (|+) :: SchemaBuilder -> (Text, JsonType) -> SchemaBuilder 176 | builder |+ (name, typ) = addProperty name typ builder 177 | 178 | -- | Infix alias for 'addObjectProperty'. 179 | (|++) :: SchemaBuilder -> (Text, Schema) -> SchemaBuilder 180 | builder |++ (name, schema) = addObjectProperty name schema builder 181 | 182 | -- | Infix alias for 'requireField'. 183 | (|!) :: SchemaBuilder -> Text -> SchemaBuilder 184 | builder |! name = requireField name builder 185 | 186 | -- | Infix alias for 'requireFields'. 187 | (|!!) :: SchemaBuilder -> [Text] -> SchemaBuilder 188 | builder |!! names = requireFields names builder 189 | 190 | infixl 7 |+, |++ 191 | infixl 6 |!, |!! 192 | -------------------------------------------------------------------------------- /src/Data/Ollama/Common/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | {- | 8 | Module : Data.Ollama.Common.Types 9 | Copyright : (c) 2025 Tushar Adhatrao 10 | License : MIT 11 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 12 | Stability : experimental 13 | Description : Shared data types for request and response structures used throughout the Ollama client. 14 | 15 | == 📋 Overview 16 | 17 | This module defines common types for working with Ollama's API, including: 18 | 19 | - Chat messages and roles 20 | - Text generation responses 21 | - Structured function/tool calling 22 | - Model metadata 23 | - Streaming handling 24 | - Custom model parameters 25 | 26 | These types are consumed and returned by higher-level modules 27 | like `Data.Ollama.Chat`, `Data.Ollama.Generate`, and others. 28 | 29 | == Includes 30 | 31 | - Chat message structure and roles 32 | - Generate and chat response records 33 | - ModelOptions and advanced config 34 | - Structured function/tool call interfaces 35 | - JSON format hints and schema wrapping 36 | - Helper class 'HasDone' for streaming termination 37 | 38 | Most types implement `ToJSON`/`FromJSON` for direct API interaction. 39 | -} 40 | module Data.Ollama.Common.Types 41 | ( ModelDetails (..) 42 | , Format (..) 43 | , GenerateResponse (..) 44 | , Message (..) 45 | , Role (..) 46 | , ChatResponse (..) 47 | , HasDone (..) 48 | , ModelOptions (..) 49 | , InputTool (..) 50 | , FunctionDef (..) 51 | , FunctionParameters (..) 52 | , ToolCall (..) 53 | , OutputFunction (..) 54 | , Version (..) 55 | ) where 56 | 57 | import Data.Aeson 58 | import Data.Map qualified as HM 59 | import Data.Maybe (catMaybes) 60 | import Data.Ollama.Common.SchemaBuilder 61 | import Data.Text (Text) 62 | import Data.Time (UTCTime) 63 | import GHC.Generics 64 | import GHC.Int (Int64) 65 | 66 | -- | Metadata describing a specific model's identity and configuration. 67 | data ModelDetails = ModelDetails 68 | { parentModel :: !(Maybe Text) 69 | -- ^ The parent model from which this model was derived, if any. 70 | , format :: !Text 71 | -- ^ The format used for the model (e.g., "gguf"). 72 | , family :: !Text 73 | -- ^ The family name of the model (e.g., "llama", "mistral"). 74 | , families :: ![Text] 75 | -- ^ Alternative or related family identifiers. 76 | , parameterSize :: !Text 77 | -- ^ The size of the model's parameters, typically expressed as a string (e.g., "7B"). 78 | , quantizationLevel :: Text 79 | -- ^ The quantization level used (e.g., "Q4", "Q8"). 80 | } 81 | deriving (Eq, Show) 82 | 83 | instance FromJSON ModelDetails where 84 | parseJSON = withObject "ModelDetails" $ \v -> 85 | ModelDetails 86 | <$> v .: "parent_model" 87 | <*> v .: "format" 88 | <*> v .: "family" 89 | <*> v .:? "families" .!= [] 90 | <*> v .: "parameter_size" 91 | <*> v .: "quantization_level" 92 | 93 | {- | Format specification for the chat output. 94 | 95 | @since 0.1.3.0 96 | -} 97 | data Format = JsonFormat | SchemaFormat Schema 98 | deriving (Show, Eq) 99 | 100 | instance ToJSON Format where 101 | toJSON JsonFormat = String "json" 102 | toJSON (SchemaFormat schema) = toJSON schema 103 | 104 | {- | 105 | Result type for 'generate' function containing the model's response and meta-information. 106 | -} 107 | data GenerateResponse = GenerateResponse 108 | { model :: !Text 109 | -- ^ The name of the model that generated the response. 110 | , createdAt :: !UTCTime 111 | -- ^ The timestamp when the response was created. 112 | , genResponse :: !Text 113 | -- ^ The generated response from the model. 114 | , done :: !Bool 115 | -- ^ A flag indicating whether the generation process is complete. 116 | , totalDuration :: !(Maybe Int64) 117 | -- ^ Optional total duration in milliseconds for the generation process. 118 | , loadDuration :: !(Maybe Int64) 119 | -- ^ Optional load duration in milliseconds for loading the model. 120 | , promptEvalCount :: !(Maybe Int64) 121 | -- ^ Optional count of prompt evaluations during the generation process. 122 | , promptEvalDuration :: !(Maybe Int64) 123 | -- ^ Optional duration in milliseconds for evaluating the prompt. 124 | , evalCount :: !(Maybe Int64) 125 | -- ^ Optional count of evaluations during the generation process. 126 | , evalDuration :: !(Maybe Int64) 127 | -- ^ Optional duration in milliseconds for evaluations during the generation process. 128 | , thinking :: !(Maybe Text) 129 | -- ^ Thinking of reasoning models; if think is set to true 130 | -- 131 | -- @since 0.2.0.0 132 | } 133 | deriving (Show, Eq) 134 | 135 | instance FromJSON GenerateResponse where 136 | parseJSON = withObject "GenerateResponse" $ \v -> 137 | GenerateResponse 138 | <$> v .: "model" 139 | <*> v .: "created_at" 140 | <*> v .: "response" 141 | <*> v .: "done" 142 | <*> v .:? "total_duration" 143 | <*> v .:? "load_duration" 144 | <*> v .:? "prompt_eval_count" 145 | <*> v .:? "prompt_eval_duration" 146 | <*> v .:? "eval_count" 147 | <*> v .:? "eval_duration" 148 | <*> v .:? "thinking" 149 | 150 | -- | Enumerated roles that can participate in a chat. 151 | data Role = System | User | Assistant | Tool 152 | deriving (Show, Eq) 153 | 154 | instance ToJSON Role where 155 | toJSON System = String "system" 156 | toJSON User = String "user" 157 | toJSON Assistant = String "assistant" 158 | toJSON Tool = String "tool" 159 | 160 | instance FromJSON Role where 161 | parseJSON = withText "Role" $ \t -> 162 | case t of 163 | "system" -> pure System 164 | "user" -> pure User 165 | "assistant" -> pure Assistant 166 | "tool" -> pure Tool 167 | _ -> fail $ "Invalid Role value: " <> show t 168 | 169 | -- | Represents a message within a chat, including its role and content. 170 | data Message = Message 171 | { role :: !Role 172 | -- ^ The role of the entity sending the message (e.g., 'User', 'Assistant'). 173 | , content :: !Text 174 | -- ^ The textual content of the message. 175 | , images :: !(Maybe [Text]) 176 | -- ^ Optional list of base64 encoded images that accompany the message. 177 | , tool_calls :: !(Maybe [ToolCall]) 178 | -- ^ a list of tools in JSON that the model wants to use 179 | -- 180 | -- @since 0.1.3.0 181 | , thinking :: !(Maybe Text) 182 | -- 183 | -- @since 0.2.0.0 184 | } 185 | deriving (Show, Eq, Generic, ToJSON, FromJSON) 186 | 187 | data ChatResponse = ChatResponse 188 | { model :: !Text 189 | -- ^ The name of the model that generated this response. 190 | , createdAt :: !UTCTime 191 | -- ^ The timestamp when the response was created. 192 | , message :: !(Maybe Message) 193 | -- ^ The message content of the response, if any. 194 | , done :: !Bool 195 | -- ^ Indicates whether the chat process has completed. 196 | , totalDuration :: !(Maybe Int64) 197 | -- ^ Optional total duration in milliseconds for the chat process. 198 | , loadDuration :: !(Maybe Int64) 199 | -- ^ Optional load duration in milliseconds for loading the model. 200 | , promptEvalCount :: !(Maybe Int64) 201 | -- ^ Optional count of prompt evaluations during the chat process. 202 | , promptEvalDuration :: !(Maybe Int64) 203 | -- ^ Optional duration in milliseconds for evaluating the prompt. 204 | , evalCount :: !(Maybe Int64) 205 | -- ^ Optional count of evaluations during the chat process. 206 | , evalDuration :: !(Maybe Int64) 207 | -- ^ Optional duration in milliseconds for evaluations during the chat process. 208 | } 209 | deriving (Show, Eq) 210 | 211 | instance FromJSON ChatResponse where 212 | parseJSON = withObject "ChatResponse" $ \v -> 213 | ChatResponse 214 | <$> v .: "model" 215 | <*> v .: "created_at" 216 | <*> v .: "message" 217 | <*> v .: "done" 218 | <*> v .:? "total_duration" 219 | <*> v .:? "load_duration" 220 | <*> v .:? "prompt_eval_count" 221 | <*> v .:? "prompt_eval_duration" 222 | <*> v .:? "eval_count" 223 | <*> v .:? "eval_duration" 224 | 225 | -- | A workaround to use done field within commonStreamHandler 226 | class HasDone a where 227 | getDone :: a -> Bool 228 | 229 | instance HasDone GenerateResponse where 230 | getDone GenerateResponse {..} = done 231 | 232 | instance HasDone ChatResponse where 233 | getDone ChatResponse {..} = done 234 | 235 | -- | Optional model tuning parameters that influence generation behavior. 236 | -- 237 | -- @since 0.2.0.0 238 | data ModelOptions = ModelOptions 239 | { numKeep :: Maybe Int 240 | , -- ^ Number of tokens to keep from the previous context. 241 | seed :: Maybe Int 242 | , -- ^ Random seed for reproducibility. 243 | numPredict :: Maybe Int 244 | , -- ^ Maximum number of tokens to predict. 245 | topK :: Maybe Int 246 | , -- ^ Top-K sampling parameter. 247 | topP :: Maybe Double 248 | , -- ^ Top-P (nucleus) sampling parameter. 249 | minP :: Maybe Double 250 | , -- ^ Minimum probability for nucleus sampling. 251 | typicalP :: Maybe Double 252 | , -- ^ Typical sampling probability. 253 | repeatLastN :: Maybe Int 254 | , -- ^ Number of tokens to consider for repetition penalty. 255 | temperature :: Maybe Double 256 | , -- ^ Sampling temperature. Higher = more randomness. 257 | repeatPenalty :: Maybe Double 258 | , -- ^ Penalty for repeating the same tokens. 259 | presencePenalty :: Maybe Double 260 | , -- ^ Penalty for introducing new tokens. 261 | frequencyPenalty :: Maybe Double 262 | , -- ^ Penalty for frequent tokens. 263 | penalizeNewline :: Maybe Bool 264 | , -- ^ Whether to penalize newline tokens. 265 | stop :: Maybe [Text] 266 | , -- ^ List of stop sequences to end generation. 267 | numa :: Maybe Bool 268 | , -- ^ Whether to enable NUMA-aware optimizations. 269 | numCtx :: Maybe Int 270 | , -- ^ Number of context tokens. 271 | numBatch :: Maybe Int 272 | , -- ^ Batch size used during generation. 273 | numGpu :: Maybe Int 274 | , -- ^ Number of GPUs to use. 275 | mainGpu :: Maybe Int 276 | , -- ^ Index of the primary GPU to use. 277 | useMmap :: Maybe Bool 278 | , -- ^ Whether to memory-map the model. 279 | numThread :: Maybe Int 280 | -- ^ Number of threads to use for inference. 281 | } 282 | 283 | deriving (Show, Eq) 284 | 285 | -- | Custom ToJSON instance for Options 286 | instance ToJSON ModelOptions where 287 | toJSON opts = 288 | object $ 289 | catMaybes 290 | [ ("num_keep" .=) <$> numKeep opts 291 | , ("seed" .=) <$> seed opts 292 | , ("num_predict" .=) <$> numPredict opts 293 | , ("top_k" .=) <$> topK opts 294 | , ("top_p" .=) <$> topP opts 295 | , ("min_p" .=) <$> minP opts 296 | , ("typical_p" .=) <$> typicalP opts 297 | , ("repeat_last_n" .=) <$> repeatLastN opts 298 | , ("temperature" .=) <$> temperature opts 299 | , ("repeat_penalty" .=) <$> repeatPenalty opts 300 | , ("presence_penalty" .=) <$> presencePenalty opts 301 | , ("frequency_penalty" .=) <$> frequencyPenalty opts 302 | , ("penalize_newline" .=) <$> penalizeNewline opts 303 | , ("stop" .=) <$> stop opts 304 | , ("numa" .=) <$> numa opts 305 | , ("num_ctx" .=) <$> numCtx opts 306 | , ("num_batch" .=) <$> numBatch opts 307 | , ("num_gpu" .=) <$> numGpu opts 308 | , ("main_gpu" .=) <$> mainGpu opts 309 | , ("use_mmap" .=) <$> useMmap opts 310 | , ("num_thread" .=) <$> numThread opts 311 | ] 312 | 313 | -- | A wrapper for the Ollama engine version string. 314 | newtype Version = Version Text 315 | deriving (Eq, Show) 316 | 317 | instance FromJSON Version where 318 | parseJSON = withObject "version" $ \v -> do 319 | Version <$> v .: "version" 320 | 321 | -- | Represents a tool that can be used in the conversation. 322 | -- 323 | -- @since 0.2.0.0 324 | data InputTool = InputTool 325 | { toolType :: Text 326 | -- ^ The type of the tool 327 | , function :: FunctionDef 328 | -- ^ The function associated with the tool 329 | } 330 | deriving (Show, Eq, Generic) 331 | 332 | instance ToJSON InputTool where 333 | toJSON InputTool {..} = 334 | object 335 | [ "type" .= toolType 336 | , "function" .= function 337 | ] 338 | 339 | instance FromJSON InputTool where 340 | parseJSON = withObject "Tool" $ \v -> 341 | InputTool 342 | <$> v .: "type" 343 | <*> v .: "function" 344 | 345 | -- | Represents a function that can be called by the model. 346 | -- 347 | -- @since 0.2.0.0 348 | data FunctionDef = FunctionDef 349 | { functionName :: Text 350 | -- ^ The name of the function 351 | , functionDescription :: Maybe Text 352 | -- ^ Optional description of the function 353 | , functionParameters :: Maybe FunctionParameters 354 | -- ^ Optional parameters for the function 355 | , functionStrict :: Maybe Bool 356 | -- ^ Optional strictness flag 357 | } 358 | deriving (Show, Eq, Generic) 359 | 360 | instance ToJSON FunctionDef where 361 | toJSON FunctionDef {..} = 362 | object $ 363 | [ "name" .= functionName 364 | ] 365 | ++ maybe [] (\d -> ["description" .= d]) functionDescription 366 | ++ maybe [] (\p -> ["parameters" .= p]) functionParameters 367 | ++ maybe [] (\s -> ["strict" .= s]) functionStrict 368 | 369 | instance FromJSON FunctionDef where 370 | parseJSON = withObject "Function" $ \v -> 371 | FunctionDef 372 | <$> v .: "name" 373 | <*> v .:? "description" 374 | <*> v .:? "parameters" 375 | <*> v .:? "strict" 376 | 377 | -- | Parameters definition for a function call used in structured output or tool calls. 378 | -- 379 | -- @since 0.2.0.0 380 | data FunctionParameters = FunctionParameters 381 | { parameterType :: Text 382 | -- ^ Type of the parameter (usually "object"). 383 | , parameterProperties :: Maybe (HM.Map Text FunctionParameters) 384 | -- ^ Optional nested parameters as a property map. 385 | , requiredParams :: Maybe [Text] 386 | -- ^ List of required parameter names. 387 | , additionalProperties :: Maybe Bool 388 | -- ^ Whether additional (unspecified) parameters are allowed. 389 | } 390 | deriving (Show, Eq) 391 | 392 | instance ToJSON FunctionParameters where 393 | toJSON FunctionParameters {..} = 394 | object 395 | [ "type" .= parameterType 396 | , "properties" .= parameterProperties 397 | , "required" .= requiredParams 398 | , "additionalProperties" .= additionalProperties 399 | ] 400 | 401 | instance FromJSON FunctionParameters where 402 | parseJSON = withObject "parameters" $ \v -> 403 | FunctionParameters 404 | <$> v .: "type" 405 | <*> v .: "properties" 406 | <*> v .: "required" 407 | <*> v .: "additionalProperties" 408 | 409 | -- | A single tool call returned from the model, containing the function to be invoked. 410 | -- 411 | -- @since 0.2.0.0 412 | newtype ToolCall = ToolCall 413 | { outputFunction :: OutputFunction 414 | -- ^ The function the model intends to call, with arguments. 415 | } 416 | deriving (Show, Eq) 417 | 418 | -- | Output representation of a function to be called, including its name and arguments. 419 | -- 420 | -- @since 0.2.0.0 421 | data OutputFunction = OutputFunction 422 | { outputFunctionName :: Text 423 | -- ^ The name of the function to invoke. 424 | , arguments :: HM.Map Text Value 425 | -- ^ A key-value map of argument names to values (JSON values). 426 | } 427 | deriving (Eq, Show) 428 | 429 | instance ToJSON OutputFunction where 430 | toJSON OutputFunction {..} = 431 | object 432 | [ "name" .= outputFunctionName 433 | , "arguments" .= arguments 434 | ] 435 | 436 | instance FromJSON OutputFunction where 437 | parseJSON = withObject "function" $ \v -> 438 | OutputFunction 439 | <$> v .: "name" 440 | <*> v .: "arguments" 441 | 442 | instance ToJSON ToolCall where 443 | toJSON ToolCall {..} = object ["function" .= outputFunction] 444 | 445 | instance FromJSON ToolCall where 446 | parseJSON = withObject "tool_calls" $ \v -> 447 | ToolCall <$> v .: "function" 448 | -------------------------------------------------------------------------------- /src/Data/Ollama/Common/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | {- | 6 | Module : Data.Ollama.Common.Utils 7 | Copyright : (c) 2025 Tushar Adhatrao 8 | License : MIT 9 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 10 | Stability : experimental 11 | Description : Utility functions for interacting with the Ollama API, including image encoding, HTTP request handling, and retry logic. 12 | 13 | This module provides helper functions for common tasks in the Ollama client, such as encoding images to Base64, 14 | sending HTTP requests to the Ollama API, handling streaming and non-streaming responses, and managing retries for failed requests. 15 | It also includes a default model options configuration and a function to retrieve the Ollama server version. 16 | 17 | The functions in this module are used internally by other modules like 'Data.Ollama.Chat' and 'Data.Ollama.Generate' but can also be used directly for custom API interactions. 18 | -} 19 | module Data.Ollama.Common.Utils 20 | ( -- * Image Encoding 21 | encodeImage 22 | 23 | -- * HTTP Request Handling 24 | , withOllamaRequest 25 | , commonNonStreamingHandler 26 | , commonStreamHandler 27 | , nonJsonHandler 28 | 29 | -- * Model Options 30 | , defaultModelOptions 31 | 32 | -- * Retry Logic 33 | , withRetry 34 | 35 | -- * Version Retrieval 36 | , getVersion 37 | ) where 38 | 39 | import Control.Concurrent (threadDelay) 40 | import Control.Exception (IOException, try) 41 | import Data.Aeson 42 | import Data.ByteString qualified as BS 43 | import Data.ByteString.Base64 qualified as Base64 44 | import Data.ByteString.Lazy qualified as BSL 45 | import Data.Char (toLower) 46 | import Data.Maybe (fromMaybe) 47 | import Data.Ollama.Common.Config 48 | import Data.Ollama.Common.Error 49 | import Data.Ollama.Common.Error qualified as Error 50 | import Data.Ollama.Common.Types 51 | import Data.Text (Text) 52 | import Data.Text qualified as T 53 | import Data.Text.Encoding qualified as TE 54 | import Network.HTTP.Client 55 | import Network.HTTP.Client.TLS 56 | import Network.HTTP.Types (Status (statusCode)) 57 | import System.Directory 58 | import System.FilePath 59 | 60 | -- | List of supported image file extensions for 'encodeImage'. 61 | supportedExtensions :: [String] 62 | supportedExtensions = [".jpg", ".jpeg", ".png"] 63 | 64 | -- | Safely read a file, returning an 'Either' with an 'IOException' on failure. 65 | safeReadFile :: FilePath -> IO (Either IOException BS.ByteString) 66 | safeReadFile = try . BS.readFile 67 | 68 | -- | Read a file if it exists, returning 'Nothing' if it does not. 69 | asPath :: FilePath -> IO (Maybe BS.ByteString) 70 | asPath filePath = do 71 | exists <- doesFileExist filePath 72 | if exists 73 | then either (const Nothing) Just <$> safeReadFile filePath 74 | else return Nothing 75 | 76 | -- | Check if a file has a supported image extension. 77 | isSupportedExtension :: FilePath -> Bool 78 | isSupportedExtension p = map toLower (takeExtension p) `elem` supportedExtensions 79 | 80 | {- | Encodes an image file to Base64 format. 81 | 82 | Takes a file path to an image (jpg, jpeg, or png) and returns its data encoded as a Base64 'Text'. 83 | Returns 'Nothing' if the file extension is unsupported or the file cannot be read. 84 | This is useful for including images in API requests that expect Base64-encoded data, such as 'GenerateOps' images field. 85 | -} 86 | encodeImage :: FilePath -> IO (Maybe Text) 87 | encodeImage filePath = do 88 | if not (isSupportedExtension filePath) 89 | then return Nothing 90 | else do 91 | maybeContent <- asPath filePath 92 | return $ fmap (TE.decodeUtf8 . Base64.encode) maybeContent 93 | 94 | {- | Executes an action with retry logic for recoverable errors. 95 | 96 | Retries the given action up to the specified number of times with a delay (in seconds) between attempts. 97 | Only retries on recoverable errors such as HTTP errors, timeouts, JSON schema errors, or decoding errors. 98 | -} 99 | withRetry :: 100 | -- | Number of retries 101 | Int -> 102 | -- | Delay between retries in seconds 103 | Int -> 104 | -- | Action to execute, returning 'Either' 'OllamaError' or a result 105 | IO (Either OllamaError a) -> 106 | IO (Either OllamaError a) 107 | withRetry 0 _ action = action 108 | withRetry retries delaySeconds action = do 109 | result <- action 110 | case result of 111 | Left err | isRetryableError err -> do 112 | threadDelay (delaySeconds * 1000000) -- Convert to microseconds 113 | withRetry (retries - 1) delaySeconds action 114 | _ -> return result 115 | where 116 | isRetryableError (HttpError _) = True 117 | isRetryableError (TimeoutError _) = True 118 | isRetryableError (JsonSchemaError _) = True 119 | isRetryableError (DecodeError _ _) = True 120 | isRetryableError _ = False 121 | 122 | {- | Sends an HTTP request to the Ollama API. 123 | 124 | A unified function for making API requests to the Ollama server. Supports both GET and POST methods, 125 | customizable payloads, and optional configuration. The response is processed by the provided handler. 126 | -} 127 | withOllamaRequest :: 128 | forall payload response. 129 | (ToJSON payload) => 130 | -- | API endpoint 131 | Text -> 132 | -- | HTTP method ("GET" or "POST") 133 | BS.ByteString -> 134 | -- | Optional request payload (must implement 'ToJSON') 135 | Maybe payload -> 136 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig') 137 | Maybe OllamaConfig -> 138 | -- | Response handler to process the HTTP response 139 | (Response BodyReader -> IO (Either OllamaError response)) -> 140 | IO (Either OllamaError response) 141 | withOllamaRequest endpoint reqMethod mbPayload mbOllamaConfig handler = do 142 | let OllamaConfig {..} = fromMaybe defaultOllamaConfig mbOllamaConfig 143 | fullUrl = T.unpack $ hostUrl <> endpoint 144 | timeoutMicros = timeout * 1000000 145 | manager <- case commonManager of 146 | Nothing -> 147 | newTlsManagerWith 148 | tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro timeoutMicros} 149 | Just m -> pure m 150 | eRequest <- try $ parseRequest fullUrl 151 | case eRequest of 152 | Left ex -> return $ Left $ Error.HttpError ex 153 | Right req -> do 154 | let request = 155 | req 156 | { method = reqMethod 157 | , requestBody = 158 | maybe mempty (\x -> RequestBodyLBS $ encode x) mbPayload 159 | } 160 | retryCnt = fromMaybe 0 retryCount 161 | retryDelay_ = fromMaybe 1 retryDelay 162 | withRetry retryCnt retryDelay_ $ do 163 | fromMaybe (pure ()) onModelStart 164 | eResponse <- try $ withResponse request manager handler 165 | case eResponse of 166 | Left ex -> do 167 | fromMaybe (pure ()) onModelError 168 | case ex of 169 | (HttpExceptionRequest _ ResponseTimeout) -> 170 | return $ Left $ Error.TimeoutError "No response from LLM yet" 171 | _ -> return $ Left $ Error.HttpError ex 172 | Right result -> do 173 | fromMaybe (pure ()) onModelFinish 174 | return result 175 | 176 | {- | Handles non-streaming API responses. 177 | 178 | Processes an HTTP response, accumulating all chunks until EOF and decoding the result as JSON. 179 | Returns an 'Either' with an 'OllamaError' on failure or the decoded response on success. 180 | Suitable for APIs that return a single JSON response. 181 | -} 182 | commonNonStreamingHandler :: 183 | FromJSON a => 184 | Response BodyReader -> 185 | IO (Either OllamaError a) 186 | commonNonStreamingHandler resp = do 187 | let bodyReader = responseBody resp 188 | respStatus = statusCode $ responseStatus resp 189 | if respStatus >= 200 && respStatus < 300 190 | then do 191 | finalBs <- readFullBuff BS.empty bodyReader 192 | case eitherDecode (BSL.fromStrict finalBs) of 193 | Left err -> pure . Left $ Error.DecodeError err (show finalBs) 194 | Right decoded -> pure . Right $ decoded 195 | else Left . ApiError . TE.decodeUtf8 <$> brRead bodyReader 196 | 197 | {- | Accumulates response chunks into a single ByteString. 198 | 199 | Internal helper function to read all chunks from a 'BodyReader' until EOF. 200 | -} 201 | readFullBuff :: BS.ByteString -> BodyReader -> IO BS.ByteString 202 | readFullBuff acc reader = do 203 | chunk <- brRead reader 204 | if BS.null chunk 205 | then pure acc 206 | else readFullBuff (acc `BS.append` chunk) reader 207 | 208 | {- | Handles streaming API responses. 209 | 210 | Processes a streaming HTTP response, decoding each chunk as JSON and passing it to the provided 211 | 'sendChunk' function. The 'flush' function is called after each chunk. Stops when the response 212 | indicates completion (via 'HasDone'). Returns the final decoded response or an error. 213 | -} 214 | commonStreamHandler :: 215 | (HasDone a, FromJSON a) => 216 | -- | Function to handle each decoded chunk 217 | (a -> IO ()) -> 218 | Response BodyReader -> 219 | IO (Either OllamaError a) 220 | commonStreamHandler sendChunk resp = go mempty 221 | where 222 | go acc = do 223 | bs <- brRead $ responseBody resp 224 | if BS.null bs 225 | then do 226 | case eitherDecode (BSL.fromStrict acc) of 227 | Left err -> pure $ Left $ Error.DecodeError err (show acc) 228 | Right decoded -> pure $ Right decoded 229 | else do 230 | let chunk = BSL.fromStrict bs 231 | case eitherDecode chunk of 232 | Left err -> return $ Left $ Error.DecodeError err (show acc) 233 | Right res -> do 234 | sendChunk res 235 | if getDone res then return (Right res) else go (acc <> bs) 236 | 237 | {- | Handles non-JSON API responses. 238 | 239 | Processes an HTTP response, accumulating all chunks into a 'ByteString'. Returns the accumulated 240 | data on success (HTTP status 2xx) or an 'ApiError' on failure. 241 | -} 242 | nonJsonHandler :: Response BodyReader -> IO (Either OllamaError BS.ByteString) 243 | nonJsonHandler resp = do 244 | let bodyReader = responseBody resp 245 | respStatus = statusCode $ responseStatus resp 246 | if respStatus >= 200 && respStatus < 300 247 | then Right <$> readFullBuff BS.empty bodyReader 248 | else Left . ApiError . TE.decodeUtf8 <$> brRead bodyReader 249 | 250 | {- | Default model options for API requests. 251 | 252 | Provides a default 'ModelOptions' configuration with all fields set to 'Nothing', 253 | suitable as a starting point for customizing model parameters like temperature or token limits. 254 | 255 | Example: 256 | 257 | >>> let opts = defaultModelOptions { temperature = Just 0.7 } 258 | -} 259 | defaultModelOptions :: ModelOptions 260 | defaultModelOptions = 261 | ModelOptions 262 | { numKeep = Nothing 263 | , seed = Nothing 264 | , numPredict = Nothing 265 | , topK = Nothing 266 | , topP = Nothing 267 | , minP = Nothing 268 | , typicalP = Nothing 269 | , repeatLastN = Nothing 270 | , temperature = Nothing 271 | , repeatPenalty = Nothing 272 | , presencePenalty = Nothing 273 | , frequencyPenalty = Nothing 274 | , penalizeNewline = Nothing 275 | , stop = Nothing 276 | , numa = Nothing 277 | , numCtx = Nothing 278 | , numBatch = Nothing 279 | , numGpu = Nothing 280 | , mainGpu = Nothing 281 | , useMmap = Nothing 282 | , numThread = Nothing 283 | } 284 | 285 | {- | Retrieves the Ollama server version. 286 | 287 | Sends a GET request to the @\/api\/version@ endpoint and returns the server version 288 | as a 'Version' wrapped in an 'Either' 'OllamaError'. 289 | 290 | Example: 291 | 292 | >>> getVersion 293 | 294 | @since 0.2.0.0 295 | -} 296 | getVersion :: IO (Either OllamaError Version) 297 | getVersion = do 298 | withOllamaRequest 299 | "/api/version" 300 | "GET" 301 | (Nothing :: Maybe Value) 302 | Nothing 303 | commonNonStreamingHandler 304 | -------------------------------------------------------------------------------- /src/Data/Ollama/Conversation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Data.Ollama.Conversation 7 | Copyright : (c) 2025 Tushar Adhatrao 8 | License : MIT 9 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 10 | Stability : experimental 11 | Description : Conversation management for the Ollama client, including storage and retrieval of chat sessions. 12 | 13 | This module provides types and functions for managing conversations in the Ollama client. It defines 14 | a 'Conversation' type to represent a chat session, a 'ConversationStore' typeclass for storage operations, 15 | and an in-memory implementation using 'InMemoryStore' and 'ConvoM'. The module supports saving, loading, 16 | listing, and deleting conversations, with thread-safe operations using STM (Software Transactional Memory). 17 | 18 | The 'Conversation' type includes metadata such as a unique ID, messages, model name, and timestamps. 19 | The 'ConversationStore' typeclass defines a generic interface for conversation storage, while 'InMemoryStore' 20 | provides a concrete in-memory implementation. The 'ConvoM' monad integrates with 'InMemoryStore' for 21 | monadic operations. 22 | 23 | Example: 24 | 25 | >>> store <- initInMemoryStore 26 | >>> let conv = Conversation "conv1" [userMessage "Hello!"] "gemma3" <$> getCurrentTime <*> getCurrentTime 27 | >>> runInMemoryConvo store $ saveConversation conv 28 | >>> runInMemoryConvo store $ loadConversation "conv1" 29 | Just (Conversation ...) 30 | -} 31 | module Data.Ollama.Conversation 32 | ( -- * Conversation Types 33 | Conversation (..) 34 | , ConversationStore (..) 35 | 36 | -- * In-Memory Store 37 | , InMemoryStore (..) 38 | , ConvoM (..) 39 | , initInMemoryStore 40 | , runInMemoryConvo 41 | 42 | -- * Validation 43 | , validateConversation 44 | ) where 45 | 46 | import Control.Concurrent.STM 47 | import Control.Monad.Reader 48 | import Data.Aeson (FromJSON, ToJSON) 49 | import Data.Map.Strict (Map) 50 | import Data.Map.Strict qualified as Map 51 | import Data.Ollama.Common.Types 52 | import Data.Text (Text) 53 | import Data.Text qualified as T 54 | import Data.Time (UTCTime, getCurrentTime) 55 | import GHC.Generics (Generic) 56 | 57 | {- | Represents a chat session with metadata and messages. 58 | 59 | Stores a conversation's unique identifier, list of messages, model name, creation time, and last updated time. 60 | -} 61 | data Conversation = Conversation 62 | { conversationId :: !Text 63 | -- ^ Unique identifier for the conversation. 64 | , messages :: ![Message] 65 | -- ^ List of messages in the conversation. 66 | , model :: !Text 67 | -- ^ Name of the model used in the conversation (e.g., "gemma3"). 68 | , createdAt :: !UTCTime 69 | -- ^ Timestamp when the conversation was created. 70 | , lastUpdated :: !UTCTime 71 | -- ^ Timestamp when the conversation was last updated. 72 | } 73 | deriving (Show, Eq, Generic) 74 | 75 | instance ToJSON Conversation 76 | instance FromJSON Conversation 77 | 78 | {- | Typeclass defining operations for storing and managing conversations. 79 | 80 | Provides methods for saving, loading, listing, and deleting conversations in a monadic context. 81 | 82 | @since 0.2.0.0 83 | -} 84 | class Monad m => ConversationStore m where 85 | -- | Saves a conversation to the store. 86 | -- 87 | -- Validates the conversation and updates its 'lastUpdated' timestamp before saving. 88 | saveConversation :: Conversation -> m () 89 | 90 | -- | Loads a conversation by its ID. 91 | -- 92 | -- Returns 'Just' the conversation if found, or 'Nothing' if not. 93 | loadConversation :: Text -> m (Maybe Conversation) 94 | 95 | -- | Lists all conversations in the store. 96 | listConversations :: m [Conversation] 97 | 98 | -- | Deletes a conversation by its ID. 99 | -- 100 | -- Returns 'True' if the conversation was found and deleted, 'False' otherwise. 101 | deleteConversation :: Text -> m Bool 102 | 103 | {- | In-memory conversation store using a 'TVar' for thread-safe operations. 104 | 105 | Stores conversations in a 'Map' keyed by conversation IDs, wrapped in a 'TVar' for concurrent access. 106 | -} 107 | newtype InMemoryStore = InMemoryStore (TVar (Map Text Conversation)) 108 | 109 | {- | Monad for operations with 'InMemoryStore'. 110 | 111 | A wrapper around 'ReaderT' that provides access to an 'InMemoryStore' in a monadic context. 112 | -} 113 | newtype ConvoM a = ConvoM {runConvoM :: ReaderT InMemoryStore IO a} 114 | deriving (Functor, Applicative, Monad, MonadIO, MonadReader InMemoryStore) 115 | 116 | {- | Runs a 'ConvoM' action with the given 'InMemoryStore'. 117 | 118 | Executes a monadic computation in the context of an in-memory store. 119 | 120 | Example: 121 | 122 | >>> store <- initInMemoryStore 123 | >>> runInMemoryConvo store $ saveConversation conv 124 | -} 125 | runInMemoryConvo :: InMemoryStore -> ConvoM a -> IO a 126 | runInMemoryConvo store = flip runReaderT store . runConvoM 127 | 128 | instance ConversationStore ConvoM where 129 | saveConversation conv = do 130 | case validateConversation conv of 131 | Left err -> liftIO $ putStrLn ("Validation error: " <> T.unpack err) 132 | Right validConv -> do 133 | now <- liftIO getCurrentTime 134 | let updatedConv = validConv {lastUpdated = now} 135 | InMemoryStore ref <- ask 136 | liftIO . atomically $ modifyTVar' ref (Map.insert (conversationId updatedConv) updatedConv) 137 | 138 | loadConversation cid = do 139 | InMemoryStore ref <- ask 140 | convs <- liftIO $ readTVarIO ref 141 | return $ Map.lookup cid convs 142 | 143 | listConversations = do 144 | InMemoryStore ref <- ask 145 | convs <- liftIO $ readTVarIO ref 146 | return $ Map.elems convs 147 | 148 | deleteConversation cid = do 149 | InMemoryStore ref <- ask 150 | liftIO . atomically $ do 151 | convs <- readTVar ref 152 | if Map.member cid convs 153 | then do 154 | writeTVar ref (Map.delete cid convs) 155 | return True 156 | else return False 157 | 158 | {- | Validates a 'Conversation' to ensure required fields are non-empty. 159 | 160 | Checks that the 'conversationId' is not empty and that the 'messages' list contains at least one message. 161 | Returns 'Right' with the validated conversation or 'Left' with an error message. 162 | 163 | Example: 164 | 165 | >>> let conv = Conversation "" [] "gemma3" time time 166 | >>> validateConversation conv 167 | Left "Conversation ID cannot be empty" 168 | -} 169 | validateConversation :: Conversation -> Either Text Conversation 170 | validateConversation conv 171 | | T.null (conversationId conv) = Left "Conversation ID cannot be empty" 172 | | null (messages conv) = Left "Conversation must have at least one message" 173 | | otherwise = Right conv 174 | 175 | {- | Creates a new empty in-memory conversation store. 176 | 177 | Initializes an 'InMemoryStore' with an empty 'Map' wrapped in a 'TVar' for thread-safe operations. 178 | 179 | Example: 180 | 181 | >>> store <- initInMemoryStore 182 | >>> runInMemoryConvo store $ listConversations 183 | [] 184 | -} 185 | initInMemoryStore :: IO InMemoryStore 186 | initInMemoryStore = InMemoryStore <$> newTVarIO Map.empty 187 | -------------------------------------------------------------------------------- /src/Data/Ollama/Copy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- | 7 | Module : Data.Ollama.Copy 8 | Copyright : (c) 2025 Tushar Adhatrao 9 | License : MIT 10 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 11 | Stability : experimental 12 | Description : Functionality for copying models in the Ollama client. 13 | 14 | This module provides functions to copy a model from a source name to a destination name using the Ollama API. 15 | It includes both an IO-based function ('copyModel') and a monadic version ('copyModelM') for use in 16 | 'MonadIO' contexts. The copy operation is performed via a POST request to the @\/api\/copy@ endpoint. 17 | 18 | Example: 19 | 20 | >>> copyModel "gemma3" "gemma3-copy" Nothing 21 | Right () 22 | -} 23 | module Data.Ollama.Copy 24 | ( -- * Copy Model API 25 | copyModel 26 | , copyModelM 27 | ) where 28 | 29 | import Control.Monad.IO.Class (MonadIO (liftIO)) 30 | import Data.Aeson 31 | import Data.Ollama.Common.Config (OllamaConfig (..)) 32 | import Data.Ollama.Common.Error (OllamaError) 33 | import Data.Ollama.Common.Utils (nonJsonHandler, withOllamaRequest) 34 | import Data.Text (Text) 35 | import GHC.Generics 36 | 37 | -- | Configuration for copying a model. 38 | data CopyModelOps = CopyModelOps 39 | { source :: !Text 40 | -- ^ The name of the source model to copy. 41 | , destination :: !Text 42 | -- ^ The name of the destination model. 43 | } 44 | deriving (Show, Eq, Generic, ToJSON) 45 | 46 | {- | Copies a model from a source name to a destination name. 47 | 48 | Sends a POST request to the @\/api\/copy@ endpoint with the source and destination model names. 49 | Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure. 50 | Example: 51 | 52 | >>> copyModel "gemma3" "gemma3-copy" Nothing 53 | Right () 54 | -} 55 | copyModel :: 56 | -- | Source model name 57 | Text -> 58 | -- | Destination model name 59 | Text -> 60 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 61 | Maybe OllamaConfig -> 62 | IO (Either OllamaError ()) 63 | copyModel 64 | source_ 65 | destination_ 66 | mbConfig = do 67 | let reqBody = CopyModelOps {source = source_, destination = destination_} 68 | withOllamaRequest 69 | "/api/copy" 70 | "POST" 71 | (Just reqBody) 72 | mbConfig 73 | (fmap ((const ()) <$>) . nonJsonHandler) 74 | 75 | {- | MonadIO version of 'copyModel' for use in monadic contexts. 76 | 77 | Lifts the 'copyModel' function into a 'MonadIO' context, allowing it to be used in monadic computations. 78 | 79 | Example: 80 | 81 | >>> import Control.Monad.IO.Class 82 | >>> runReaderT (copyModelM "gemma3" "gemma3-copy" Nothing) someContext 83 | Right () 84 | -} 85 | copyModelM :: MonadIO m => Text -> Text -> Maybe OllamaConfig -> m (Either OllamaError ()) 86 | copyModelM s d mbCfg = liftIO $ copyModel s d mbCfg 87 | -------------------------------------------------------------------------------- /src/Data/Ollama/Create.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DuplicateRecordFields #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | {- | 6 | Module : Data.Ollama.Create 7 | Copyright : (c) 2025 Tushar Adhatrao 8 | License : MIT 9 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 10 | Stability : experimental 11 | Description : Functionality for creating new models in the Ollama client. 12 | 13 | This module provides functions to create a new model in the Ollama API using either a model file 14 | content or a file path. It includes both an IO-based function ('createModel') and a monadic version 15 | ('createModelM') for use in 'MonadIO' contexts. The create operation is performed via a POST request 16 | to the @\/api\/pull@ endpoint, with streaming support for progress updates. 17 | 18 | Note: If both 'modelFile' and 'path' are provided, 'modelFile' takes precedence. 19 | 20 | Example: 21 | 22 | >>> createModel "myModel" (Just "FROM llama3\nPARAMETER temperature 0.8") (Just True) Nothing Nothing 23 | Creating model... 24 | Completed 25 | -} 26 | module Data.Ollama.Create 27 | ( -- * Create Model API 28 | createModel 29 | , createModelM 30 | ) where 31 | 32 | import Control.Monad (void) 33 | import Control.Monad.IO.Class (MonadIO (liftIO)) 34 | import Data.Aeson 35 | import Data.Ollama.Common.Config (OllamaConfig) 36 | import Data.Ollama.Common.Types (HasDone (getDone)) 37 | import Data.Ollama.Common.Utils as CU 38 | import Data.Text (Text) 39 | 40 | -- | Configuration for creating a new model. 41 | data CreateModelOps = CreateModelOps 42 | { name :: !Text 43 | -- ^ The name of the model to create. 44 | , modelFile :: !(Maybe Text) 45 | -- ^ Optional model file content (e.g., Modelfile text). Takes precedence over 'path'. 46 | , stream :: !(Maybe Bool) 47 | -- ^ Optional flag to enable streaming progress updates. 48 | , path :: !(Maybe FilePath) 49 | -- ^ Optional file path to a Modelfile. 50 | } 51 | deriving (Show, Eq) 52 | 53 | -- | Response type for model creation. 54 | newtype CreateModelResp 55 | = -- | The status of the create operation (e.g., "success"). 56 | CreateModelResp {status :: Text} 57 | deriving (Show, Eq) 58 | 59 | instance HasDone CreateModelResp where 60 | getDone CreateModelResp {..} = status /= "success" 61 | 62 | instance ToJSON CreateModelOps where 63 | toJSON 64 | ( CreateModelOps 65 | name_ 66 | modelFile_ 67 | stream_ 68 | path_ 69 | ) = 70 | object 71 | [ "name" .= name_ 72 | , "modelfile" .= modelFile_ 73 | , "stream" .= stream_ 74 | , "path" .= path_ 75 | ] 76 | 77 | instance FromJSON CreateModelResp where 78 | parseJSON = withObject "CreateModelResp" $ \v -> 79 | CreateModelResp 80 | <$> v .: "status" 81 | 82 | {- | Creates a new model using either model file content or a file path. 83 | 84 | Sends a POST request to the @\/api\/pull@ endpoint to create a model with the specified name. 85 | The model can be defined either by 'modelFile' (Modelfile content as text) or 'path' (file path to a Modelfile). 86 | If both are provided, 'modelFile' is used. Supports streaming progress updates if 'stream' is 'Just True'. 87 | Prints progress messages to the console during creation. 88 | -} 89 | createModel :: 90 | -- | Model name 91 | Text -> 92 | -- | Optional model file content 93 | Maybe Text -> 94 | -- | Optional streaming flag 95 | Maybe Bool -> 96 | -- | Optional file path to a Modelfile 97 | Maybe FilePath -> 98 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 99 | Maybe OllamaConfig -> 100 | IO () 101 | createModel 102 | modelName 103 | modelFile_ 104 | stream_ 105 | path_ 106 | mbConfig = 107 | void $ 108 | withOllamaRequest 109 | "/api/pull" 110 | "POST" 111 | ( Just $ 112 | CreateModelOps 113 | { name = modelName 114 | , modelFile = modelFile_ 115 | , stream = stream_ 116 | , path = path_ 117 | } 118 | ) 119 | mbConfig 120 | (commonStreamHandler onToken) 121 | where 122 | onToken :: CreateModelResp -> IO () 123 | onToken _ = putStrLn "Creating model..." 124 | 125 | 126 | {- | MonadIO version of 'createModel' for use in monadic contexts. 127 | 128 | Lifts the 'createModel' function into a 'MonadIO' context, allowing it to be used in monadic computations. 129 | -} 130 | createModelM :: 131 | MonadIO m => 132 | Text -> 133 | Maybe Text -> 134 | Maybe Bool -> 135 | Maybe FilePath -> 136 | Maybe OllamaConfig -> 137 | m () 138 | createModelM m mf s p mbCfg = liftIO $ createModel m mf s p mbCfg 139 | -------------------------------------------------------------------------------- /src/Data/Ollama/Delete.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE DuplicateRecordFields #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- | 7 | Module : Data.Ollama.Delete 8 | Copyright : (c) 2025 Tushar Adhatrao 9 | License : MIT 10 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 11 | Stability : experimental 12 | Description : Functionality for deleting models in the Ollama client. 13 | 14 | This module provides functions to delete a model from the Ollama server using its name. It includes 15 | both an IO-based function ('deleteModel') and a monadic version ('deleteModelM') for use in 16 | 'MonadIO' contexts. The delete operation is performed via a DELETE request to the @\/api\/delete@ endpoint. 17 | 18 | Example: 19 | 20 | >>> deleteModel "gemma3" Nothing 21 | Right () 22 | -} 23 | module Data.Ollama.Delete 24 | ( -- * Delete Model API 25 | deleteModel 26 | , deleteModelM 27 | ) where 28 | 29 | import Control.Monad.IO.Class (MonadIO (liftIO)) 30 | import Data.Aeson 31 | import Data.Ollama.Common.Config (OllamaConfig (..)) 32 | import Data.Ollama.Common.Error (OllamaError) 33 | import Data.Ollama.Common.Utils (nonJsonHandler, withOllamaRequest) 34 | import Data.Text (Text) 35 | 36 | -- | Request payload for deleting a model. 37 | newtype DeleteModelReq 38 | = -- | The name of the model to delete. 39 | DeleteModelReq {name :: Text} 40 | deriving newtype (Show, Eq) 41 | 42 | instance ToJSON DeleteModelReq where 43 | toJSON (DeleteModelReq name_) = object ["name" .= name_] 44 | 45 | {- | Deletes a model from the Ollama server. 46 | 47 | Sends a DELETE request to the "/api/delete" endpoint with the specified model name. 48 | Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure. 49 | -} 50 | deleteModel :: 51 | -- | Model name to delete 52 | Text -> 53 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 54 | Maybe OllamaConfig -> 55 | IO (Either OllamaError ()) 56 | deleteModel modelName mbConfig = do 57 | let reqBody = DeleteModelReq {name = modelName} 58 | withOllamaRequest 59 | "/api/delete" 60 | "DELETE" 61 | (Just reqBody) 62 | mbConfig 63 | (fmap ((const ()) <$>) . nonJsonHandler) 64 | 65 | {- | MonadIO version of 'deleteModel' for use in monadic contexts. 66 | 67 | Lifts the 'deleteModel' function into a context, 68 | allowing it to be used in monadic computations. 69 | -} 70 | deleteModelM :: MonadIO m => Text -> Maybe OllamaConfig -> m (Either OllamaError ()) 71 | deleteModelM t mbCfg = liftIO $ deleteModel t mbCfg 72 | -------------------------------------------------------------------------------- /src/Data/Ollama/Embeddings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- | 4 | Module : Data.Ollama.Embeddings 5 | Copyright : (c) 2025 Tushar Adhatrao 6 | License : MIT 7 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 8 | Stability : experimental 9 | Description : Functionality for generating text embeddings using the Ollama API. 10 | 11 | This module provides functions to generate text embeddings from an Ollama model. It includes both 12 | high-level ('embedding', 'embeddingM') and low-level ('embeddingOps', 'embeddingOpsM') APIs for 13 | generating embeddings, with support for customizing model options, truncation, and keep-alive settings. 14 | The embeddings are returned as a list of float vectors, suitable for tasks like semantic search or 15 | text similarity analysis. 16 | 17 | The 'EmbeddingOps' type configures the embedding request, and 'EmbeddingResp' represents the response 18 | containing the model name and the generated embeddings. The 'defaultEmbeddingOps' provides a default 19 | configuration for convenience. 20 | 21 | Example: 22 | 23 | >>> embedding "llama3.2" ["Hello, world!"] 24 | Right (EmbeddingResp "llama3.2" [[0.1, 0.2, ...]]) 25 | -} 26 | module Data.Ollama.Embeddings 27 | ( -- * Embedding API 28 | embedding 29 | , embeddingOps 30 | , embeddingM 31 | , embeddingOpsM 32 | 33 | -- * Configuration and Response Types 34 | , defaultEmbeddingOps 35 | , EmbeddingOps (..) 36 | , EmbeddingResp (..) 37 | 38 | -- * Model Options 39 | , ModelOptions (..) 40 | , defaultModelOptions 41 | ) where 42 | 43 | import Control.Monad.IO.Class (MonadIO (liftIO)) 44 | import Data.Aeson 45 | import Data.Ollama.Common.Config (OllamaConfig) 46 | import Data.Ollama.Common.Error (OllamaError) 47 | import Data.Ollama.Common.Types (ModelOptions (..)) 48 | import Data.Ollama.Common.Utils as CU 49 | import Data.Text (Text) 50 | 51 | {- | Default configuration for embedding requests. 52 | 53 | Provides a default 'EmbeddingOps' with the "llama3.2" model, an empty input list, and no additional options. 54 | Can be customized by modifying fields as needed. 55 | -} 56 | defaultEmbeddingOps :: EmbeddingOps 57 | defaultEmbeddingOps = 58 | EmbeddingOps 59 | { model = "llama3.2" 60 | , input = [] 61 | , truncateInput = Nothing 62 | , keepAliveEmbed = Nothing 63 | , modelOptions = Nothing 64 | } 65 | 66 | -- | Configuration for an embedding request. 67 | data EmbeddingOps = EmbeddingOps 68 | { model :: !Text 69 | -- ^ The name of the model to use for generating embeddings (e.g., "llama3.2"). 70 | , input :: ![Text] 71 | -- ^ List of input texts to generate embeddings for. 72 | , truncateInput :: !(Maybe Bool) 73 | -- ^ Optional flag to truncate input if it exceeds model limits. 74 | , keepAliveEmbed :: !(Maybe Int) 75 | -- ^ Optional override for the keep-alive timeout in minutes. 76 | , modelOptions :: !(Maybe ModelOptions) 77 | -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile. 78 | -- 79 | -- @since 0.2.0.0 80 | } 81 | deriving (Show, Eq) 82 | 83 | -- | Response type for an embedding request. 84 | data EmbeddingResp = EmbeddingResp 85 | { respondedModel :: !Text 86 | -- ^ The name of the model that generated the embeddings. 87 | , respondedEmbeddings :: ![[Float]] 88 | -- ^ List of embedding vectors, one for each input text. 89 | } 90 | deriving (Show, Eq) 91 | 92 | instance FromJSON EmbeddingResp where 93 | parseJSON = withObject "EmbeddingResp" $ \v -> 94 | EmbeddingResp 95 | <$> v .: "model" 96 | <*> v .: "embeddings" 97 | 98 | instance ToJSON EmbeddingOps where 99 | toJSON (EmbeddingOps model_ input_ truncate' keepAlive_ ops) = 100 | object 101 | [ "model" .= model_ 102 | , "input" .= input_ 103 | , "truncate" .= truncate' 104 | , "keep_alive" .= keepAlive_ 105 | , "options" .= ops 106 | ] 107 | 108 | {- | Generates embeddings for a list of input texts with full configuration. 109 | 110 | Sends a POST request to the @\/api\/embed@ endpoint to generate embeddings for the provided inputs. 111 | Allows customization of truncation, keep-alive settings, model options, and Ollama configuration. 112 | Returns 'Right' with an 'EmbeddingResp' on success or 'Left' with an 'OllamaError' on failure. 113 | -} 114 | embeddingOps :: 115 | -- | Model name 116 | Text -> 117 | -- | List of input texts 118 | [Text] -> 119 | -- | Optional truncation flag 120 | Maybe Bool -> 121 | -- | Optional keep-alive timeout in minutes 122 | Maybe Int -> 123 | -- | Optional model options 124 | Maybe ModelOptions -> 125 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 126 | Maybe OllamaConfig -> 127 | IO (Either OllamaError EmbeddingResp) 128 | embeddingOps modelName input_ mTruncate mKeepAlive mbOptions mbConfig = do 129 | withOllamaRequest 130 | "/api/embed" 131 | "POST" 132 | ( Just $ 133 | EmbeddingOps 134 | { model = modelName 135 | , input = input_ 136 | , truncateInput = mTruncate 137 | , keepAliveEmbed = mKeepAlive 138 | , modelOptions = mbOptions 139 | } 140 | ) 141 | mbConfig 142 | commonNonStreamingHandler 143 | 144 | {- | Simplified API for generating embeddings. 145 | 146 | A higher-level function that generates embeddings using default settings for truncation, keep-alive, 147 | model options, and Ollama configuration. Suitable for basic use cases. 148 | -} 149 | embedding :: 150 | -- | Model name 151 | Text -> 152 | -- | List of input texts 153 | [Text] -> 154 | IO (Either OllamaError EmbeddingResp) 155 | embedding modelName input_ = 156 | embeddingOps modelName input_ Nothing Nothing Nothing Nothing 157 | 158 | {- | MonadIO version of 'embedding' for use in monadic contexts. 159 | 160 | Lifts the 'embedding' function into a 'MonadIO' context, allowing it to be used in monadic computations. 161 | -} 162 | embeddingM :: MonadIO m => Text -> [Text] -> m (Either OllamaError EmbeddingResp) 163 | embeddingM m ip = liftIO $ embedding m ip 164 | 165 | {- | MonadIO version of 'embeddingOps' for use in monadic contexts. 166 | 167 | Lifts the 'embeddingOps' function into a 'MonadIO' context, allowing it to be used in monadic computations 168 | with full configuration options. 169 | -} 170 | embeddingOpsM :: 171 | MonadIO m => 172 | Text -> 173 | [Text] -> 174 | Maybe Bool -> 175 | Maybe Int -> 176 | Maybe ModelOptions -> 177 | Maybe OllamaConfig -> 178 | m (Either OllamaError EmbeddingResp) 179 | embeddingOpsM m ip mbTruncate mbKeepAlive mbOptions mbCfg = 180 | liftIO $ embeddingOps m ip mbTruncate mbKeepAlive mbOptions mbCfg 181 | -------------------------------------------------------------------------------- /src/Data/Ollama/Generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DuplicateRecordFields #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | {- | 6 | Module : Data.Ollama.Generate 7 | Copyright : (c) 2025 Tushar Adhatrao 8 | License : MIT 9 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 10 | Stability : experimental 11 | Description : Text generation functionality for the Ollama client. 12 | 13 | This module provides functions and types for generating text using an Ollama model. It includes APIs 14 | for sending generation requests, both in IO ('generate') and monadic ('generateM') contexts, with 15 | support for streaming and non-streaming responses. The 'GenerateOps' type configures the generation 16 | request, allowing customization of the model, prompt, images, format, and other parameters. The 17 | 'defaultGenerateOps' provides a convenient starting point for configuration. 18 | 19 | The module supports advanced features like Base64-encoded images, custom templates, and model-specific 20 | options (e.g., temperature). It also includes validation to ensure required fields are non-empty. 21 | 22 | Example: 23 | 24 | >>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Write a poem." } 25 | >>> generate ops Nothing 26 | Right (GenerateResponse ...) 27 | -} 28 | module Data.Ollama.Generate 29 | ( -- * Generate Texts 30 | generate 31 | , generateM 32 | 33 | -- * Configuration 34 | , defaultGenerateOps 35 | , GenerateOps (..) 36 | , validateGenerateOps 37 | 38 | -- * Response and Configuration Types 39 | , GenerateResponse (..) 40 | , Format (..) 41 | , OllamaConfig (..) 42 | , defaultOllamaConfig 43 | , ModelOptions (..) 44 | , defaultModelOptions 45 | 46 | -- * Error Types 47 | , OllamaError (..) 48 | ) where 49 | 50 | import Control.Monad.IO.Class (MonadIO (liftIO)) 51 | import Data.Aeson 52 | import Data.Maybe 53 | import Data.Ollama.Common.Config (OllamaConfig (..), defaultOllamaConfig) 54 | import Data.Ollama.Common.Error (OllamaError (..)) 55 | import Data.Ollama.Common.Types (Format (..), GenerateResponse (..), ModelOptions (..)) 56 | import Data.Ollama.Common.Utils as CU 57 | import Data.Text (Text) 58 | import Data.Text qualified as T 59 | 60 | {- | Validates 'GenerateOps' to ensure required fields are non-empty. 61 | 62 | Checks that the 'modelName' and 'prompt' fields are not empty. Returns 'Right' with the validated 63 | 'GenerateOps' or 'Left' with an 'OllamaError' if validation fails. 64 | 65 | Example: 66 | 67 | >>> validateGenerateOps defaultGenerateOps 68 | Left (InvalidRequest "Prompt cannot be empty") 69 | 70 | @since 0.2.0.0 71 | -} 72 | validateGenerateOps :: GenerateOps -> Either OllamaError GenerateOps 73 | validateGenerateOps ops 74 | | T.null (modelName ops) = Left $ InvalidRequest "Model name cannot be empty" 75 | | T.null (prompt ops) = Left $ InvalidRequest "Prompt cannot be empty" 76 | | otherwise = Right ops 77 | 78 | -- | Configuration for a text generation request. 79 | data GenerateOps = GenerateOps 80 | { modelName :: !Text 81 | -- ^ The name of the model to use for generation (e.g., "gemma3"). 82 | , prompt :: !Text 83 | -- ^ The prompt text to provide to the model for generating a response. 84 | , suffix :: Maybe Text 85 | -- ^ Optional suffix to append to the generated text (not supported by all models). 86 | , images :: !(Maybe [Text]) 87 | -- ^ Optional list of Base64-encoded images to include with the request. 88 | , format :: !(Maybe Format) 89 | -- ^ Optional format specifier for the response (e.g., JSON). 90 | -- 91 | -- @since 0.1.3.0 92 | , system :: !(Maybe Text) 93 | -- ^ Optional system text to include in the generation context. 94 | , template :: !(Maybe Text) 95 | -- ^ Optional template to format the response. 96 | , stream :: !(Maybe (GenerateResponse -> IO ())) 97 | -- ^ Optional callback function to be called with each incoming response. 98 | , raw :: !(Maybe Bool) 99 | -- ^ Optional flag to return the raw response. 100 | , keepAlive :: !(Maybe Int) 101 | -- ^ Optional override for how long (in minutes) the model stays loaded in memory (default: 5 minutes). 102 | , options :: !(Maybe ModelOptions) 103 | -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile. 104 | -- 105 | -- @since 0.1.3.0 106 | , think :: !(Maybe Bool) 107 | -- ^ Optional flag to enable thinking mode. 108 | -- 109 | -- @since 0.2.0.0 110 | } 111 | 112 | instance Show GenerateOps where 113 | show GenerateOps {..} = 114 | "GenerateOps { " 115 | <> "model : " 116 | <> T.unpack modelName 117 | <> ", prompt : " 118 | <> T.unpack prompt 119 | <> ", suffix : " 120 | <> show suffix 121 | <> ", images : " 122 | <> show images 123 | <> ", format : " 124 | <> show format 125 | <> ", system : " 126 | <> show system 127 | <> ", template : " 128 | <> show template 129 | <> ", stream : " 130 | <> "Stream functions" 131 | <> ", raw : " 132 | <> show raw 133 | <> ", keepAlive : " 134 | <> show keepAlive 135 | <> ", options : " 136 | <> show options 137 | <> ", think: " 138 | <> show think 139 | 140 | instance Eq GenerateOps where 141 | (==) a b = 142 | modelName a == modelName b 143 | && prompt a == prompt b 144 | && suffix a == suffix b 145 | && images a == images b 146 | && format a == format b 147 | && system a == system b 148 | && template a == template b 149 | && raw a == raw b 150 | && keepAlive a == keepAlive b 151 | && options a == options b 152 | && think a == think b 153 | 154 | instance ToJSON GenerateOps where 155 | toJSON 156 | ( GenerateOps 157 | model 158 | prompt 159 | suffix 160 | images 161 | format 162 | system 163 | template 164 | stream 165 | raw 166 | keepAlive 167 | options 168 | think 169 | ) = 170 | object 171 | [ "model" .= model 172 | , "prompt" .= prompt 173 | , "suffix" .= suffix 174 | , "images" .= images 175 | , "format" .= format 176 | , "system" .= system 177 | , "template" .= template 178 | , "stream" .= if isNothing stream then Just False else Just True 179 | , "raw" .= raw 180 | , "keep_alive" .= keepAlive 181 | , "options" .= options 182 | , "think" .= think 183 | ] 184 | 185 | {- | Default configuration for text generation. 186 | 187 | Provides a default 'GenerateOps' with the "gemma3" model and an empty prompt. Other fields are set 188 | to 'Nothing' or default values. Can be customized by modifying fields as needed. 189 | 190 | Example: 191 | 192 | >>> let ops = defaultGenerateOps { modelName = "customModel", prompt = "Hello!" } 193 | >>> generate ops Nothing 194 | -} 195 | defaultGenerateOps :: GenerateOps 196 | defaultGenerateOps = 197 | GenerateOps 198 | { modelName = "gemma3" 199 | , prompt = "" 200 | , suffix = Nothing 201 | , images = Nothing 202 | , format = Nothing 203 | , system = Nothing 204 | , template = Nothing 205 | , stream = Nothing 206 | , raw = Nothing 207 | , keepAlive = Nothing 208 | , options = Nothing 209 | , think = Nothing 210 | } 211 | 212 | {- | Generates text using the specified model and configuration. 213 | 214 | Validates the 'GenerateOps' configuration and sends a POST request to the @\/api\/generate@ endpoint. 215 | Supports both streaming and non-streaming responses based on the 'stream' field in 'GenerateOps'. 216 | Returns 'Right' with a 'GenerateResponse' on success or 'Left' with an 'OllamaError' on failure. 217 | 218 | Example: 219 | 220 | >>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Write a short poem." } 221 | >>> generate ops Nothing 222 | Right (GenerateResponse ...) 223 | -} 224 | generate :: GenerateOps -> Maybe OllamaConfig -> IO (Either OllamaError GenerateResponse) 225 | generate ops mbConfig = 226 | case validateGenerateOps ops of 227 | Left err -> pure $ Left err 228 | Right _ -> withOllamaRequest "/api/generate" "POST" (Just ops) mbConfig handler 229 | where 230 | handler = case stream ops of 231 | Nothing -> commonNonStreamingHandler 232 | Just sendChunk -> commonStreamHandler sendChunk 233 | 234 | {- | MonadIO version of 'generate' for use in monadic contexts. 235 | 236 | Lifts the 'generate' function into a 'MonadIO' context, allowing it to be used in monadic computations. 237 | 238 | Example: 239 | 240 | >>> import Control.Monad.IO.Class 241 | >>> let ops = defaultGenerateOps { modelName = "gemma3", prompt = "Hello!" } 242 | >>> runReaderT (generateM ops Nothing) someContext 243 | Right (GenerateResponse ...) 244 | -} 245 | generateM :: 246 | MonadIO m => 247 | GenerateOps -> Maybe OllamaConfig -> m (Either OllamaError GenerateResponse) 248 | generateM ops mbCfg = liftIO $ generate ops mbCfg 249 | -------------------------------------------------------------------------------- /src/Data/Ollama/List.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.Ollama.List 3 | -- Copyright : (c) 2025 Tushar Adhatrao 4 | -- License : MIT 5 | -- Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 6 | -- Stability : experimental 7 | -- Description : Functionality for listing available models in the Ollama client. 8 | -- 9 | -- This module provides functions to retrieve a list of models available on the Ollama server. 10 | -- It includes both an IO-based function ('list') and a monadic version ('listM') for use in 11 | -- 'MonadIO' contexts. The list operation is performed via a GET request to the @\/api\/tags@ endpoint, 12 | -- returning a 'Models' type containing a list of 'ModelInfo' records with details about each model. 13 | -- 14 | -- Example: 15 | -- 16 | -- >>> list Nothing 17 | -- Right (Models [ModelInfo ...]) 18 | -- 19 | {-# LANGUAGE OverloadedStrings #-} 20 | 21 | module Data.Ollama.List 22 | ( -- * List Models API 23 | list, 24 | listM, 25 | 26 | -- * Model Types 27 | Models (..), 28 | ModelInfo (..) 29 | ) where 30 | 31 | import Control.Monad.IO.Class (MonadIO (liftIO)) 32 | import Data.Aeson 33 | import Data.Ollama.Common.Config (OllamaConfig) 34 | import Data.Ollama.Common.Error (OllamaError) 35 | import Data.Ollama.Common.Types as CT 36 | import Data.Ollama.Common.Utils as CU 37 | import Data.Text (Text) 38 | import Data.Time 39 | import GHC.Int (Int64) 40 | 41 | -- | A wrapper type containing a list of available models. 42 | -- 43 | newtype Models = Models [ModelInfo] 44 | -- ^ List of 'ModelInfo' records describing available models. 45 | deriving (Eq, Show) 46 | 47 | -- | Details about a specific model. 48 | -- 49 | data ModelInfo = ModelInfo 50 | { name :: !Text 51 | -- ^ The name of the model. 52 | , modifiedAt :: !UTCTime 53 | -- ^ The timestamp when the model was last modified. 54 | , size :: !Int64 55 | -- ^ The size of the model in bytes. 56 | , digest :: !Text 57 | -- ^ The digest (hash) of the model. 58 | , details :: !ModelDetails 59 | -- ^ Additional details about the model (e.g., format, family, parameters). 60 | } deriving (Eq, Show) 61 | 62 | -- | JSON parsing instance for 'Models'. 63 | instance FromJSON Models where 64 | parseJSON = withObject "Models" $ \v -> Models <$> v .: "models" 65 | 66 | -- | JSON parsing instance for 'ModelInfo'. 67 | instance FromJSON ModelInfo where 68 | parseJSON = withObject "ModelInfo" $ \v -> 69 | ModelInfo 70 | <$> v .: "name" 71 | <*> v .: "modified_at" 72 | <*> v .: "size" 73 | <*> v .: "digest" 74 | <*> v .: "details" 75 | 76 | -- | Retrieves a list of available models from the Ollama server. 77 | -- 78 | -- Sends a GET request to the @\/api\/tags@ endpoint to fetch the list of models. 79 | -- Returns 'Right' with a 'Models' containing the list of 'ModelInfo' on success, 80 | -- or 'Left' with an 'OllamaError' on failure. 81 | list :: 82 | Maybe OllamaConfig -> -- ^ Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 83 | IO (Either OllamaError Models) 84 | list mbConfig = do 85 | withOllamaRequest 86 | "/api/tags" 87 | "GET" 88 | (Nothing :: Maybe Value) 89 | mbConfig 90 | commonNonStreamingHandler 91 | 92 | -- | MonadIO version of 'list' for use in monadic contexts. 93 | -- 94 | -- Lifts the 'list' function into a 'MonadIO' context, allowing it to be used in monadic computations. 95 | -- 96 | -- Example: 97 | -- 98 | -- >>> import Control.Monad.IO.Class 99 | -- >>> runReaderT (listM Nothing) someContext 100 | -- Right (Models [ModelInfo ...]) 101 | -- 102 | listM :: MonadIO m => Maybe OllamaConfig -> m (Either OllamaError Models) 103 | listM mbCfg = liftIO $ list mbCfg -------------------------------------------------------------------------------- /src/Data/Ollama/Load.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- | 4 | Module : Data.Ollama.Load 5 | Copyright : (c) 2025 Tushar Adhatrao 6 | License : MIT 7 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 8 | Stability : experimental 9 | Description : High-level functions for loading and unloading models in the Ollama client. 10 | 11 | This module provides functions to load and unload generative models in the Ollama server. 12 | It includes both IO-based functions ('loadGenModel', 'unloadGenModel') and monadic versions 13 | ('loadGenModelM', 'unloadGenModelM') for use in 'MonadIO' contexts. The operations are 14 | performed via POST requests to the @\/api\/generate@ endpoint, leveraging the 'GenerateOps' 15 | configuration from the 'Data.Ollama.Generate' module. 16 | 17 | Loading a model keeps it in memory for faster subsequent requests, while unloading frees 18 | up memory by setting the keep-alive duration to zero. 19 | 20 | Example: 21 | 22 | >>> loadGenModel "gemma3" 23 | Right () 24 | >>> unloadGenModel "gemma3" 25 | Right () 26 | -} 27 | module Data.Ollama.Load 28 | ( -- * Load and Unload Model APIs 29 | loadGenModel 30 | , unloadGenModel 31 | , loadGenModelM 32 | , unloadGenModelM 33 | ) where 34 | 35 | import Control.Monad.IO.Class (MonadIO (liftIO)) 36 | import Data.Ollama.Common.Error 37 | import Data.Ollama.Common.Utils (commonNonStreamingHandler, withOllamaRequest) 38 | import Data.Ollama.Generate qualified as Gen 39 | import Data.Text (Text) 40 | 41 | {- | Loads a generative model into memory. 42 | 43 | Sends a POST request to the @\/api\/generate@ endpoint to load the specified model into 44 | memory, ensuring faster response times for subsequent requests. Returns 'Right ()' on 45 | success or 'Left' with an 'OllamaError' on failure. 46 | 47 | @since 0.2.0.0 48 | -} 49 | loadGenModel :: 50 | -- | Model name (e.g., "gemma3") 51 | Text -> 52 | IO (Either OllamaError ()) 53 | loadGenModel m = do 54 | let ops = Gen.defaultGenerateOps {Gen.modelName = m} 55 | withOllamaRequest "/api/generate" "POST" (Just ops) Nothing commonNonStreamingHandler 56 | 57 | {- | Unloads a generative model from memory. 58 | 59 | Sends a POST request to the @\/api\/generate@ endpoint with a keep-alive duration of zero 60 | to unload the specified model from memory, freeing up resources. Returns 'Right ()' on 61 | success or 'Left' with an 'OllamaError' on failure. 62 | 63 | @since 0.2.0.0 64 | -} 65 | unloadGenModel :: 66 | -- | Model name (e.g., "gemma3") 67 | Text -> 68 | IO (Either OllamaError ()) 69 | unloadGenModel m = do 70 | let ops = Gen.defaultGenerateOps {Gen.modelName = m, Gen.keepAlive = Just 0} 71 | withOllamaRequest "/api/generate" "POST" (Just ops) Nothing commonNonStreamingHandler 72 | 73 | {- | MonadIO version of 'loadGenModel' for use in monadic contexts. 74 | 75 | Lifts the 'loadGenModel' function into a 'MonadIO' context, allowing it to be used in 76 | monadic computations. 77 | 78 | Example: 79 | 80 | >>> import Control.Monad.IO.Class 81 | >>> runReaderT (loadGenModelM "gemma3") someContext 82 | Right () 83 | 84 | @since 0.2.0.0 85 | -} 86 | loadGenModelM :: MonadIO m => Text -> m (Either OllamaError ()) 87 | loadGenModelM t = liftIO $ loadGenModel t 88 | 89 | {- | MonadIO version of 'unloadGenModel' for use in monadic contexts. 90 | 91 | Lifts the 'unloadGenModel' function into a 'MonadIO' context, allowing it to be used in 92 | monadic computations. 93 | 94 | Example: 95 | 96 | >>> import Control.Monad.IO.Class 97 | >>> runReaderT (unloadGenModelM "gemma3") someContext 98 | Right () 99 | 100 | @since 0.2.0.0 101 | -} 102 | unloadGenModelM :: MonadIO m => Text -> m (Either OllamaError ()) 103 | unloadGenModelM t = liftIO $ unloadGenModel t 104 | -------------------------------------------------------------------------------- /src/Data/Ollama/Ps.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- | 4 | Module : Data.Ollama.Ps 5 | Copyright : (c) 2025 Tushar Adhatrao 6 | License : MIT 7 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 8 | Stability : experimental 9 | Description : Functionality for listing running models in the Ollama client. 10 | 11 | This module provides functions to retrieve a list of models currently running on the Ollama server. 12 | It includes both an IO-based function ('ps') and a monadic version ('psM') for use in 'MonadIO' 13 | contexts. The operation is performed via a GET request to the @\/api\/ps@ endpoint, returning a 14 | 'RunningModels' type containing a list of 'RunningModel' records with details about each running model. 15 | 16 | Example: 17 | 18 | >>> ps Nothing 19 | Right (RunningModels [RunningModel ...]) 20 | -} 21 | module Data.Ollama.Ps 22 | ( -- * List Running Models API 23 | ps 24 | , psM 25 | 26 | -- * Model Types 27 | , RunningModels (..) 28 | , RunningModel (..) 29 | ) where 30 | 31 | import Control.Monad.IO.Class (MonadIO (liftIO)) 32 | import Data.Aeson 33 | import Data.Ollama.Common.Config (OllamaConfig) 34 | import Data.Ollama.Common.Error (OllamaError) 35 | import Data.Ollama.Common.Types as CT 36 | import Data.Ollama.Common.Utils as CU 37 | import Data.Text (Text) 38 | import Data.Time 39 | import GHC.Int (Int64) 40 | 41 | -- | A wrapper type containing a list of running models. 42 | newtype RunningModels 43 | = -- | List of 'RunningModel' records describing currently running models. 44 | RunningModels [RunningModel] 45 | deriving (Eq, Show) 46 | 47 | -- | Details about a specific running model. 48 | data RunningModel = RunningModel 49 | { name_ :: !Text 50 | -- ^ The name of the running model instance. 51 | , modelName :: !Text 52 | -- ^ The base model name (e.g., "gemma3"). 53 | , size_ :: !Int64 54 | -- ^ The size of the model in bytes. 55 | , modelDigest :: !Text 56 | -- ^ The digest (hash) of the model. 57 | , modelDetails :: !ModelDetails 58 | -- ^ Additional details about the model (e.g., format, family, parameters). 59 | , expiresAt :: !UTCTime 60 | -- ^ The timestamp when the model's memory allocation expires. 61 | , sizeVRam :: !Int64 62 | -- ^ The size of the model's VRAM usage in bytes. 63 | } 64 | deriving (Eq, Show) 65 | 66 | -- | JSON parsing instance for 'RunningModels'. 67 | instance FromJSON RunningModels where 68 | parseJSON = withObject "Models" $ \v -> RunningModels <$> v .: "models" 69 | 70 | -- | JSON parsing instance for 'RunningModel'. 71 | instance FromJSON RunningModel where 72 | parseJSON = withObject "RunningModel" $ \v -> 73 | RunningModel 74 | <$> v .: "name" 75 | <*> v .: "model" 76 | <*> v .: "size" 77 | <*> v .: "digest" 78 | <*> v .: "details" 79 | <*> v .: "expires_at" 80 | <*> v .: "size_vram" 81 | 82 | {- | Retrieves a list of currently running models from the Ollama server. 83 | 84 | Sends a GET request to the @\/api\/ps@ endpoint to fetch the list of running models. 85 | Returns 'Right' with a 'RunningModels' containing the list of 'RunningModel' on success, 86 | or 'Left' with an 'OllamaError' on failure. 87 | Example: 88 | 89 | >>> ps Nothing 90 | Right (RunningModels [RunningModel {name_ = "gemma3:instance1", modelName = "gemma3", ...}]) 91 | -} 92 | ps :: 93 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 94 | Maybe OllamaConfig -> 95 | IO (Either OllamaError RunningModels) 96 | ps mbConfig = do 97 | withOllamaRequest 98 | "/api/ps" 99 | "GET" 100 | (Nothing :: Maybe Value) 101 | mbConfig 102 | commonNonStreamingHandler 103 | 104 | {- | MonadIO version of 'ps' for use in monadic contexts. 105 | 106 | Lifts the 'ps' function into a 'MonadIO' context, allowing it to be used in monadic computations. 107 | -} 108 | psM :: MonadIO m => Maybe OllamaConfig -> m (Either OllamaError RunningModels) 109 | psM mbCfg = liftIO $ ps mbCfg 110 | -------------------------------------------------------------------------------- /src/Data/Ollama/Pull.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | {- | 8 | Module : Data.Ollama.Pull 9 | Copyright : (c) 2025 Tushar Adhatrao 10 | License : MIT 11 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 12 | Stability : experimental 13 | Description : Functionality for pulling models in the Ollama client. 14 | 15 | This module provides functions to pull (download) models from the Ollama server. It includes both 16 | high-level ('pull', 'pullM') and low-level ('pullOps', 'pullOpsM') APIs for pulling models, with 17 | support for streaming progress updates and insecure connections. The 'PullOps' type configures the 18 | pull request, and 'PullResp' represents the response containing the status and progress details. 19 | 20 | The pull operation is performed via a POST request to the @\/api\/pull@ endpoint. Streaming mode, 21 | when enabled, provides real-time progress updates by printing the remaining bytes to the console. 22 | 23 | Example: 24 | 25 | >>> pull "gemma3" 26 | Remaining bytes: 123456789 27 | ... 28 | Completed 29 | Right (PullResp {status = "success", ...}) 30 | -} 31 | module Data.Ollama.Pull 32 | ( -- * Pull Model API 33 | pull 34 | , pullOps 35 | , pullM 36 | , pullOpsM 37 | ) where 38 | 39 | import Control.Monad.IO.Class (MonadIO (liftIO)) 40 | import Data.Aeson 41 | import Data.Maybe (fromMaybe) 42 | import Data.Ollama.Common.Config (OllamaConfig) 43 | import Data.Ollama.Common.Error (OllamaError) 44 | import Data.Ollama.Common.Types (HasDone (..)) 45 | import Data.Ollama.Common.Utils as CU 46 | import Data.Text (Text) 47 | import GHC.Generics 48 | import GHC.Int (Int64) 49 | 50 | -- | Configuration options for pulling a model. 51 | data PullOps = PullOps 52 | { name :: !Text 53 | -- ^ The name of the model to pull (e.g., "gemma3"). 54 | , insecure :: !(Maybe Bool) 55 | -- ^ Optional flag to allow insecure connections. If 'Just True', insecure connections are permitted. 56 | , stream :: !(Maybe Bool) 57 | -- ^ Optional flag to enable streaming of the download. If 'Just True', progress updates are streamed. 58 | } 59 | deriving (Show, Eq, Generic, ToJSON) 60 | 61 | -- | Response data from a pull operation. 62 | data PullResp = PullResp 63 | { status :: !Text 64 | -- ^ The status of the pull operation (e.g., "success" or "failure"). 65 | , digest :: !(Maybe Text) 66 | -- ^ The digest (hash) of the model, if available. 67 | , total :: !(Maybe Int64) 68 | -- ^ The total size of the model in bytes, if available. 69 | , completed :: !(Maybe Int64) 70 | -- ^ The number of bytes downloaded, if available. 71 | } 72 | deriving (Show, Eq, Generic, FromJSON) 73 | 74 | instance HasDone PullResp where 75 | getDone PullResp {..} = status /= "success" 76 | 77 | {- | Pulls a model with full configuration. 78 | 79 | Sends a POST request to the @\/api\/pull@ endpoint to download the specified model. Supports 80 | streaming progress updates (if 'stream' is 'Just True') and insecure connections (if 'insecure' 81 | is 'Just True'). Prints remaining bytes during streaming and "Completed" when finished. 82 | Returns 'Right' with a 'PullResp' on success or 'Left' with an 'OllamaError' on failure. 83 | -} 84 | pullOps :: 85 | -- | Model name 86 | Text -> 87 | -- | Optional insecure connection flag 88 | Maybe Bool -> 89 | -- | Optional streaming flag 90 | Maybe Bool -> 91 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 92 | Maybe OllamaConfig -> 93 | IO (Either OllamaError PullResp) 94 | pullOps modelName mInsecure mStream mbConfig = do 95 | withOllamaRequest 96 | "/api/pull" 97 | "POST" 98 | (Just $ PullOps {name = modelName, insecure = mInsecure, stream = mStream}) 99 | mbConfig 100 | (commonStreamHandler onToken) 101 | where 102 | onToken :: PullResp -> IO () 103 | onToken res = do 104 | let completed' = fromMaybe 0 (completed res) 105 | let total' = fromMaybe 0 (total res) 106 | putStrLn $ "Remaining bytes: " <> show (total' - completed') 107 | 108 | {- | Simplified API for pulling a model. 109 | 110 | A higher-level function that pulls a model using default settings for insecure connections, 111 | streaming, and Ollama configuration. Suitable for basic use cases. 112 | -} 113 | pull :: 114 | -- | Model name 115 | Text -> 116 | IO (Either OllamaError PullResp) 117 | pull modelName = pullOps modelName Nothing Nothing Nothing 118 | 119 | {- | MonadIO version of 'pull' for use in monadic contexts. 120 | 121 | Lifts the 'pull' function into a 'MonadIO' context, allowing it to be used in monadic computations. 122 | 123 | Example: 124 | 125 | >>> import Control.Monad.IO.Class 126 | >>> runReaderT (pullM "gemma3") someContext 127 | Right (PullResp {status = "success", ...}) 128 | -} 129 | pullM :: MonadIO m => Text -> m (Either OllamaError PullResp) 130 | pullM t = liftIO $ pull t 131 | 132 | {- | MonadIO version of 'pullOps' for use in monadic contexts. 133 | 134 | Lifts the 'pullOps' function into a 'MonadIO' context, allowing it to be used in monadic computations 135 | with full configuration options. 136 | 137 | Example: 138 | 139 | >>> import Control.Monad.IO.Class 140 | >>> runReaderT (pullOpsM "gemma3" Nothing (Just True) Nothing) someContext 141 | Remaining bytes: 123456789 142 | ... 143 | Completed 144 | Right (PullResp {status = "success", ...}) 145 | -} 146 | pullOpsM :: 147 | MonadIO m => 148 | Text -> 149 | Maybe Bool -> 150 | Maybe Bool -> 151 | Maybe OllamaConfig -> 152 | m (Either OllamaError PullResp) 153 | pullOpsM t mbInsecure mbStream mbCfg = liftIO $ pullOps t mbInsecure mbStream mbCfg 154 | -------------------------------------------------------------------------------- /src/Data/Ollama/Push.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | {- | 8 | Module : Data.Ollama.Push 9 | Copyright : (c) 2025 Tushar Adhatrao 10 | License : MIT 11 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 12 | Stability : experimental 13 | Description : Functionality for pushing models to the Ollama server. 14 | 15 | This module provides functions to push (upload) a model to the Ollama server. It includes 16 | both an IO-based function ('push') and a monadic version ('pushM') for use in 'MonadIO' 17 | contexts. The push operation is performed via a POST request to the @\/api\/pull@ endpoint, 18 | with support for streaming progress updates and insecure connections. 19 | 20 | The 'PushOps' type configures the push request, and 'PushResp' represents the response 21 | containing the status and progress details. Streaming mode, when enabled, provides 22 | real-time progress updates by printing to the console. 23 | 24 | Example: 25 | 26 | >>> push "gemma3" Nothing (Just True) Nothing 27 | Pushing... 28 | Completed 29 | -} 30 | module Data.Ollama.Push 31 | ( -- * Push Model API 32 | push 33 | , pushM 34 | ) where 35 | 36 | import Control.Monad (void) 37 | import Control.Monad.IO.Class (MonadIO (liftIO)) 38 | import Data.Aeson 39 | import Data.Ollama.Common.Config (OllamaConfig) 40 | import Data.Ollama.Common.Types (HasDone (getDone)) 41 | import Data.Ollama.Common.Utils as CU 42 | import Data.Text (Text) 43 | import GHC.Generics 44 | import GHC.Int (Int64) 45 | 46 | -- | Configuration options for pushing a model. 47 | data PushOps = PushOps 48 | { name :: !Text 49 | -- ^ The name of the model to push (e.g., "gemma3"). 50 | , insecure :: !(Maybe Bool) 51 | -- ^ Optional flag to allow insecure connections. 52 | -- If 'Just True', insecure connections are permitted. 53 | , stream :: !(Maybe Bool) 54 | -- ^ Optional flag to enable streaming of the upload. 55 | -- If 'Just True', progress updates are streamed. 56 | } 57 | deriving (Show, Eq, Generic, ToJSON) 58 | 59 | -- | Response data from a push operation. 60 | data PushResp = PushResp 61 | { status :: !Text 62 | -- ^ The status of the push operation (e.g., "success" or "failure"). 63 | , digest :: !(Maybe Text) 64 | -- ^ The digest (hash) of the model, if available. 65 | , total :: !(Maybe Int64) 66 | -- ^ The total size of the model in bytes, if available. 67 | } 68 | deriving (Show, Eq, Generic, FromJSON) 69 | 70 | instance HasDone PushResp where 71 | getDone PushResp {..} = status /= "success" 72 | 73 | {- | Pushes a model to the Ollama server with specified options. 74 | 75 | Sends a POST request to the @\/api\/pull@ endpoint to upload the specified model. Supports 76 | streaming progress updates (if 'stream' is 'Just True') and insecure connections (if 77 | 'insecure' is 'Just True'). Prints "Pushing..." during streaming and "Completed" when 78 | finished. Returns '()' on completion. 79 | -} 80 | push :: 81 | -- | Model name 82 | Text -> 83 | -- | Optional insecure connection flag 84 | Maybe Bool -> 85 | -- | Optional streaming flag 86 | Maybe Bool -> 87 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 88 | Maybe OllamaConfig -> 89 | IO () 90 | push modelName mInsecure mStream mbConfig = do 91 | void $ 92 | withOllamaRequest 93 | "/api/push" 94 | "POST" 95 | (Just $ PushOps {name = modelName, insecure = mInsecure, stream = mStream}) 96 | mbConfig 97 | (commonStreamHandler onToken) 98 | where 99 | onToken :: PushResp -> IO () 100 | onToken _ = putStrLn "Pushing... " 101 | 102 | {- | MonadIO version of 'push' for use in monadic contexts. 103 | 104 | Lifts the 'push' function into a 'MonadIO' context, allowing it to be used in monadic 105 | computations. 106 | 107 | Example: 108 | 109 | >>> import Control.Monad.IO.Class 110 | >>> runReaderT (pushM "gemma3" Nothing (Just True) Nothing) someContext 111 | Pushing... 112 | Completed 113 | -} 114 | pushM :: MonadIO m => Text -> Maybe Bool -> Maybe Bool -> Maybe OllamaConfig -> m () 115 | pushM t insec s mbCfg = liftIO $ push t insec s mbCfg 116 | -------------------------------------------------------------------------------- /src/Data/Ollama/Show.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- | 7 | Module : Data.Ollama.Show 8 | Copyright : (c) 2025 Tushar Adhatrao 9 | License : MIT 10 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 11 | Stability : experimental 12 | Description : Functionality for retrieving detailed information about models in the Ollama client. 13 | 14 | This module provides functions to fetch detailed information about a specific model on the Ollama server. 15 | It includes both high-level ('showModel', 'showModelM') and low-level ('showModelOps', 'showModelOpsM') APIs 16 | for retrieving model details, with support for verbose output. The operation is performed via a POST request 17 | to the @\/api\/show@ endpoint, returning a 'ShowModelResponse' containing comprehensive model metadata. 18 | 19 | The 'ShowModelOps' type configures the request, and 'ShowModelResponse' and 'ShowModelInfo' represent the 20 | response structure. The module also re-exports 'CT.ModelDetails' for completeness. 21 | 22 | Note: Verbose mode parsing is currently not fully supported. 23 | 24 | Example: 25 | 26 | >>> showModel "gemma3" 27 | Right (ShowModelResponse {modelFile = "...", ...}) 28 | 29 | @since 1.0.0.0 30 | -} 31 | module Data.Ollama.Show 32 | ( -- * Show Model Info API 33 | showModel 34 | , showModelM 35 | , showModelOps 36 | , showModelOpsM 37 | 38 | -- * Response Types 39 | , ShowModelResponse (..) 40 | , ShowModelInfo (..) 41 | , CT.ModelDetails (..) 42 | ) where 43 | 44 | import Control.Monad.IO.Class (MonadIO (liftIO)) 45 | import Data.Aeson 46 | import Data.Ollama.Common.Config (OllamaConfig) 47 | import Data.Ollama.Common.Error (OllamaError) 48 | import Data.Ollama.Common.Types qualified as CT 49 | import Data.Ollama.Common.Utils (commonNonStreamingHandler, withOllamaRequest) 50 | import Data.Text (Text) 51 | import GHC.Generics 52 | import GHC.Int (Int64) 53 | 54 | -- | Configuration options for requesting model information. 55 | data ShowModelOps = ShowModelOps 56 | { name :: !Text 57 | -- ^ The name of the model to query (e.g., "gemma3"). 58 | , verbose :: !(Maybe Bool) 59 | -- ^ Optional flag to request verbose output. Note: Verbose mode parsing is currently incomplete. 60 | } 61 | deriving (Show, Eq, Generic, ToJSON) 62 | 63 | -- | Response structure for model information. 64 | data ShowModelResponse = ShowModelResponse 65 | { modelFile :: !Text 66 | -- ^ The content of the model's Modelfile. 67 | , parameters :: !(Maybe Text) 68 | -- ^ Optional model parameters (e.g., temperature settings). 69 | , template :: !(Maybe Text) 70 | -- ^ Optional template used for the model. 71 | , details :: !CT.ModelDetails 72 | -- ^ General details about the model (e.g., format, family). 73 | , modelInfo :: !ShowModelInfo 74 | -- ^ Detailed technical information about the model. 75 | , license :: !(Maybe Text) 76 | -- ^ Optional license information for the model. 77 | -- 78 | -- @since 0.2.0.0 79 | , capabilities :: Maybe [Text] 80 | -- ^ Optional list of model capabilities. 81 | -- 82 | -- @since 0.2.0.0 83 | } 84 | deriving (Show, Eq) 85 | 86 | -- | Detailed technical information about a model. 87 | data ShowModelInfo = ShowModelInfo 88 | { generalArchitecture :: !(Maybe Text) 89 | -- ^ The architecture of the model (e.g., "llama"). 90 | , generalFileType :: !(Maybe Int) 91 | -- ^ The file type identifier for the model. 92 | , generalParameterCount :: !(Maybe Int64) 93 | -- ^ The number of parameters in the model. 94 | , generalQuantizationVersion :: !(Maybe Int) 95 | -- ^ The quantization version used by the model. 96 | , llamaAttentionHeadCount :: !(Maybe Int) 97 | -- ^ Number of attention heads in the LLaMA model. 98 | , llamaAttentionHeadCountKV :: !(Maybe Int) 99 | -- ^ Number of key-value attention heads in the LLaMA model. 100 | , llamaAttentionLayerNormRMSEpsilon :: !(Maybe Float) 101 | -- ^ RMS epsilon for layer normalization in the LLaMA model. 102 | , llamaBlockCount :: !(Maybe Int) 103 | -- ^ Number of blocks in the LLaMA model. 104 | , llamaContextLength :: !(Maybe Int) 105 | -- ^ Context length supported by the LLaMA model. 106 | , llamaEmbeddingLength :: !(Maybe Int) 107 | -- ^ Embedding length used by the LLaMA model. 108 | , llamaFeedForwardLength :: !(Maybe Int) 109 | -- ^ Feed-forward layer length in the LLaMA model. 110 | , llamaRopeDimensionCount :: !(Maybe Int) 111 | -- ^ RoPE dimension count in the LLaMA model. 112 | , llamaRopeFreqBase :: !(Maybe Int64) 113 | -- ^ Base frequency for RoPE in the LLaMA model. 114 | , llamaVocabSize :: !(Maybe Int64) 115 | -- ^ Vocabulary size of the LLaMA model. 116 | , tokenizerGgmlBosToken_id :: !(Maybe Int) 117 | -- ^ BOS (beginning of sequence) token ID for the GGML tokenizer. 118 | , tokenizerGgmlEosToken_id :: !(Maybe Int) 119 | -- ^ EOS (end of sequence) token ID for the GGML tokenizer. 120 | , tokenizerGgmlMerges :: !(Maybe [Text]) 121 | -- ^ List of merges for the GGML tokenizer. 122 | , tokenizerGgmlMode :: !(Maybe Text) 123 | -- ^ Mode of the GGML tokenizer. 124 | , tokenizerGgmlPre :: !(Maybe Text) 125 | -- ^ Pre-tokenization configuration for the GGML tokenizer. 126 | , tokenizerGgmlTokenType :: !(Maybe [Text]) 127 | -- ^ Token type information for the GGML tokenizer. 128 | , tokenizerGgmlTokens :: !(Maybe [Text]) 129 | -- ^ List of tokens for the GGML tokenizer. 130 | } 131 | deriving (Show, Eq) 132 | 133 | -- | JSON parsing instance for 'ShowModelResponse'. 134 | instance FromJSON ShowModelResponse where 135 | parseJSON = withObject "ShowModelResponse" $ \v -> 136 | ShowModelResponse 137 | <$> v .: "modelfile" 138 | <*> v .:? "parameters" 139 | <*> v .:? "template" 140 | <*> v .: "details" 141 | <*> v .: "model_info" 142 | <*> v .:? "license" 143 | <*> v .:? "capabilities" 144 | 145 | -- | JSON parsing instance for 'ShowModelInfo'. 146 | instance FromJSON ShowModelInfo where 147 | parseJSON = withObject "ModelInfo" $ \v -> 148 | ShowModelInfo 149 | <$> v .:? "general.architecture" 150 | <*> v .:? "general.file_type" 151 | <*> v .:? "general.parameter_count" 152 | <*> v .:? "general.quantization_version" 153 | <*> v .:? "llama.attention.head_count" 154 | <*> v .:? "llama.attention.head_count_kv" 155 | <*> v .:? "llama.attention.layer_norm_rms_epsilon" 156 | <*> v .:? "llama.block_count" 157 | <*> v .:? "llama.context_length" 158 | <*> v .:? "llama.embedding_length" 159 | <*> v .:? "llama.feed_forward_length" 160 | <*> v .:? "llama.rope.dimension_count" 161 | <*> v .:? "llama.rope.freq_base" 162 | <*> v .:? "llama.vocab_size" 163 | <*> v .:? "tokenizer.ggml.bos_token_id" 164 | <*> v .:? "tokenizer.ggml.eos_token_id" 165 | <*> v .:? "tokenizer.ggml.merges" 166 | <*> v .:? "tokenizer.ggml.model" 167 | <*> v .:? "tokenizer.ggml.pre" 168 | <*> v .:? "tokenizer.ggml.token_type" 169 | <*> v .:? "tokenizer.ggml.tokens" 170 | 171 | {- | Retrieves model information with configuration options. 172 | 173 | Sends a POST request to the @\/api\/show@ endpoint to fetch detailed information about 174 | the specified model. Supports verbose output if 'verbose' is 'Just True' (though verbose 175 | mode parsing is currently incomplete). Returns 'Right' with a 'ShowModelResponse' on 176 | success or 'Left' with an 'OllamaError' on failure. 177 | -} 178 | showModelOps :: 179 | -- | Model name 180 | Text -> 181 | -- | Optional verbose flag 182 | Maybe Bool -> 183 | -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing') 184 | Maybe OllamaConfig -> 185 | IO (Either OllamaError ShowModelResponse) 186 | showModelOps modelName verbose_ mbConfig = do 187 | withOllamaRequest 188 | "/api/show" 189 | "POST" 190 | ( Just $ 191 | ShowModelOps 192 | { name = modelName 193 | , verbose = verbose_ 194 | } 195 | ) 196 | mbConfig 197 | commonNonStreamingHandler 198 | 199 | {- | Simplified API for retrieving model information. 200 | 201 | A higher-level function that fetches model information using default settings for 202 | verbose output and Ollama configuration. Suitable for basic use cases. 203 | -} 204 | showModel :: 205 | -- | Model name 206 | Text -> 207 | IO (Either OllamaError ShowModelResponse) 208 | showModel modelName = 209 | showModelOps modelName Nothing Nothing 210 | 211 | {- | MonadIO version of 'showModel' for use in monadic contexts. 212 | 213 | Lifts the 'showModel' function into a 'MonadIO' context, allowing it to be used in 214 | monadic computations. 215 | -} 216 | showModelM :: MonadIO m => Text -> m (Either OllamaError ShowModelResponse) 217 | showModelM t = liftIO $ showModel t 218 | 219 | {- | MonadIO version of 'showModelOps' for use in monadic contexts. 220 | 221 | Lifts the 'showModelOps' function into a 'MonadIO' context, allowing it to be used in 222 | monadic computations with full configuration options. 223 | -} 224 | showModelOpsM :: 225 | MonadIO m => 226 | Text -> 227 | Maybe Bool -> 228 | Maybe OllamaConfig -> 229 | m (Either OllamaError ShowModelResponse) 230 | showModelOpsM t v mbCfg = liftIO $ showModelOps t v mbCfg 231 | -------------------------------------------------------------------------------- /src/Ollama.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DuplicateRecordFields #-} 2 | 3 | {- | 4 | Module : Data.Ollama 5 | Copyright : (c) 2025 Tushar Adhatrao 6 | License : MIT 7 | Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com> 8 | Stability : experimental 9 | Portability : portable 10 | 11 | == Ollama Haskell 12 | 13 | This module provides a high-level Haskell interface to the [Ollama](https://ollama.com) API 14 | for interacting with local LLMs. It includes support for: 15 | 16 | - Text generation (sync/streaming) 17 | - Conversational chat (with tools and images) 18 | - Embeddings 19 | - Model management (pull, push, delete, list, show) 20 | - Structured outputs 21 | - Custom configuration and model options 22 | 23 | Inspired by @ollama-python@, this library is built to offer idiomatic Haskell bindings 24 | over Ollama’s HTTP API. 25 | 26 | == 🔧 Usage 27 | 28 | Import this module as a top-level interface: 29 | 30 | @ 31 | import Ollama 32 | @ 33 | 34 | All functions return @Either OllamaError a@ or can be used in a Monad stack using 35 | their @\*M@ variants. 36 | 37 | == 🔑 Main APIs 38 | 39 | === ✍️ Generate Text 40 | 41 | - 'generate', 'generateM' – Generate text from a model 42 | - 'defaultGenerateOps' – Default generation parameters 43 | - 'GenerateOps', 'GenerateResponse' – Request and response types 44 | 45 | === 💬 Chat with LLMs 46 | 47 | - 'chat', 'chatM' – Send chat messages to a model 48 | - 'ChatOps', 'ChatResponse', 'Role', 'Message' – Chat input/output types 49 | - Supports tools via 'InputTool', 'FunctionDef', 'OutputFunction', etc. 50 | 51 | === 🧠 Embeddings 52 | 53 | - 'embedding', 'embeddingM' – Generate vector embeddings 54 | - 'EmbeddingOps', 'EmbeddingResp' – Request/response types 55 | 56 | === 📦 Model Management 57 | 58 | - 'copyModel', 'createModel', 'deleteModel' 59 | - 'list' – List all installed models 60 | - 'ps', 'psM' – Show running models 61 | - 'showModel', 'showModelM' – Show model info 62 | - 'pull', 'push' – Pull/push models (with progress support) 63 | 64 | === ⚙️ Configuration 65 | 66 | - 'defaultOllamaConfig' – Modify host, retries, streaming, etc. 67 | - 'withOnModelStart', 'withOnModelFinish', 'withOnModelError' – Hook support 68 | 69 | === 🧰 Utilities 70 | 71 | - 'defaultModelOptions', 'encodeImage', 'withOllamaRequest' 72 | - 'loadGenModel', 'unloadGenModel' – Load/unload generation models 73 | - 'getVersion' – Ollama server version 74 | 75 | == 🧾 Types 76 | 77 | All request/response payloads and enums are exposed, including: 78 | 79 | - 'ModelOptions', 'OllamaConfig', 'OllamaError', 'Format' 80 | - 'Models', 'ModelInfo', 'ModelDetails', 'ShowModelResponse' 81 | - 'RunningModels', 'RunningModel', 'Version' 82 | -} 83 | module Ollama 84 | ( -- * Main APIs 85 | 86 | -- ** Generate Texts 87 | generate 88 | , generateM 89 | , defaultGenerateOps 90 | , GenerateOps (..) 91 | , GenerateResponse (..) 92 | 93 | -- ** Chat with LLMs 94 | , chat 95 | , chatM 96 | , Role (..) 97 | , defaultChatOps 98 | , ChatResponse (..) 99 | , ChatOps (..) 100 | , InputTool (..) 101 | , FunctionDef (..) 102 | , FunctionParameters (..) 103 | , ToolCall (..) 104 | , OutputFunction (..) 105 | 106 | -- ** Embeddings 107 | , embedding 108 | , embeddingOps 109 | , embeddingM 110 | , embeddingOpsM 111 | , EmbeddingOps (..) 112 | , EmbeddingResp (..) 113 | 114 | -- ** Copy Models 115 | , copyModel 116 | , copyModelM 117 | 118 | -- ** Create Models 119 | , createModel 120 | , createModelM 121 | 122 | -- ** Delete Models 123 | , deleteModel 124 | , deleteModelM 125 | 126 | -- ** List Models 127 | , list 128 | 129 | -- ** List currently running models 130 | , ps 131 | , psM 132 | 133 | -- ** Push and Pull 134 | , push 135 | , pushM 136 | , pull 137 | , pullM 138 | , pullOps 139 | , pullOpsM 140 | 141 | -- ** Show Model Info 142 | , showModel 143 | , showModelOps 144 | , showModelM 145 | , showModelOpsM 146 | 147 | -- * Ollama config 148 | , defaultOllamaConfig 149 | , withOnModelStart 150 | , withOnModelFinish 151 | , withOnModelError 152 | 153 | -- * Utils 154 | , defaultModelOptions 155 | , ModelOptions (..) 156 | , encodeImage 157 | , withOllamaRequest 158 | , getVersion 159 | , loadGenModel 160 | , unloadGenModel 161 | , loadGenModelM 162 | , unloadGenModelM 163 | 164 | -- * Types 165 | , ShowModelResponse (..) 166 | , Models (..) 167 | , ModelInfo (..) 168 | , ModelDetails (..) 169 | , ShowModelInfo (..) 170 | , RunningModels (..) 171 | , RunningModel (..) 172 | , Message (..) 173 | , Format (..) 174 | , OllamaError (..) 175 | , OllamaConfig (..) 176 | , Version (..) 177 | ) 178 | where 179 | 180 | import Data.Ollama.Chat 181 | import Data.Ollama.Common.Config 182 | import Data.Ollama.Common.Types 183 | import Data.Ollama.Common.Utils 184 | import Data.Ollama.Copy 185 | import Data.Ollama.Create 186 | import Data.Ollama.Delete 187 | import Data.Ollama.Embeddings 188 | import Data.Ollama.Generate 189 | import Data.Ollama.List 190 | import Data.Ollama.Load 191 | import Data.Ollama.Ps 192 | import Data.Ollama.Pull 193 | import Data.Ollama.Push 194 | import Data.Ollama.Show 195 | -------------------------------------------------------------------------------- /stack-lts-19.33.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-19.33 2 | packages: 3 | - . 4 | 5 | extra-deps: 6 | - tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 7 | -------------------------------------------------------------------------------- /stack-lts-19.33.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 9 | pantry-tree: 10 | sha256: 3f4655ce81d6b50d9293ee3b2b15e1608e9b18b886d3463bb66c34a3a7c302f6 11 | size: 1944 12 | original: 13 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 14 | snapshots: 15 | - completed: 16 | sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4 17 | size: 619204 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/33.yaml 19 | original: lts-19.33 20 | -------------------------------------------------------------------------------- /stack-lts-20.26.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-20.26 2 | packages: 3 | - . 4 | extra-deps: 5 | - tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 6 | -------------------------------------------------------------------------------- /stack-lts-20.26.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 9 | pantry-tree: 10 | sha256: 3f4655ce81d6b50d9293ee3b2b15e1608e9b18b886d3463bb66c34a3a7c302f6 11 | size: 1944 12 | original: 13 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 14 | snapshots: 15 | - completed: 16 | sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 17 | size: 650475 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml 19 | original: lts-20.26 20 | -------------------------------------------------------------------------------- /stack-lts-21.25.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-21.25 2 | packages: 3 | - . 4 | extra-deps: 5 | - tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 6 | -------------------------------------------------------------------------------- /stack-lts-21.25.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 9 | pantry-tree: 10 | sha256: 3f4655ce81d6b50d9293ee3b2b15e1608e9b18b886d3463bb66c34a3a7c302f6 11 | size: 1944 12 | original: 13 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 14 | snapshots: 15 | - completed: 16 | sha256: a81fb3877c4f9031e1325eb3935122e608d80715dc16b586eb11ddbff8671ecd 17 | size: 640086 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/25.yaml 19 | original: lts-21.25 20 | -------------------------------------------------------------------------------- /stack-lts-22.43.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-22.43 2 | packages: 3 | - . 4 | extra-deps: 5 | - tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 6 | 7 | -------------------------------------------------------------------------------- /stack-lts-22.43.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 9 | pantry-tree: 10 | sha256: 3f4655ce81d6b50d9293ee3b2b15e1608e9b18b886d3463bb66c34a3a7c302f6 11 | size: 1944 12 | original: 13 | hackage: tasty-1.5.3@sha256:9d56ea9dbc274fc853fc531373b2c91bfe360e21460c2c6a5838897d86e3f6d0,2923 14 | snapshots: 15 | - completed: 16 | sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146 17 | size: 720271 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml 19 | original: lts-22.43 20 | -------------------------------------------------------------------------------- /stack-lts-23.19.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-23.19 2 | packages: 3 | - . 4 | -------------------------------------------------------------------------------- /stack-lts-23.19.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 296a7960c37efa382432ab497161a092684191815eb92a608c5d6ea5f894ace3 10 | size: 683835 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/19.yaml 12 | original: lts-23.19 13 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2025-05-05 2 | packages: 3 | - . 4 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: bcbc80a081dbf9d701bb8c46f0212b251acbe6cf64332e6e3c8b108c13794841 10 | size: 685947 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/5/5.yaml 12 | original: nightly-2025-05-05 13 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import Data.Text (unpack) 6 | import Ollama (Version (..), getVersion) 7 | import Test.Ollama.Chat qualified as Chat 8 | import Test.Ollama.Embedding qualified as Embeddings 9 | import Test.Ollama.Generate qualified as Generate 10 | import Test.Ollama.Show qualified as Show 11 | import Test.Tasty 12 | 13 | tests :: TestTree 14 | tests = 15 | testGroup 16 | "Tests" 17 | [ Generate.tests 18 | , Chat.tests 19 | , Show.tests 20 | , Embeddings.tests 21 | ] 22 | 23 | main :: IO () 24 | main = do 25 | eRes <- getVersion 26 | case eRes of 27 | Left err -> putStrLn $ show err 28 | Right (Version r) -> do 29 | putStrLn $ "Ollama client version: " <> unpack r 30 | defaultMain tests 31 | -------------------------------------------------------------------------------- /test/Test/Ollama/Chat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Test.Ollama.Chat (tests) where 5 | 6 | import Control.Monad (void) 7 | import Data.Aeson qualified as Aeson 8 | import Data.ByteString.Lazy.Char8 qualified as BSL 9 | import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) 10 | import Data.List.NonEmpty (fromList) 11 | import Data.List.NonEmpty qualified as NE 12 | import Data.Map qualified as HM 13 | import Data.Maybe (isJust) 14 | import Data.Ollama.Chat 15 | import Data.Scientific 16 | import Data.Text qualified as T 17 | import Data.Time (diffUTCTime, getCurrentTime) 18 | import Network.HTTP.Client 19 | import Network.HTTP.Client.TLS 20 | import Test.Tasty 21 | import Test.Tasty.HUnit 22 | 23 | -- | Basic chat test with default options 24 | basicChatTest :: TestTree 25 | basicChatTest = testCase "Basic chat should contain 4 for 2+2" $ do 26 | let ops = defaultChatOps 27 | eRes <- chat ops Nothing 28 | case eRes of 29 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 30 | Right r -> case message r of 31 | Nothing -> assertFailure "Expected a message in response" 32 | Just msg -> assertBool "Should contain '4'" (T.isInfixOf "4" (content msg)) 33 | 34 | -- | Test timeout configuration 35 | timeoutTest :: TestTree 36 | timeoutTest = testCase "Setting timeout" $ do 37 | let config = Just $ defaultOllamaConfig {timeout = 1} 38 | eRes <- chat defaultChatOps config 39 | case eRes of 40 | Right _ -> assertFailure "The model responded before timeout" 41 | Left (TimeoutError _) -> pure () 42 | Left other -> assertFailure $ "Expected timeout error, got " ++ show other 43 | 44 | -- | Test model lifecycle hooks on failure 45 | hooksFailTest :: TestTree 46 | hooksFailTest = testCase "Model lifecycle hooks should trigger on failure" $ do 47 | refStart <- newIORef False 48 | refError <- newIORef False 49 | refFinish <- newIORef True 50 | let config = 51 | defaultOllamaConfig 52 | { hostUrl = "http://localhost:12345" -- Guaranteed to fail 53 | , onModelStart = Just $ writeIORef refStart True 54 | , onModelError = Just $ writeIORef refError True 55 | , onModelFinish = Just $ writeIORef refFinish False 56 | } 57 | void $ chat defaultChatOps (Just config) 58 | wasStarted <- readIORef refStart 59 | wasErrored <- readIORef refError 60 | wasFinished <- readIORef refFinish 61 | assertBool "onModelStart should be called" wasStarted 62 | assertBool "onModelError should be called" wasErrored 63 | assertBool "onModelFinish should be called" wasFinished 64 | 65 | -- | Test model lifecycle hooks on success 66 | hooksSuccessTest :: TestTree 67 | hooksSuccessTest = testCase "Model lifecycle hooks should trigger on success" $ do 68 | refStart <- newIORef False 69 | refError <- newIORef True 70 | refFinish <- newIORef False 71 | let config = 72 | defaultOllamaConfig 73 | { onModelStart = Just $ writeIORef refStart True 74 | , onModelError = Just $ writeIORef refError False 75 | , onModelFinish = Just $ writeIORef refFinish True 76 | } 77 | void $ chat defaultChatOps (Just config) 78 | wasStarted <- readIORef refStart 79 | wasErrored <- readIORef refError 80 | wasFinished <- readIORef refFinish 81 | assertBool "onModelStart should be called" wasStarted 82 | assertBool "onModelError should not be called" wasErrored 83 | assertBool "onModelFinish should be called" wasFinished 84 | 85 | -- | Test retry count 86 | retryCountTest :: TestTree 87 | retryCountTest = testCase "Should retry chat call retryCount times" $ do 88 | counter <- newIORef (0 :: Int) 89 | let config = 90 | defaultOllamaConfig 91 | { hostUrl = "http://localhost:12345" -- Fails 92 | , retryCount = Just 2 93 | , retryDelay = Just 1 94 | , onModelStart = Just $ modifyIORef counter (+ 1) 95 | , onModelError = Just $ pure () 96 | , onModelFinish = Just $ pure () 97 | } 98 | _ <- chat defaultChatOps (Just config) 99 | calls <- readIORef counter 100 | assertEqual "Expected 3 attempts (1 initial + 2 retries)" 3 calls 101 | 102 | -- | Test retry delay 103 | retryDelayTest :: TestTree 104 | retryDelayTest = testCase "Should delay between retries" $ do 105 | counter <- newIORef (0 :: Int) 106 | let delaySecs = 2 107 | start <- getCurrentTime 108 | let config = 109 | defaultOllamaConfig 110 | { hostUrl = "http://localhost:12345" -- Fails 111 | , retryCount = Just 1 112 | , retryDelay = Just delaySecs 113 | , onModelStart = Just $ modifyIORef counter (+ 1) 114 | , onModelError = Just $ pure () 115 | , onModelFinish = Just $ pure () 116 | } 117 | _ <- chat defaultChatOps (Just config) 118 | end <- getCurrentTime 119 | let elapsed = realToFrac (diffUTCTime end start) :: Double 120 | expectedMin = fromIntegral delaySecs 121 | assertBool 122 | ("Elapsed time should be at least " ++ show expectedMin ++ "s, but was " ++ show elapsed) 123 | (elapsed >= expectedMin) 124 | 125 | -- | Test common manager usage 126 | commonManagerTest :: TestTree 127 | commonManagerTest = testCase "Should reuse provided commonManager" $ do 128 | refStart <- newIORef (0 :: Int) 129 | mgr <- 130 | newTlsManagerWith 131 | tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro 1000000} 132 | let config = 133 | defaultOllamaConfig 134 | { hostUrl = "http://localhost:12345" -- Will fail fast 135 | , commonManager = Just mgr 136 | , timeout = 999 -- Shouldn’t matter, manager timeout takes precedence 137 | , onModelStart = Just $ modifyIORef refStart (+ 1) 138 | , onModelError = Just $ pure () 139 | , onModelFinish = Just $ pure () 140 | } 141 | _ <- chat defaultChatOps (Just config) 142 | _ <- chat defaultChatOps (Just config) 143 | startCount <- readIORef refStart 144 | assertEqual "Both requests should start (reuse manager)" 2 startCount 145 | 146 | -- | Test JSON format response 147 | jsonFormatTest :: TestTree 148 | jsonFormatTest = testCase "Should return response in JSON format" $ do 149 | let ops = 150 | defaultChatOps 151 | { messages = 152 | fromList 153 | [userMessage "Return a JSON with keys 'name' and 'age' for John, 25 years old."] 154 | , format = Just JsonFormat 155 | } 156 | eRes <- chat ops Nothing 157 | case eRes of 158 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 159 | Right r -> case message r of 160 | Nothing -> assertFailure "Expected a message in response" 161 | Just msg -> do 162 | let responseText = content msg 163 | let decoded = Aeson.decode (BSL.pack $ T.unpack responseText) :: Maybe Aeson.Value 164 | assertBool "Expected valid JSON object in response" (decoded /= Nothing) 165 | 166 | -- | Test streaming response 167 | streamingTest :: TestTree 168 | streamingTest = testCase "Should handle streaming response" $ do 169 | chunksRef <- newIORef [] 170 | let streamHandler chunk = modifyIORef chunksRef (++ [message chunk]) 171 | ops = defaultChatOps {stream = Just streamHandler} 172 | eRes <- chat ops Nothing 173 | chunks <- readIORef chunksRef 174 | let fullOutput = T.concat (map (maybe "" content) chunks) 175 | case eRes of 176 | Left err -> assertFailure $ "Expected streaming success, got error: " ++ show err 177 | Right _ -> assertBool "Expected some streamed content" (not $ T.null fullOutput) 178 | 179 | -- | Test custom model options 180 | modelOptionsTest :: TestTree 181 | modelOptionsTest = testCase "Should use custom model options" $ do 182 | let opts = 183 | Just $ 184 | defaultModelOptions 185 | { temperature = Just 0.9 186 | , topP = Just 0.8 187 | , topK = Nothing 188 | , numPredict = Just 20 189 | } 190 | ops = defaultChatOps {options = opts} 191 | eRes <- chat ops Nothing 192 | case eRes of 193 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 194 | Right r -> assertBool "Expected a response message" (isJust (message r)) 195 | 196 | testToolCall_addTwoNumbers :: TestTree 197 | testToolCall_addTwoNumbers = testCase "Tool call: addTwoNumbers(23, 46)" $ do 198 | let messageList = NE.singleton $ userMessage "What is 23 + 46? (Use tool)" 199 | paramProps = 200 | HM.fromList 201 | [ ("a", FunctionParameters "number" Nothing Nothing Nothing) 202 | , ("b", FunctionParameters "number" Nothing Nothing Nothing) 203 | ] 204 | functionParams = 205 | FunctionParameters 206 | { parameterType = "object" 207 | , requiredParams = Just ["a", "b"] 208 | , parameterProperties = Just paramProps 209 | , additionalProperties = Just False 210 | } 211 | functionDef = 212 | FunctionDef 213 | { functionName = "addTwoNumbers" 214 | , functionDescription = Just "Add two numbers" 215 | , functionParameters = Just functionParams 216 | , functionStrict = Nothing 217 | } 218 | tool = 219 | InputTool 220 | { toolType = "function" 221 | , function = functionDef 222 | } 223 | ops = 224 | defaultChatOps 225 | { chatModelName = "qwen3:0.6b" 226 | , messages = messageList 227 | , tools = Just [tool] 228 | } 229 | 230 | res <- chat ops Nothing 231 | case res of 232 | Left err -> assertFailure $ "Chat failed: " ++ show err 233 | Right ChatResponse {message = Nothing} -> assertFailure "No message in response" 234 | Right ChatResponse {message = Just msg} -> 235 | case tool_calls msg of 236 | Nothing -> assertFailure "No tool calls received" 237 | Just [toolCall] -> do 238 | result <- captureAddToolCall toolCall 239 | assertEqual "Expected result of 23 + 46" 69 result 240 | Just other -> assertFailure $ "Unexpected number of tool calls: " ++ show other 241 | 242 | -- Helper to evaluate the tool call 243 | captureAddToolCall :: ToolCall -> IO Int 244 | captureAddToolCall (ToolCall func) 245 | | outputFunctionName func == "addTwoNumbers" = 246 | case ( HM.lookup "a" (arguments func) >>= convertToNumber 247 | , HM.lookup "b" (arguments func) >>= convertToNumber 248 | ) of 249 | (Just a, Just b) -> return $ addTwoNumbers a b 250 | _ -> assertFailure "Missing parameters a or b" >> return 0 251 | | otherwise = assertFailure "Unexpected function name" >> return 0 252 | 253 | addTwoNumbers :: Int -> Int -> Int 254 | addTwoNumbers = (+) 255 | 256 | -- Convert Aeson value to Int 257 | convertToNumber :: Aeson.Value -> Maybe Int 258 | convertToNumber (Aeson.Number n) = toBoundedInteger n 259 | convertToNumber _ = Nothing 260 | 261 | -- | Group all tests 262 | tests :: TestTree 263 | tests = 264 | sequentialTestGroup 265 | "Chat tests" 266 | AllFinish 267 | [ basicChatTest 268 | , timeoutTest 269 | , hooksFailTest 270 | , hooksSuccessTest 271 | , retryCountTest 272 | , retryDelayTest 273 | , commonManagerTest 274 | , jsonFormatTest 275 | , streamingTest 276 | , modelOptionsTest 277 | , testToolCall_addTwoNumbers 278 | ] 279 | -------------------------------------------------------------------------------- /test/Test/Ollama/Embedding.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module Test.Ollama.Embedding (tests) where 5 | 6 | import Data.Maybe (listToMaybe) 7 | import Data.Ollama.Embeddings 8 | import Test.Tasty 9 | import Test.Tasty.HUnit 10 | 11 | testEmbeddingBasic :: TestTree 12 | testEmbeddingBasic = testCase "Basic embedding with qwen3" $ do 13 | res <- embedding "qwen3:0.6b" ["The sky is blue.", "Cats are independent."] 14 | case res of 15 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 16 | Right EmbeddingResp {..} -> do 17 | assertEqual "Should return two embeddings" 2 (length respondedEmbeddings) 18 | assertBool "Embeddings should not be empty" (all (not . null) respondedEmbeddings) 19 | 20 | testEmbeddingWithOptions :: TestTree 21 | testEmbeddingWithOptions = testCase "Embedding with truncate and keepAlive" $ do 22 | let opts = defaultModelOptions {numKeep = Just 5, seed = Just 42} 23 | res <- embeddingOps "qwen3:0.6b" ["Hello world"] (Just True) (Just 30) (Just opts) Nothing 24 | case res of 25 | Left err -> assertFailure $ "Unexpected error: " ++ show err 26 | Right EmbeddingResp {..} -> do 27 | assertEqual "Should return one embedding" 1 (length respondedEmbeddings) 28 | assertBool 29 | "Embedding vector should not be empty" 30 | (not . null $ listToMaybe respondedEmbeddings) 31 | 32 | testEmbeddingInvalidModel :: TestTree 33 | testEmbeddingInvalidModel = testCase "Embedding with invalid model name" $ do 34 | res <- embedding "nonexistent-model" ["This should fail."] 35 | case res of 36 | Left _ -> return () -- Expected failure 37 | Right _ -> assertFailure "Expected failure with invalid model name" 38 | 39 | tests :: TestTree 40 | tests = 41 | testGroup 42 | "Embeddings tests" 43 | [ testEmbeddingBasic 44 | , testEmbeddingWithOptions 45 | , testEmbeddingInvalidModel 46 | ] 47 | -------------------------------------------------------------------------------- /test/Test/Ollama/Generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- 4 | Tests related to Generate module 5 | -} 6 | module Test.Ollama.Generate (tests) where 7 | 8 | import Control.Monad (void) 9 | import Data.Aeson qualified as Aeson 10 | import Data.ByteString.Lazy.Char8 qualified as BSL 11 | import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) 12 | import Data.Ollama.Common.SchemaBuilder 13 | import Data.Ollama.Common.Utils (encodeImage) 14 | import Data.Ollama.Generate 15 | import Data.Text qualified as T 16 | import Data.Time (diffUTCTime, getCurrentTime) 17 | import Network.HTTP.Client 18 | import Network.HTTP.Client.TLS 19 | import Test.Tasty 20 | import Test.Tasty.HUnit 21 | 22 | generateTests :: TestTree 23 | generateTests = 24 | testGroup 25 | "Generation with various options" 26 | [ testCase "Should contain 4 in 2+2" $ do 27 | eRes <- 28 | generate 29 | defaultGenerateOps {modelName = "gemma3", prompt = "What is 2+2?"} 30 | Nothing 31 | case eRes of 32 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 33 | Right r -> assertBool "Should contain 4" (T.isInfixOf "4" (genResponse r)) 34 | , testCase "Setting timeout" $ do 35 | eRes <- 36 | generate 37 | defaultGenerateOps {modelName = "gemma3", prompt = "Write a poem about French revolution"} 38 | (Just $ defaultOllamaConfig {timeout = 1}) 39 | case eRes of 40 | Left (TimeoutError _) -> pure () 41 | _ -> assertFailure "Expected timeout error" 42 | ] 43 | 44 | testOnModelHooksFail :: TestTree 45 | testOnModelHooksFail = testCase "Model lifecycle hooks should be triggered" $ do 46 | refStart <- newIORef False 47 | refError <- newIORef False 48 | refFinish <- newIORef True 49 | let config = 50 | defaultOllamaConfig 51 | { hostUrl = "http://localhost:12345" -- guaranteed to fail 52 | , onModelStart = Just $ writeIORef refStart True 53 | , onModelError = Just $ writeIORef refError True 54 | , onModelFinish = Just $ writeIORef refFinish True 55 | } 56 | 57 | void $ 58 | generate 59 | defaultGenerateOps {modelName = "gemma3", prompt = "what is 23+41?"} 60 | (Just config) 61 | 62 | wasStarted <- readIORef refStart 63 | wasErrored <- readIORef refError 64 | wasFinished <- readIORef refFinish 65 | 66 | assertBool "onModelStart should be called" wasStarted 67 | assertBool "onModelError should be called" wasErrored 68 | assertBool "onModelFinish should be called" wasFinished 69 | 70 | testOnModelHooksSucc :: TestTree 71 | testOnModelHooksSucc = testCase "Model lifecycle hooks should be triggered 2" $ do 72 | refStart <- newIORef False 73 | refError <- newIORef True 74 | refFinish <- newIORef False 75 | let config = 76 | defaultOllamaConfig 77 | { onModelStart = Just $ writeIORef refStart True 78 | , onModelError = Just $ writeIORef refError False 79 | , onModelFinish = Just $ writeIORef refFinish True 80 | } 81 | 82 | void $ 83 | generate 84 | defaultGenerateOps {modelName = "gemma3", prompt = "what is 23+41?"} 85 | (Just config) 86 | 87 | wasStarted <- readIORef refStart 88 | wasErrored <- readIORef refError 89 | wasFinished <- readIORef refFinish 90 | 91 | assertBool "onModelStart should be called" wasStarted 92 | assertBool "onModelError should be called" wasErrored 93 | assertBool "onModelFinish should be called" wasFinished 94 | 95 | testRetryCount :: TestTree 96 | testRetryCount = testCase "Should retry generate call retryCount times" $ do 97 | counter <- newIORef (0 :: Int) 98 | let config = 99 | defaultOllamaConfig 100 | { hostUrl = "http://localhost:12345" -- fails 101 | , retryCount = Just 2 102 | , retryDelay = Just 1 103 | , onModelStart = Just $ modifyIORef counter (+ 1) 104 | , onModelError = Just $ pure () 105 | , onModelFinish = Just $ pure () 106 | } 107 | 108 | _ <- generate defaultGenerateOps {prompt = "Retry test"} (Just config) 109 | calls <- readIORef counter 110 | -- Should be retryCount + 1 (initial + retries) 111 | assertEqual "Expected 3 attempts (1 initial + 2 retries)" 3 calls 112 | 113 | testRetryDelay :: TestTree 114 | testRetryDelay = testCase "Should delay between retries" $ do 115 | counter <- newIORef (0 :: Int) 116 | let delaySecs = 2 117 | start <- getCurrentTime 118 | 119 | let config = 120 | defaultOllamaConfig 121 | { hostUrl = "http://localhost:12345" -- fails 122 | , retryCount = Just 1 123 | , retryDelay = Just delaySecs 124 | , onModelStart = Just $ modifyIORef counter (+ 1) 125 | , onModelError = Just $ pure () 126 | , onModelFinish = Just $ pure () 127 | } 128 | 129 | _ <- generate defaultGenerateOps {prompt = "Retry delay test"} (Just config) 130 | end <- getCurrentTime 131 | let elapsed = realToFrac (diffUTCTime end start) :: Double 132 | let expectedMin = fromIntegral delaySecs 133 | 134 | assertBool 135 | ("Elapsed time should be at least " ++ show expectedMin ++ "s, but was " ++ show elapsed) 136 | (elapsed >= expectedMin) 137 | 138 | testCommonManagerUsage :: TestTree 139 | testCommonManagerUsage = testCase "Should reuse provided commonManager" $ do 140 | refStart <- newIORef (0 :: Int) 141 | mgr <- 142 | newTlsManagerWith tlsManagerSettings {managerResponseTimeout = responseTimeoutMicro 1000000} 143 | let config = 144 | defaultOllamaConfig 145 | { hostUrl = "http://localhost:12345" -- will fail fast 146 | , commonManager = Just mgr 147 | , timeout = 999 -- shouldn't matter, manager timeout will be used 148 | , onModelStart = Just $ modifyIORef refStart (+ 1) 149 | , onModelError = Just $ pure () 150 | , onModelFinish = Just $ pure () 151 | } 152 | 153 | _ <- generate defaultGenerateOps {prompt = "1"} (Just config) 154 | _ <- generate defaultGenerateOps {prompt = "2"} (Just config) 155 | startCount <- readIORef refStart 156 | assertEqual "Both requests should start (reuse manager)" 2 startCount 157 | 158 | {- 159 | Suffix is not supported for few gemma3 and qwen3. 160 | 161 | testSuffixOption :: TestTree 162 | testSuffixOption = testCase "Should respect suffix in generation" $ do 163 | let ops = defaultGenerateOps 164 | { modelName = "qwen3:0.6b" 165 | , prompt = "Complete this sentence: The Eiffel Tower is in" 166 | , suffix = Just " [End]" 167 | } 168 | eRes <- generate ops Nothing 169 | case eRes of 170 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 171 | Right r -> assertBool "Expected suffix in response" $ 172 | T.isSuffixOf "[End]" (genResponse r) 173 | -} 174 | 175 | testThinkOption :: TestTree 176 | testThinkOption = testCase "Should activate thinking mode when think=True" $ do 177 | let ops = 178 | defaultGenerateOps 179 | { modelName = "qwen3:0.6b" 180 | , prompt = "What is 2+2?" 181 | , think = Just True 182 | } 183 | eRes <- generate ops Nothing 184 | case eRes of 185 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 186 | Right _ -> pure () -- TODO: Need to find a way to know if model is thinking 187 | 188 | testFormatJsonFormat :: TestTree 189 | testFormatJsonFormat = testCase "Should return response in JsonFormat" $ do 190 | let ops = 191 | defaultGenerateOps 192 | { modelName = "gemma3" 193 | , prompt = 194 | "John was 23 year old in 2023, this is year 2025." 195 | <> "How old is John assuming he celebrated this year's birthday; " 196 | <> "Return an object with keys 'name' and 'age'." 197 | , format = Just JsonFormat 198 | } 199 | eRes <- generate ops Nothing 200 | case eRes of 201 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 202 | Right r -> do 203 | let responseText = genResponse r 204 | let decoded = Aeson.decode (BSL.pack $ T.unpack responseText) :: Maybe Aeson.Value 205 | assertBool "Expected valid JSON object in response" (decoded /= Nothing) 206 | 207 | testFormatSchemaFormat :: TestTree 208 | testFormatSchemaFormat = testCase "Should include SchemaFormat in the request" $ do 209 | let schema = 210 | buildSchema $ 211 | emptyObject 212 | |+ ("fruit", JString) 213 | |+ ("quantity", JNumber) 214 | |! "fruit" 215 | |! "quantity" 216 | 217 | ops = 218 | defaultGenerateOps 219 | { modelName = "gemma3" 220 | , prompt = "I had 3 apples, 1 gave one away. How many left?" 221 | , format = Just (SchemaFormat schema) 222 | } 223 | 224 | eRes <- generate ops Nothing 225 | case eRes of 226 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 227 | Right r -> do 228 | let response = T.toLower (genResponse r) 229 | assertBool "Expected fruit information in response" $ 230 | "apple" `T.isInfixOf` response || "fruit" `T.isInfixOf` response 231 | 232 | testImageInput :: TestTree 233 | testImageInput = testCase "Should accept and process base64 image input" $ do 234 | maybeImg <- encodeImage "./examples/sample.png" 235 | case maybeImg of 236 | Nothing -> assertFailure "Image encoding failed (unsupported format or missing file)" 237 | Just imgData -> do 238 | let ops = 239 | defaultGenerateOps 240 | { modelName = "gemma3" 241 | , prompt = "Describe this image." 242 | , images = Just [imgData] 243 | } 244 | cfg = Just defaultOllamaConfig {timeout = 300} 245 | 246 | eRes <- generate ops cfg 247 | case eRes of 248 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 249 | Right r -> do 250 | let response = T.toLower (genResponse r) 251 | assertBool "Expected image-related description in response" $ 252 | T.isInfixOf "i love haskell" response 253 | 254 | testStreamingHandler :: TestTree 255 | testStreamingHandler = testCase "Should handle streaming response" $ do 256 | -- IORef to collect streamed chunks 257 | chunksRef <- newIORef [] 258 | -- Define the stream handler: accumulate responses 259 | let streamHandler chunk = modifyIORef chunksRef (++ [genResponse chunk]) 260 | ops = 261 | defaultGenerateOps 262 | { modelName = "gemma3" 263 | , prompt = "Write few words about Haskell." 264 | , stream = Just streamHandler 265 | } 266 | eRes <- generate ops Nothing 267 | -- Collect streamed chunks from IORef 268 | chunks <- readIORef chunksRef 269 | let fullOutput = T.concat chunks 270 | case eRes of 271 | Left err -> assertFailure $ "Expected streaming success, got error: " ++ show err 272 | Right _ -> do 273 | assertBool "Expected streamed text to include 'haskell'" $ 274 | "haskell" `T.isInfixOf` T.toLower fullOutput 275 | assertBool "Expected some streamed content" $ not (T.null fullOutput) 276 | 277 | testModelOptionsBasic :: TestTree 278 | testModelOptionsBasic = testCase "ModelOptions: temperature and topP" $ do 279 | let opts = 280 | Just $ 281 | defaultModelOptions 282 | { temperature = Just 0.9 283 | , topP = Just 0.8 284 | , topK = Nothing 285 | , numPredict = Just 20 286 | } 287 | 288 | eRes <- 289 | generate 290 | defaultGenerateOps 291 | { modelName = "gemma3" 292 | , prompt = "Generate a random list of 3 animals" 293 | , options = opts 294 | } 295 | Nothing 296 | 297 | case eRes of 298 | Left err -> assertFailure $ "Expected success, got: " ++ show err 299 | Right r -> assertBool "Response should not be empty" (not . T.null $ genResponse r) 300 | 301 | tests :: TestTree 302 | tests = 303 | sequentialTestGroup 304 | "Generate tests" 305 | AllFinish 306 | [ generateTests 307 | , testOnModelHooksFail 308 | , testOnModelHooksSucc 309 | , testRetryCount 310 | , testRetryDelay 311 | , testCommonManagerUsage 312 | , testThinkOption 313 | , testFormatJsonFormat 314 | , testFormatSchemaFormat 315 | , testImageInput 316 | , testStreamingHandler 317 | , testModelOptionsBasic 318 | ] 319 | -------------------------------------------------------------------------------- /test/Test/Ollama/Show.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Test.Ollama.Show (tests) where 5 | 6 | import Test.Tasty 7 | import Test.Tasty.HUnit 8 | import Data.Ollama.Show 9 | import Data.Ollama.Ps 10 | import Data.Text qualified as T 11 | import Data.Maybe (isJust) 12 | 13 | testShowModelBasic :: TestTree 14 | testShowModelBasic = testCase "Show model info: basic call" $ do 15 | res <- showModel "gemma3" 16 | case res of 17 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 18 | Right ShowModelResponse {modelFile, modelInfo = ShowModelInfo {generalArchitecture}} -> do 19 | assertBool "modelFile should not be empty" (not $ T.null modelFile) 20 | assertBool "Architecture should be present" (isJust generalArchitecture) 21 | 22 | testShowModelVerbose :: TestTree 23 | testShowModelVerbose = testCase "Show model info: verbose enabled" $ do 24 | res <- showModelOps "qwen3:0.6b" (Just True) Nothing 25 | case res of 26 | Left _ -> pure () --assertFailure $ "Expected success, got error: " ++ show err 27 | Right ShowModelResponse {template, parameters} -> do 28 | -- Verbose should yield more details like parameters/template 29 | assertBool "Should have a template if verbose" (isJust template) 30 | assertBool "Should have parameters if verbose" (isJust parameters) 31 | 32 | testPsBasic :: TestTree 33 | testPsBasic = testCase "List running models: basic success" $ do 34 | res <- ps Nothing 35 | case res of 36 | Left err -> assertFailure $ "Expected success, got error: " ++ show err 37 | Right (RunningModels _) -> do 38 | assertBool "Should return a list (possibly empty)" True 39 | 40 | testPsModelFields :: TestTree 41 | testPsModelFields = testCase "Running model fields are populated" $ do 42 | res <- ps Nothing 43 | case res of 44 | Left _ -> return () -- Allow failure if no models are running 45 | Right (RunningModels (m:_)) -> do 46 | assertBool "name_ should not be empty" (not $ T.null $ name_ m) 47 | assertBool "modelName should not be empty" (not $ T.null $ modelName m) 48 | assertBool "modelDigest should not be empty" (not $ T.null $ modelDigest m) 49 | assertBool "size_ should be positive" (size_ m > 0) 50 | assertBool "sizeVRam should be non-negative" (sizeVRam m >= 0) 51 | Right _ -> return () -- If empty, that's acceptable 52 | 53 | tests :: TestTree 54 | tests = testGroup "show model tests" [ 55 | testShowModelBasic 56 | , testShowModelVerbose 57 | , testPsBasic 58 | , testPsModelFields 59 | ] 60 | --------------------------------------------------------------------------------