diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +# Changelog for langchain-hs-ollama + +## 0.0.6.0 - 2026-10-02 + +- Initial release. Split from the monolithic `langchain-hs` package. +- Provides `Langchain.Provider.Ollama` and `Langchain.Embeddings.Ollama`. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2025 Tushar Adhatrao + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,33 @@ +# langchain-hs-ollama + +Ollama ChatModel provider and embeddings for [langchain-hs](https://hackage.haskell.org/package/langchain-hs). + +Provides `Langchain.Provider.Ollama` and `Langchain.Embeddings.Ollama` without +pulling in OpenAI or Gemini dependencies. + +## Installation + +```yaml +# stack.yaml extra-deps +- langchain-hs-ollama-0.0.6.0 +``` + +```yaml +# package.yaml / .cabal +dependencies: + - langchain-hs-ollama +``` + +## Usage + +```haskell +import Langchain.Provider.Ollama +import Control.Monad.Except (runExceptT) + +main :: IO () +main = do + model <- newOllama "llama3" defaultClientConfig + let cfg = withOptions (defaultOptions {optTemperature = Just 0.7}) defaultOllamaConfig + res <- runExceptT $ invoke model [userMessage "Hello"] (Just cfg) + print res +``` diff --git a/langchain-hs-ollama.cabal b/langchain-hs-ollama.cabal new file mode 100644 --- /dev/null +++ b/langchain-hs-ollama.cabal @@ -0,0 +1,75 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.39.6. +-- +-- see: https://github.com/sol/hpack + +name: langchain-hs-ollama +version: 0.0.6.0 +synopsis: Ollama provider and embeddings for langchain-hs +description: Ollama ChatModel provider and text embeddings integration for langchain-hs. Depends only on ollama-haskell; does not pull in OpenAI or Gemini dependencies. +category: AI +homepage: https://github.com/tusharad/langchain-hs#readme +bug-reports: https://github.com/tusharad/langchain-hs/issues +author: Tushar Adhatrao +maintainer: tusharadhatrao@gmail.com +copyright: 2025-2026 Tushar Adhatrao +license: MIT +license-file: LICENSE +build-type: Simple +tested-with: + GHC == 9.12.4 + , GHC == 9.10.3 + , GHC == 9.8.4 +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/tusharad/langchain-hs + +library + exposed-modules: + Langchain.Provider.Ollama + Langchain.Embeddings.Ollama + other-modules: + Paths_langchain_hs_ollama + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + aeson >=2.0 && <3 + , base >=4.17 && <5 + , bytestring >=0.10 && <0.13 + , conduit ==1.3.* + , langchain-hs-core ==0.0.6.* + , mtl >=2.2 && <2.4 + , ollama-haskell >=0.4.0.0 && <0.5 + , text >=1.2 && <3 + default-language: Haskell2010 + +test-suite langchain-hs-ollama-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Test.Langchain.Provider.Ollama + Test.Langchain.Provider.OllamaConversionSpec + Paths_langchain_hs_ollama + hs-source-dirs: + test + 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 + build-depends: + aeson + , base >=4.17 && <5 + , bytestring + , conduit ==1.3.* + , containers + , langchain-hs-core + , langchain-hs-ollama + , mtl >=2.2 && <2.4 + , ollama-haskell + , tasty + , tasty-hunit + , text + default-language: Haskell2010 diff --git a/src/Langchain/Embeddings/Ollama.hs b/src/Langchain/Embeddings/Ollama.hs new file mode 100644 --- /dev/null +++ b/src/Langchain/Embeddings/Ollama.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{- | +Module : Langchain.Embeddings.Ollama +Description : Ollama integration for text embeddings in LangChain Haskell +Copyright : (c) 2025-2026 Tushar Adhatrao +License : MIT +Maintainer : Tushar Adhatrao +Stability : experimental + +Ollama implementation of LangChain's embedding interface using ollama-haskell 0.3.0.0. +-} +module Langchain.Embeddings.Ollama + ( OllamaEmbeddings (..) + ) where + +import Control.Monad.Except (throwError) +import Control.Monad.IO.Class (liftIO) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Langchain.DocumentLoader.Core (Document (..)) +import Langchain.Embeddings.Core +import Langchain.Error (llmError) + +import Ollama.API.Embed (EmbedRequest (..), EmbedResponse (..), embed) +import Ollama.Client (defaultClient) +import Ollama.Types.Common (ModelName (..)) +import Ollama.Types.Options (ModelOptions) + +data OllamaEmbeddings = OllamaEmbeddings + { model :: Text + , defaultTruncate :: Maybe Bool + , defaultKeepAlive :: Maybe Text + , modelOptions :: Maybe ModelOptions + } + deriving (Show, Eq) + +instance Embeddings OllamaEmbeddings where + embedDocuments (OllamaEmbeddings {..}) docs = do + client <- liftIO defaultClient + let inputs = map (TL.toStrict . pageContent) docs + req = + EmbedRequest + { embModel = ModelName model + , embInput = Right inputs + , embTruncate = defaultTruncate + , embOptions = modelOptions + , embKeepAlive = defaultKeepAlive + , embDimensions = Nothing + } + eRes <- liftIO $ embed client req + case eRes of + Left ollamaErr -> throwError $ llmError (T.pack (show ollamaErr)) (Just "OllamaEmbeddings") Nothing + Right resp -> pure $ map (map realToFrac) (erEmbeddings resp) + + embedQuery (OllamaEmbeddings {..}) query = do + client <- liftIO defaultClient + let req = + EmbedRequest + { embModel = ModelName model + , embInput = Left query + , embTruncate = defaultTruncate + , embOptions = modelOptions + , embKeepAlive = defaultKeepAlive + , embDimensions = Nothing + } + eRes <- liftIO $ embed client req + case eRes of + Left err -> throwError $ llmError (T.pack (show err)) (Just "OllamaEmbeddings") Nothing + Right resp -> case erEmbeddings resp of + (vec : _) -> pure $ map realToFrac vec + [] -> throwError $ llmError "Embeddings are empty" (Just "OllamaEmbeddings") Nothing diff --git a/src/Langchain/Provider/Ollama.hs b/src/Langchain/Provider/Ollama.hs new file mode 100644 --- /dev/null +++ b/src/Langchain/Provider/Ollama.hs @@ -0,0 +1,415 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{- | +Module : Langchain.Provider.Ollama +Description : Ollama provider implementing the effect-polymorphic ChatModel typeclass +Copyright : (c) 2025-2026 Tushar Adhatrao +License : MIT +Maintainer : Tushar Adhatrao +Stability : experimental + +Ollama provider using 'ollama-haskell'. Supports native structured outputs +via JSON Schema grammar sampling, token streaming, tool calling, and model options. +-} +module Langchain.Provider.Ollama + ( -- * Provider + Ollama (..) + , newOllama + , newOllamaWithClient + + -- * Configuration + , OllamaConfig (..) + , OllamaOptions + , defaultOllamaConfig + , defaultClientConfig + , withOptions + , withTools + , withJsonFormat + , withSchemaFormat + , withStructuredOutput + , withKeepAlive + , withThink + + -- * Proxy + , Proxy (..) + + -- * Tool Binding + , OllamaWithTools (..) + , bindTools + , toOllamaTool + , toOllamaTools + + -- * Conversions + , toOllamaRole + , fromOllamaRole + , toOllamaMessage + , fromOllamaMessage + + -- * Re-exports from ollama-haskell + , module Ollama.Client.Config + , module Ollama.Types.Common + , module Ollama.Types.Options + , OFormat.Format (..) + , OSB.Schema (..) + , OSB.Property (..) + , OSB.JsonType (..) + , OSD.ToSchema (..) + , OSD.ToJsonType (..) + ) where + +import Control.Applicative ((<|>)) +import Control.Monad (when) +import Control.Monad.Except (throwError) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (Result (..), decode, fromJSON, toJSON, (.=)) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy.Char8 as LBSC +import Data.Conduit (await, transPipe, yield, (.|)) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Proxy (Proxy (..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import GHC.Generics (Generic) + +import Langchain.Cache.Core (CacheableChatModel (..)) +import Langchain.Error (llmError) +import Langchain.Model +import Langchain.Stream (StreamEvent (..), TokenUsage (..)) +import Langchain.Tool (Tool, toolToValue) +import Langchain.Tool.Binding (ToolBinder (..)) + +import qualified Ollama.API.Chat as OllamaChat +import Ollama.Client (OllamaClient (..), newClient) +import Ollama.Client.Config (OllamaClientConfig (..), defaultConfig) +import Ollama.Types.Common (Base64Image (..), ModelName (..), Think) +import qualified Ollama.Types.Format as OFormat +import qualified Ollama.Types.Format.SchemaBuilder as OSB +import qualified Ollama.Types.Format.SchemaDerive as OSD +import qualified Ollama.Types.Message as O +import Ollama.Types.Options (ModelOptions (..), defaultOptions) +import qualified Ollama.Types.Tool as OTool + +-- | Ollama provider wrapping an 'OllamaClient' and model name. +data Ollama = Ollama + { client :: !OllamaClient + -- ^ The underlying HTTP client connection to Ollama + , ollamaModelName :: !Text + -- ^ The model name (e.g. @"llama3"@, @"gemma3"@) + } + +instance Show Ollama where + show (Ollama _ m) = "Ollama provider (" ++ show m ++ ")" + +-- | Create a new Ollama provider with a model name and client configuration. +newOllama :: MonadIO m => Text -> OllamaClientConfig -> m Ollama +newOllama model cfg = do + c <- liftIO $ newClient cfg + pure $ Ollama c model + +-- | Create an Ollama provider using an existing 'OllamaClient' handle. +newOllamaWithClient :: Text -> OllamaClient -> Ollama +newOllamaWithClient model c = Ollama c model + +{- | Configuration options for an Ollama invocation. + +Contains request-level settings (tools, format constraints, model options, +keep-alive duration, thinking parameter) without redundant model names or message history. +-} +data OllamaConfig = OllamaConfig + { ollamaTools :: !(Maybe [OTool.Tool]) + -- ^ Tool definitions available for the model to invoke + , ollamaFormat :: !(Maybe OFormat.Format) + -- ^ Output format constraint (e.g. JSON format or JSON schema) + , ollamaOptions :: !(Maybe ModelOptions) + -- ^ Runtime model parameters (temperature, num_ctx, top_k, top_p, etc.) + , ollamaKeepAlive :: !(Maybe Text) + -- ^ Time to keep model in memory (e.g. @"5m"@) + , ollamaThink :: !(Maybe Think) + -- ^ Thinking parameter for reasoning models + } + deriving (Eq, Show, Generic) + +-- | Backward-compatible alias for 'OllamaConfig'. +type OllamaOptions = OllamaConfig + +-- | Default empty 'OllamaConfig' with all options unset. +defaultOllamaConfig :: OllamaConfig +defaultOllamaConfig = OllamaConfig Nothing Nothing Nothing Nothing Nothing + +-- | Default Ollama client configuration targeting local @http://localhost:11434@. +defaultClientConfig :: OllamaClientConfig +defaultClientConfig = defaultConfig + +instance Semigroup OllamaConfig where + a <> b = + OllamaConfig + { ollamaTools = case (ollamaTools a, ollamaTools b) of + (Just ts1, Just ts2) -> Just (ts1 ++ ts2) + (t1, t2) -> t2 <|> t1 + , ollamaFormat = ollamaFormat b <|> ollamaFormat a + , ollamaOptions = ollamaOptions b <|> ollamaOptions a + , ollamaKeepAlive = ollamaKeepAlive b <|> ollamaKeepAlive a + , ollamaThink = ollamaThink b <|> ollamaThink a + } + +instance Monoid OllamaConfig where + mempty = defaultOllamaConfig + +-- | Attach runtime 'ModelOptions' (temperature, context size, etc.) to an 'OllamaConfig'. +withOptions :: ModelOptions -> OllamaConfig -> OllamaConfig +withOptions opts cfg = cfg {ollamaOptions = Just opts} + +-- | Attach Langchain tools to an 'OllamaConfig'. +withTools :: [Tool m] -> OllamaConfig -> OllamaConfig +withTools ts cfg = + let newTs = toOllamaTools ts + combined = case ollamaTools cfg of + Nothing -> newTs + Just existing -> existing ++ newTs + in cfg {ollamaTools = Just combined} + +-- | Attach generic JSON format constraint to an 'OllamaConfig'. +withJsonFormat :: OllamaConfig -> OllamaConfig +withJsonFormat cfg = cfg {ollamaFormat = Just OFormat.JsonFormat} + +-- | Attach specific Schema format constraint to an 'OllamaConfig'. +withSchemaFormat :: OSB.Schema -> OllamaConfig -> OllamaConfig +withSchemaFormat schema cfg = cfg {ollamaFormat = Just (OFormat.SchemaFormat schema)} + +-- | Attach automatic 'OSD.ToSchema' derived format constraint to an 'OllamaConfig'. +withStructuredOutput :: + forall a. + (OSD.ToSchema a) => + Proxy a -> + OllamaConfig -> + OllamaConfig +withStructuredOutput _ cfg = + cfg {ollamaFormat = Just (OFormat.SchemaFormat (OSD.toSchema @a))} + +-- | Set keep-alive duration (e.g. @"5m"@) on an 'OllamaConfig'. +withKeepAlive :: Text -> OllamaConfig -> OllamaConfig +withKeepAlive duration cfg = cfg {ollamaKeepAlive = Just duration} + +-- | Set thinking parameter on an 'OllamaConfig'. +withThink :: Think -> OllamaConfig -> OllamaConfig +withThink th cfg = cfg {ollamaThink = Just th} + +-- | Convert core 'Role' to Ollama 'O.Role'. +toOllamaRole :: Role -> O.Role +toOllamaRole System = O.System +toOllamaRole User = O.User +toOllamaRole Assistant = O.Assistant +toOllamaRole Tool = O.Tool +toOllamaRole Developer = O.System +toOllamaRole Function = O.Tool + +-- | Convert Ollama 'O.Role' to core 'Role'. +fromOllamaRole :: O.Role -> Role +fromOllamaRole O.System = System +fromOllamaRole O.User = User +fromOllamaRole O.Assistant = Assistant +fromOllamaRole O.Tool = Tool + +-- | Convert core 'Message' to Ollama 'O.Message'. +toOllamaMessage :: Message -> O.Message +toOllamaMessage msg = + let r = toOllamaRole (messageRole msg) + txt = extractMessageText msg + imgs = case [ b64 + | ImageBlock ImageContent {imageSource = ImageBase64 _ b64} <- NonEmpty.toList (messageContents msg) + ] of + [] -> Nothing + xs -> Just (map Base64Image xs) + tools = case messageToolCalls msg of + Nothing -> Nothing + Just tcs -> + Just + [ OTool.ToolCall + { OTool.tcFunction = + OTool.ToolCallFunction + { OTool.tcfName = toolCallName tc + , OTool.tcfArguments = parseArgs (toolCallArguments tc) + } + } + | tc <- tcs + ] + parseArgs v = case v of + Aeson.Object _ -> case fromJSON v of + Success m -> m + _ -> mempty + Aeson.String s -> fromMaybe mempty $ decode (LBSC.fromStrict (TE.encodeUtf8 s)) + _ -> case fromJSON v of + Success m -> m + _ -> mempty + in O.Message r txt imgs tools (messageName msg) Nothing + +-- | Convert Ollama 'O.Message' to core 'Message'. +fromOllamaMessage :: O.Message -> Message +fromOllamaMessage (O.Message r txt _imgs tools name _think) = + let cRole = fromOllamaRole r + cMsg = (textMessage cRole txt) {messageName = name} + cTools = case tools of + Nothing -> Nothing + Just tcs -> + Just + [ ToolCall + { toolCallId = "" + , toolCallType = "function" + , toolCallName = OTool.tcfName (OTool.tcFunction tc) + , toolCallArguments = toJSON (OTool.tcfArguments (OTool.tcFunction tc)) + } + | tc <- tcs + ] + in cMsg {messageToolCalls = cTools} + +-- | Convert a Langchain 'Tool' definition to an Ollama 'OTool.Tool'. +toOllamaTool :: Tool m -> Maybe OTool.Tool +toOllamaTool t = case fromJSON (toolToValue t) of + Success ot -> Just ot + Aeson.Error _ -> Nothing + +-- | Convert a list of Langchain 'Tool' definitions to Ollama 'OTool.Tool's. +toOllamaTools :: [Tool m] -> [OTool.Tool] +toOllamaTools = mapMaybe toOllamaTool + +-- | Build an 'OllamaChat.ChatRequest' from an 'Ollama' model, messages, and optional 'OllamaConfig'. +toChatRequest :: Ollama -> [Message] -> Maybe OllamaConfig -> OllamaChat.ChatRequest +toChatRequest (Ollama _ mName) inputMsgs mbConfig = + let oMsgs = case inputMsgs of + (m : ms) -> NonEmpty.map toOllamaMessage (m NonEmpty.:| ms) + [] -> O.userMessage "" NonEmpty.:| [] + cfg = fromMaybe defaultOllamaConfig mbConfig + in OllamaChat.ChatRequest + { OllamaChat.chatModel = ModelName mName + , OllamaChat.chatMessages = oMsgs + , OllamaChat.chatTools = ollamaTools cfg + , OllamaChat.chatFormat = ollamaFormat cfg + , OllamaChat.chatOptions = ollamaOptions cfg + , OllamaChat.chStream = Just False + , OllamaChat.chatKeepAlive = ollamaKeepAlive cfg + , OllamaChat.chatThink = ollamaThink cfg + } + +instance ChatModel Ollama where + type ModelConfig Ollama = OllamaConfig + + invoke model inputMsgs mbConfig = do + let req = toChatRequest model inputMsgs mbConfig + eRes <- liftIO $ OllamaChat.chat (client model) req + case eRes of + Left err -> throwError $ llmError (T.pack $ show err) (Just "Ollama") Nothing + Right resp -> case OllamaChat.crMessage resp of + Nothing -> throwError $ llmError "No message in response" (Just "Ollama") Nothing + Just oMsg -> pure $ fromOllamaMessage oMsg + + stream model inputMsgs mbConfig = do + let runId_ = "ollama-run" + req = toChatRequest model inputMsgs mbConfig + resolvedModel = ollamaModelName model + + yield $ LLMStart runId_ resolvedModel inputMsgs + transPipe liftIO (OllamaChat.chatStream (client model) req) .| processChunks runId_ + where + processChunks rId = loop [] Nothing Nothing + where + loop accChunks mbLastUsage mbLastTools = + await >>= \case + Nothing -> do + let fullText = T.concat (reverse accChunks) + finalMsg = + (assistantMessage fullText) + { messageToolCalls = mbLastTools + } + yield $ LLMEnd rId finalMsg mbLastUsage + Just resp -> do + let mbMsg = OllamaChat.crMessage resp + chunkTxt = maybe "" O.messageContent mbMsg + mbTools = mbMsg >>= O.messageToolCalls + toolCalls = case mbTools of + Nothing -> Nothing + Just tcs -> + Just + [ ToolCall + { toolCallId = "" + , toolCallType = "function" + , toolCallName = OTool.tcfName (OTool.tcFunction tc) + , toolCallArguments = toJSON (OTool.tcfArguments (OTool.tcFunction tc)) + } + | tc <- tcs + ] + toolDelta = case toolCalls of + Just (tc : _) -> Just tc + _ -> Nothing + newAccChunks = if T.null chunkTxt then accChunks else chunkTxt : accChunks + newTools = case toolCalls of + Just tcs -> Just $ maybe tcs (++ tcs) mbLastTools + Nothing -> mbLastTools + newUsage = case (OllamaChat.crPromptEvalCount resp, OllamaChat.crEvalCount resp) of + (Just p, Just c) -> Just $ TokenUsage p c (p + c) + _ -> mbLastUsage + when (not (T.null chunkTxt) || isJust toolDelta) $ + yield $ + LLMChunk rId chunkTxt toolDelta + loop newAccChunks newUsage newTools + +instance CacheableChatModel Ollama where + cacheModelIdentity (Ollama ollamaClient mName) mbCfg = + Aeson.object + [ "provider" .= ("ollama" :: Text) + , "baseUrl" .= configBaseUrl (clientConfig ollamaClient) + , "model" .= mName + , "config" + .= Aeson.object + [ "tools" .= (ollamaTools =<< mbCfg) + , "format" .= (ollamaFormat =<< mbCfg) + , "options" .= (ollamaOptions =<< mbCfg) + , "keep_alive" .= (ollamaKeepAlive =<< mbCfg) + , "think" .= (ollamaThink =<< mbCfg) + ] + ] + +-- | Attach tool definitions to an 'Ollama' invocation config. +instance ToolBinder Ollama m where + bindToolsConfig tools mbConfig = + case tools of + [] -> mbConfig + _ -> + let cfg = fromMaybe defaultOllamaConfig mbConfig + in Just (withTools tools cfg) + +-- | Ollama model with pre-bound tools. +data OllamaWithTools m = OllamaWithTools + { ollamaBaseModel :: !Ollama + -- ^ The underlying Ollama model + , ollamaBoundTools :: ![Tool m] + -- ^ Pre-bound tools attached to this model + } + +instance Show (OllamaWithTools m) where + show (OllamaWithTools m _) = "OllamaWithTools (" ++ show m ++ ")" + +-- | Bind tools to an Ollama model so any invocation automatically includes tool definitions. +bindTools :: [Tool m] -> Ollama -> OllamaWithTools m +bindTools ts model = OllamaWithTools model ts + +instance ChatModel (OllamaWithTools m) where + type ModelConfig (OllamaWithTools m) = OllamaConfig + invoke (OllamaWithTools model ts) msgs mbCfg = + invoke model msgs (bindToolsConfig @Ollama ts mbCfg) + stream (OllamaWithTools model ts) msgs mbCfg = + stream model msgs (bindToolsConfig @Ollama ts mbCfg) + +instance ToolBinder (OllamaWithTools m) n where + bindToolsConfig tools mbCfg = + case tools of + [] -> mbCfg + _ -> Just (withTools tools (fromMaybe defaultOllamaConfig mbCfg)) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import qualified Test.Langchain.Provider.Ollama as OllamaProviderTest +import qualified Test.Langchain.Provider.OllamaConversionSpec as OllamaConversionTest +import Test.Tasty + +main :: IO () +main = + defaultMain $ + testGroup + "langchain-hs-ollama Test Suite" + [ testGroup + "Provider Tests" + [ OllamaProviderTest.tests + , OllamaConversionTest.tests + ] + ] diff --git a/test/Test/Langchain/Provider/Ollama.hs b/test/Test/Langchain/Provider/Ollama.hs new file mode 100644 --- /dev/null +++ b/test/Test/Langchain/Provider/Ollama.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Langchain.Provider.Ollama (tests) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Data.Text (Text) +import GHC.Generics (Generic) + +import Langchain.Provider.Ollama +import qualified Ollama.Client as OC +import qualified Ollama.Types.Format as OFormat + +testModelName :: Text +testModelName = "gemma3:latest" + +data TestPerson = TestPerson + { personName :: !Text + , personAge :: !Int + } + deriving (Show, Eq, Generic, ToSchema) + +tests :: TestTree +tests = + testGroup + "Langchain.Provider.Ollama" + [ testCase "newOllama initializes provider with defaultConfig" $ do + p <- newOllama testModelName defaultClientConfig + ollamaModelName p @?= testModelName + , testCase "newOllama accepts custom OllamaClientConfig" $ do + let cfg = + defaultClientConfig + { configBaseUrl = "http://custom-host:11434" + , configTimeout = 120 + } + p <- newOllama "qwen3.5:2b" cfg + ollamaModelName p @?= "qwen3.5:2b" + configBaseUrl (OC.clientConfig (client p)) @?= "http://custom-host:11434" + configTimeout (OC.clientConfig (client p)) @?= 120 + , testCase "newOllamaWithClient wraps existing OllamaClient" $ do + c <- OC.defaultClient + let p = newOllamaWithClient testModelName c + ollamaModelName p @?= testModelName + , testCase "defaultOllamaConfig is empty" $ do + let cfg = defaultOllamaConfig + ollamaTools cfg @?= Nothing + ollamaFormat cfg @?= Nothing + ollamaOptions cfg @?= Nothing + ollamaKeepAlive cfg @?= Nothing + ollamaThink cfg @?= Nothing + , testCase "withOptions sets ModelOptions on OllamaConfig" $ do + let opts = defaultOptions {optTemperature = Just 0.3, optNumCtx = Just 4096} + cfg = withOptions opts defaultOllamaConfig + case ollamaOptions cfg of + Nothing -> assertFailure "Expected ollamaOptions in OllamaConfig" + Just o -> do + optTemperature o @?= Just 0.3 + optNumCtx o @?= Just 4096 + , testCase "withJsonFormat sets JsonFormat" $ do + let cfg = withJsonFormat defaultOllamaConfig + ollamaFormat cfg @?= Just OFormat.JsonFormat + , testCase "withStructuredOutput sets SchemaFormat" $ do + let cfg = withStructuredOutput (Proxy @TestPerson) defaultOllamaConfig + case ollamaFormat cfg of + Just (OFormat.SchemaFormat _) -> pure () + _ -> assertFailure "Expected SchemaFormat in OllamaConfig" + , testCase "withKeepAlive sets keep-alive duration" $ do + let cfg = withKeepAlive "10m" defaultOllamaConfig + ollamaKeepAlive cfg @?= Just "10m" + ] diff --git a/test/Test/Langchain/Provider/OllamaConversionSpec.hs b/test/Test/Langchain/Provider/OllamaConversionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Langchain/Provider/OllamaConversionSpec.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Langchain.Provider.OllamaConversionSpec (tests) where + +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Map.Strict as Map +import Test.Tasty +import Test.Tasty.HUnit + +import Langchain.Model +import Langchain.Provider.Ollama + ( fromOllamaMessage + , fromOllamaRole + , toOllamaMessage + , toOllamaRole + ) +import Ollama.Types.Common (Base64Image (..)) +import qualified Ollama.Types.Message as O + +tests :: TestTree +tests = + testGroup + "Langchain.Provider.OllamaConversionSpec" + [ testGroup + "Role Mapping Tests" + [ testCase "Standard roles map to Ollama equivalents" $ do + toOllamaRole System @?= O.System + toOllamaRole User @?= O.User + toOllamaRole Assistant @?= O.Assistant + toOllamaRole Tool @?= O.Tool + , testCase "Developer and Function roles map to System/Tool fallbacks" $ do + toOllamaRole Developer @?= O.System + toOllamaRole Function @?= O.Tool + , testCase "fromOllamaRole parses Ollama roles to Langchain roles" $ do + fromOllamaRole O.System @?= System + fromOllamaRole O.User @?= User + fromOllamaRole O.Assistant @?= Assistant + fromOllamaRole O.Tool @?= Tool + ] + , testGroup + "Message Conversion Tests" + [ testCase "toOllamaMessage extracts base64 image data" $ do + let msg = imageMessage User "image/png" "iVBORw0KGgoAAAANSUhEUg==" + (O.Message r _ imgs _ _ _) = toOllamaMessage msg + r @?= O.User + case imgs of + Just [Base64Image b64] -> b64 @?= "iVBORw0KGgoAAAANSUhEUg==" + _ -> assertFailure "Expected single base64 image in Ollama message" + , testCase "fromOllamaMessage parses role and text content" $ do + let oMsg = O.Message O.Assistant "Response content" Nothing Nothing Nothing Nothing + msg = fromOllamaMessage oMsg + messageRole msg @?= Assistant + extractMessageText msg @?= "Response content" + , testCase "Multi-modal message with text and image converts correctly" $ do + let msg = + Message + User + ( TextBlock "Analyze this:" + NonEmpty.:| [ImageBlock $ ImageContent (ImageBase64 (Just "image/jpeg") "dGVzdA==") Nothing Nothing] + ) + Nothing + Nothing + Nothing + Map.empty + (O.Message _ txt imgs _ _ _) = toOllamaMessage msg + txt @?= "Analyze this:" + case imgs of + Just [Base64Image b64] -> b64 @?= "dGVzdA==" + _ -> assertFailure "Expected image block conversion" + ] + ]