packages feed

langchain-hs (empty) → 0.0.1.0

raw patch · 49 files changed

+7483/−0 lines, 49 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, directory, filepath, http-conduit, http-types, langchain-hs, ollama-haskell, pdf-toolbox-document, scalpel, tasty, tasty-hunit, temporary, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `langchain-haskell`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,88 @@+# 🦜️🔗LangChain Haskell++⚡ Building applications with LLMs through composability in Haskell! ⚡++## Introduction++LangChain Haskell is a robust port of the original [LangChain](https://github.com/langchain-ai/langchain) library, bringing its powerful natural language processing capabilities to the Haskell ecosystem. This library enables developers to build applications powered by large language models (LLMs) with ease and flexibility.++## Features++- **LLM Integration**: Seamlessly interact with various language models, including OpenAI's GPT series and others.+- **Prompt Templates**: Create and manage dynamic prompts for different tasks.+- **Memory Management**: Implement conversational memory to maintain context across interactions.+- **Agents and Tools**: Develop agents that can utilize tools to perform complex tasks.+- **Document Loaders**: Load and process documents from various sources for use in your applications.++## Current Supported Providers++  - Ollama+  - More to come...++## Installation++To use LangChain Haskell in your project, add it to your package dependencies. +If you're using Stack, include it in your `package.yaml`:++```yaml+dependencies:+  - base >= 4.7 && < 5+  - langchain-hs+```+Then, run the build command for your respective build tool to fetch and compile the dependency.++## Quickstart++Here's a simple example demonstrating how to use LangChain Haskell to interact with an LLM:++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Langchain.LLM.Ollama+import Langchain.LLM.Core+import Langchain.PromptTemplate+import Langchain.Callback+import qualified Data.Map.Strict as Map+import qualified Data.Text as T++main :: IO ()+main = do +  let ollamaLLM = Ollama "llama3.2" [stdOutCallback]+      prompt = PromptTemplate "Translate the following English text to French: {text}"+      input = Map.fromList [("text", "Hello, how are you?")]+      +  case renderPrompt prompt input of+    Left e -> putStrLn $ "Error: " ++ e+    Right renderedPrompt -> do+      eRes <- generate ollamaLLM renderedPrompt Nothing+      case eRes of+        Left err -> putStrLn $ "Error: " ++ err+        Right response -> putStrLn $ "Translation: " ++ (T.unpack response)+```++## Documentation++Documentation will soon be available on hackage.++## Examples++Explore the `examples` directory in the repository for more use cases, including:++- **Conversational Agents**: Building chatbots that maintain context.+- **Document Q&A**: Answering questions based on the content of provided documents.+- **Tool Use**: Creating agents that can use external tools to fetch information or perform calculations.++## Contributing++Contributions are welcome! If you'd like to contribute, please fork the repository and submit a pull request. +For major changes, please open an issue first to discuss what you'd like to change.++## License++This project is licensed under the MIT License. See the [LICENSE](LICENSE) file for details.++## Acknowledgements++This project is inspired by and builds upon the original [LangChain](https://github.com/langchain-ai/langchain) library and its various ports in other programming languages. +Special thanks to the developers of those projects for their foundational work.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ langchain-hs.cabal view
@@ -0,0 +1,117 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name:           langchain-hs+version:        0.0.1.0+synopsis:       Haskell implementation of Langchain+description:    Build LLM-powered applications in Haskell.+category:       Web+homepage:       https://github.com/tusharad/langchain-hs#readme+bug-reports:    https://github.com/tusharad/langchain-hs/issues+author:         tushar+maintainer:     tusharadhatrao@gmail.com+copyright:      2025 tushar+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/tusharad/langchain-hs++library+  exposed-modules:+      Langchain.Agents.Core+      Langchain.Agents.React+      Langchain.Callback+      Langchain.DocumentLoader.Core+      Langchain.DocumentLoader.FileLoader+      Langchain.DocumentLoader.PdfLoader+      Langchain.Embeddings.Core+      Langchain.Embeddings.Ollama+      Langchain.LLM.Core+      Langchain.LLM.Ollama+      Langchain.LLM.OpenAI+      Langchain.Memory.Core+      Langchain.OutputParser.Core+      Langchain.PromptTemplate+      Langchain.Retriever.Core+      Langchain.Retriever.MultiQueryRetriever+      Langchain.Runnable.Chain+      Langchain.Runnable.ConversationChain+      Langchain.Runnable.Core+      Langchain.Runnable.Utils+      Langchain.TextSplitter.Character+      Langchain.Tool.Core+      Langchain.Tool.WebScraper+      Langchain.Tool.WikipediaTool+      Langchain.VectorStore.Core+      Langchain.VectorStore.InMemory+  other-modules:+      Paths_langchain_hs+  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.*+    , base >=4.7 && <5+    , bytestring >=0.10+    , containers >=0.6 && <0.9+    , directory >=1.3.6 && <1.4+    , http-conduit ==2.*+    , http-types >=0.11 && <0.13+    , ollama-haskell+    , pdf-toolbox-document ==0.1.4+    , scalpel ==0.6.*+    , text ==2.*+  default-language: Haskell2010++test-suite langchain-hs-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Langchain.Agent.Core+      Test.Langchain.Agent.ReactAgent+      Test.Langchain.DocumentLoader.Core+      Test.Langchain.Embeddings.Core+      Test.Langchain.LLM.Core+      Test.Langchain.LLM.Ollama+      Test.Langchain.Memory.Core+      Test.Langchain.OutputParser.Core+      Test.Langchain.PromptTemplate+      Test.Langchain.Retriever.Core+      Test.Langchain.Runnable.Chains+      Test.Langchain.Runnable.ConversationChains+      Test.Langchain.Runnable.Core+      Test.Langchain.Runnable.Utils+      Test.Langchain.TextSplitter.Character+      Test.Langchain.Tool.Core+      Test.Langchain.VectorStore.Core+      Paths_langchain_hs+  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 ==2.*+    , base >=4.7 && <5+    , bytestring >=0.10+    , containers >=0.6 && <0.9+    , directory >=1.3.6 && <1.4+    , filepath+    , http-conduit ==2.*+    , http-types >=0.11 && <0.13+    , langchain-hs+    , ollama-haskell+    , pdf-toolbox-document ==0.1.4+    , scalpel ==0.6.*+    , tasty+    , tasty-hunit+    , temporary+    , text+  default-language: Haskell2010
+ src/Langchain/Agents/Core.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Agents.Core+Description : Core implementation of LangChain agents+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>++Agents use LLMs as reasoning engines to determine actions dynamically+This module implements the core agent execution loop and interfaces,+supporting tool interaction and memory management.++Example agent execution flow:++> executor <- AgentExecutor+>   { executor = myAgent+>   , executorMemory = emptyMemory+>   , maxIterations = 5+>   , returnIntermediateSteps = True+>   }+> result <- runAgentExecutor executor "Explain quantum computing"+-}+module Langchain.Agents.Core+  ( AgentAction (..)+  , AgentFinish (..)+  , AgentStep (..)+  , Agent (..)+  , AnyTool (..)+  , AgentState (..)+  , AgentExecutor (..)+  , runAgent+  , runAgentLoop+  , runAgentExecutor+  , executeTool+  , runSingleStep+  , customAnyTool+  ) where++import Control.Exception (SomeException, try)+import Data.List (find)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import Langchain.LLM.Core (Message (Message), Role (..), defaultMessageData)+import Langchain.Memory.Core (BaseMemory (..))+import Langchain.PromptTemplate (PromptTemplate)+import qualified Langchain.Runnable.Core as Run+import Langchain.Tool.Core (Tool (..))++{- |+Represents an action to be taken by the agent+-}+data AgentAction = AgentAction+  { actionToolName :: Text+  -- ^ Tool name+  , actionInput :: Text+  -- ^ Input+  , actionLog :: Text+  -- ^ Execution log+  }+  deriving (Eq, Show)++-- | Represents that agent has finished work with final value+data AgentFinish = AgentFinish+  { returnValues :: Map.Map Text Text +  , finishLog :: Text+  }+  deriving (Show, Eq)++-- | Type that will be return from LLM +-- Could be either Continue, making another call to LLM or Finish with final value+data AgentStep+  = Continue AgentAction+  | Finish AgentFinish+  deriving (Eq, Show)++-- | Type for maintaining state of the agent +data (BaseMemory m) => AgentState m = AgentState+  { agentMemory :: m -- ^ Memory for storing chat history+  , agentToolResults :: [(Text, Text)] -- ^ Tool results+  , agentSteps :: [AgentAction] -- ^ Agent steps happened so far+  }+  deriving (Eq, Show)++{- |+Dynamic tool wrapper allowing heterogeneous tool collections+Converts between Text and tool-specific input/output types.++Example usage:++> calculatorTool :: AnyTool+> calculatorTool = customAnyTool+>   Calculator+>   (\t -> read (T.unpack t) :: (Int, Int))+>   (T.pack . show)+-}+data AnyTool = forall a. Tool a => AnyTool+  { anyTool :: a+  , textToInput :: Text -> Input a+  , outputToText :: Output a -> Text+  }++{- |+Core agent class defining required operations++* Plan next action based on state+* Provide prompt template+* Expose available tools+-}+class Agent a where+  planNextAction :: BaseMemory m => a -> AgentState m -> IO (Either String AgentStep)+  agentPrompt :: a -> IO PromptTemplate+  agentTools :: a -> IO [AnyTool]++{- |+Agent execution engine+-}+data AgentExecutor a m = AgentExecutor+  { executor :: a -- Agent instance+  , executorMemory :: m+  -- ^ Memory state+  , maxIterations :: Int+  -- ^ Iteration limits+  , returnIntermediateSteps :: Bool+  -- ^ Step tracking+  }+  deriving (Eq, Show)++{- |+Run the full agent execution loop+Handles:++1. Memory updates+2. Action planning+3. Tool execution+4. Iteration control++Example flow:++1. User input -> memory+2. Plan action -> execute tool+3. Store result -> memory+4. Repeat until finish++Throws errors for:++- Tool not found [[5]]+- Execution errors+- Iteration limits+-}+runAgent :: (Agent a, BaseMemory m) => a -> AgentState m -> Text -> IO (Either String AgentFinish)+runAgent agent initialState@AgentState {..} initialInput = do+  memWithInput <- addUserMessage agentMemory initialInput+  case memWithInput of+    Left err -> return $ Left err+    Right updatedMem ->+      let newState = initialState {agentMemory = updatedMem}+       in runAgentLoop agent newState 0 10++-- | Helper function for runAgent+runAgentLoop ::+  (Agent a, BaseMemory m) => a -> AgentState m -> Int -> Int -> IO (Either String AgentFinish)+runAgentLoop agent agentState@AgentState {..} currIter maxIter+  | currIter > maxIter = return $ Left "Max iterations excedded"+  | otherwise = do+      eStepResult <- runSingleStep agent agentState+      case eStepResult of+        Left err -> return $ Left err+        Right (Finish agentFinish) -> return $ Right agentFinish+        Right (Continue act@AgentAction {..}) -> do+          toolList <- agentTools agent+          toolResult <- executeTool toolList actionToolName actionInput+          case toolResult of+            Left err -> return $ Left err+            Right result -> do+              -- Add the tool result to memory as a tool message+              let toolMsg = Message Tool result defaultMessageData+              updatedMemResult <- addMessage agentMemory toolMsg+              case updatedMemResult of+                Left err -> return $ Left err+                Right updatedMem ->+                  let updatedState =+                        agentState+                          { agentMemory = updatedMem+                          , agentToolResults = agentToolResults ++ [(actionToolName, result)]+                          , agentSteps = agentSteps ++ [act]+                          }+                   in runAgentLoop agent updatedState (currIter + 1) maxIter++-- | Alias for planNextAction+runSingleStep :: (Agent a, BaseMemory m) => a -> AgentState m -> IO (Either String AgentStep)+runSingleStep = planNextAction++{- |+Execute a single tool call+Handles tool lookup and input/output conversion.++Example:++> tools = [calculatorTool, wikipediaTool]+> executeTool tools "calculator" "(5, 3)"+> -- Returns Right "8"+-}+executeTool :: [AnyTool] -> Text -> Text -> IO (Either String Text)+executeTool tools toolName_ input =+  case find (\(AnyTool t _ _) -> toolName t == toolName_) tools of+    Nothing -> return $ Left $ "Tool not found: " <> T.unpack toolName_+    Just (AnyTool {..}) -> do+      resultE <- try $ do+        let typedInput = textToInput input+        result <- runTool anyTool typedInput+        return $ outputToText result+      case resultE of+        Left ex -> return $ Left $ "Tool execution error: " <> show (ex :: SomeException)+        Right output -> return $ Right output++{- |+Helper for creating custom tool wrappers+Requires conversion functions between Text and tool-specific types.++Example:++> weatherTool = customAnyTool+>   WeatherAPI+>   parseLocation+>   formatWeatherResponse+-}+customAnyTool :: Tool a => a -> (Text -> Input a) -> (Output a -> Text) -> AnyTool+customAnyTool tool inputConv outputConv = AnyTool tool inputConv outputConv++-- | Similar to runAgent, but for AgentExecutor+runAgentExecutor ::+  (Agent a, BaseMemory m) => AgentExecutor a m -> Text -> IO (Either String (Maybe AgentFinish))+runAgentExecutor AgentExecutor {..} input = do+  let initialState =+        AgentState+          { agentMemory = executorMemory+          , agentToolResults = []+          , agentSteps = []+          }+  result <- runAgent executor initialState input+  case result of+    Left err -> return $ Left err+    Right a ->+      if returnIntermediateSteps+        then return $ Right $ Just a+        else return $ Right Nothing++{- |+Runnable instance for agent execution+Allows integration with LangChain workflows.++Example:++> response <- invoke myAgentExecutor "Solve 5+3"+> case response of+>   Right result -> print result+>   Left err -> print err+-}+instance (Agent a, BaseMemory m) => Run.Runnable (AgentExecutor a m) where+  type RunnableInput (AgentExecutor a m) = Text+  type RunnableOutput (AgentExecutor a m) = AgentFinish++  invoke AgentExecutor {..} input = do+    let initialState =+          AgentState+            { agentMemory = executorMemory+            , agentToolResults = []+            , agentSteps = []+            }+    runAgent executor initialState input
+ src/Langchain/Agents/React.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Agents.React+Description : Implementation of ReAct agent combining reasoning and action+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>++Implements the ReAct pattern where the agent alternates between:++1. Reasoning (generating thoughts)+2. Acting (executing tools)++Example agent interaction:++> agent <- createReactAgent llm [wikipediaTool, calculatorTool]+> result <- runAgentExecutor executor "What's the population of Paris?"+> -- Agent might:+> -- 1. Use Wikipedia tool to find current population data+> -- 2. Use calculator tool to verify numbers+> -- 3. Return final answer+-}+module Langchain.Agents.React+  ( ReactAgentOutputParser (..)+  , parseReactOutput+  , ReactAgent (..)+  , createReactAgent+  , formatToolDescriptions+  , formatToolNames+  , getLastUserInput+  ) where++import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import Langchain.Agents.Core+import Langchain.LLM.Core+import Langchain.Memory.Core+import Langchain.OutputParser.Core+import Langchain.PromptTemplate+import Langchain.Tool.Core++{- |+Output parser for ReAct agent responses+Handles two primary formats:++1. Final answers containing "Final Answer:"+2. Action requests with "Action:" and "Action Input:"++Example parsing:++> parseReactOutput "Final Answer: 42"+> -- Right (Finish ...)+>+> parseReactOutput "Action: calculator\nAction Input: 5+3"+> -- Right (Continue ...)+-}+newtype ReactAgentOutputParser = ReactAgentOutputParser AgentStep++instance OutputParser ReactAgentOutputParser where+  parse = parseReactOutput++-- | Parses the output from a React agent+parseReactOutput :: Text -> Either String ReactAgentOutputParser+parseReactOutput text+  | T.isInfixOf "Final Answer:" text =+      -- Extract the final answer+      let answer = extractAfter "Final Answer:" text+       in Right $+            ReactAgentOutputParser $+              Finish $+                AgentFinish+                  { returnValues = Map.singleton "output" answer+                  , finishLog = text+                  }+  | T.isInfixOf "Action:" text && T.isInfixOf "Action Input:" text =+      -- Extract action and action input+      let actionName = extractAfter "Action:" $ T.takeWhile (/= '\n') $ T.dropWhile (/= 'A') text+          actionInput_ =+            extractAfter "Action Input:" $ T.takeWhile (/= '\n') $ snd $ T.breakOn "Action Input:" text+       in Right $+            ReactAgentOutputParser $+              Continue $+                AgentAction+                  { actionToolName = T.strip actionName+                  , actionInput = T.strip actionInput_+                  , actionLog = text+                  }+  | otherwise = Left $ "Could not parse agent output: " <> T.unpack text++{- |+Core ReAct agent configuration.+Contains:++- LLM for reasoning+- Available tools+- Prompt template for interaction++Example creation:++> agent <- createReactAgent+>   openAIGPT+>   [ AnyTool wikipediaTool+>   , AnyTool calculatorTool+>   ]+-}+data (LLM llm) => ReactAgent llm = ReactAgent+  { reactLLM :: llm+  , reactTools :: [AnyTool]+  , reactPromptTemplate :: PromptTemplate+  }++-- Helper function to extract text after a marker+extractAfter :: Text -> Text -> Text+extractAfter marker text =+  let afterMarker = snd $ T.breakOn marker text+   in if T.null afterMarker+        then ""+        else T.strip $ T.dropWhile (/= ':') afterMarker++{- |+Creates a ReAct agent with standard prompt structure+The prompt instructs the LLM to:++1. List available tools+2. Follow thought-action-observation pattern+3. Provide final answers++Example prompt excerpt:++> "Use the following format:+> Thought: ...+> Action: [tool_name]+> Action Input: ..."+-}+createReactAgent ::+  (LLM llm) =>+  llm ->+  [AnyTool] ->+  IO (Either String (ReactAgent llm))+createReactAgent llm tools = do+  let reactPrompt =+        PromptTemplate $+          T.unlines+            [ "You are an AI assistant designed to help with tasks."+            , "You have access to the following tools:"+            , "{tools_description}"+            , ""+            , "Use the following format:"+            , ""+            , "Thought: you should always think about what to do"+            , "Action: the action to take, should be one of [{tool_names}]"+            , "Action Input: the input to the action"+            , "Observation: the result of the action"+            , "... (this Thought/Action/Action Input/Observation can repeat N times)"+            , "Thought: I now know the final answer"+            , "Final Answer: the final answer to the original input question"+            ]+  return $+    Right $+      ReactAgent+        { reactLLM = llm+        , reactTools = tools+        , reactPromptTemplate = reactPrompt+        }++instance (LLM llm) => Agent (ReactAgent llm) where+  -- \|+  --  Core reasoning loop implementing ReAct pattern+  --+  --  1. Retrieve chat history+  --  2. Format tool information+  --  3. Construct reasoning prompt+  --  4. Execute LLM call+  --  5. Parse response into action/answer+  --+  --  Uses depth-first planning with backtracking+  --+  planNextAction ReactAgent {..} state = do+    let mem = agentMemory state+    msgResult <- messages mem+    case msgResult of+      Left err -> return $ Left err+      Right msgs -> do+        -- Format the tools descriptions+        let toolDescs = formatToolDescriptions reactTools+            userQuery = getLastUserInput msgs+        -- Build the prompt variables+        let promptVars =+              Map.fromList+                [ ("tools_description", toolDescs)+                , ("tool_names", formatToolNames reactTools)+                ]++        -- Render the prompt+        case renderPrompt reactPromptTemplate promptVars of+          Left err -> return $ Left err+          Right renderedPrompt -> do+            -- Call the LLM+            let m =+                  ( msgs+                      `NE.append` NE.fromList+                        [ (Message System renderedPrompt defaultMessageData)+                        , (Message User userQuery defaultMessageData)+                        ]+                  )+            response <-+              chat+                reactLLM+                m+                Nothing+            case response of+              Left err -> return $ Left err+              Right llmOutput -> do+                -- Parse the output+                case parse llmOutput of+                  Left err -> return $ Left $ "Failed to parse LLM output: " <> err+                  Right (ReactAgentOutputParser step) -> return $ Right step++  agentPrompt ReactAgent {..} = pure reactPromptTemplate+  agentTools ReactAgent {..} = pure reactTools++{- |+Formats tool descriptions for LLM consumption+Creates a list like:++> "Tool: wikipedia+>  Description: Search Wikipedia..."+-}+formatToolDescriptions :: [AnyTool] -> Text+formatToolDescriptions tools = T.intercalate "\n\n" $ map formatTool tools+  where+    formatTool (AnyTool tool _ _) =+      T.concat ["Tool: ", toolName tool, "\nDescription: ", toolDescription tool]++{- |+Creates comma-separated tool names for prompt inclusion+Example output: "wikipedia, calculator, weather"+-}+formatToolNames :: [AnyTool] -> Text+formatToolNames tools = T.intercalate ", " $ map (\(AnyTool tool _ _) -> toolName tool) tools++{- |+Extracts latest user query from chat history+Handles cases where:++- Multiple user messages exist+- No user input found+-}+getLastUserInput :: ChatMessage -> Text+getLastUserInput msgs =+  let userMsgs = filter (\m -> role m == User) $ NE.toList msgs+   in if null userMsgs+        then ""+        else content $ last userMsgs
+ src/Langchain/Callback.hs view
@@ -0,0 +1,87 @@+{- |+Module:      Langchain.Callback+Copyright:   (c) 2025 Tushar Adhatrao+License:     MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability:   experimental++This module provides a callback system for Langchain's language model operations.+Callbacks allow users to perform actions at different stages of an LLM operation,+such as when it starts, completes, or encounters an error. This is useful for+logging, monitoring, or integrating with external systems.++The callback system is inspired by the Langchain Python library's callback+functionality: [Langchain Callbacks](https://python.langchain.com/docs/concepts/callbacks/).++== Examples++See the documentation for 'stdOutCallback' for a basic example, or check the+examples for 'generate', 'chat', and 'stream' in the 'Langchain.LLM.Ollama' module+for practical usage in LLM operations.+-}+module Langchain.Callback+  ( -- * Event Types+    Event (..)++    -- * Callback Interface+  , Callback++    -- * Standard Implementations+  , stdOutCallback+  ) where++{- | Represents different events that can occur during a language model operation.+These events can be used to trigger callbacks at various stages.+-}+data Event+  = -- | Indicates the start of an LLM operation, such as generating text or chatting.+    LLMStart+  | -- | Indicates the successful completion of an LLM operation.+    LLMEnd+  | -- | Indicates an error occurred during the LLM operation, with the error message.+    LLMError String+  deriving (Show, Eq)++{- | A callback is a function that takes an 'Event' and performs some IO action.+This allows users to react to different stages of LLM operations, such as logging+or updating a UI.++=== Examples++To create a custom callback that logs events to a file:++@+import System.IO+myCallback :: Callback+myCallback event = do+  handle <- openFile "llm_log.txt" AppendMode+  case event of+    LLMStart -> hPutStrLn handle "LLM operation started"+    LLMEnd -> hPutStrLn handle "LLM operation completed"+    LLMError err -> hPutStrLn handle $ "LLM error: " ++ err+  hClose handle+@+-}+type Callback = Event -> IO ()++{- | A standard callback that prints event messages to the standard output.+This is useful for simple debugging or monitoring of LLM operations.++=== Examples++Using 'stdOutCallback' in an LLM operation:++@+let callbacks = [stdOutCallback]+result <- generate (Ollama "llama3.2:latest" callbacks) "What is 2+2?" Nothing+-- Output will include:+-- Model operation started+-- Model completed with+-- (depending on success or error)+@+-}+stdOutCallback :: Callback+stdOutCallback event = case event of+  LLMStart -> putStrLn "Model operation started"+  LLMEnd -> putStrLn $ "Model completed with"+  LLMError err -> putStrLn $ "Error occurred: " ++ err
+ src/Langchain/DocumentLoader/Core.hs view
@@ -0,0 +1,139 @@+{- |+Module      : Langchain.DocumentLoader.Core+Description : Core document loading functionality for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Implementation of LangChain's document loading abstraction, providing:++- Document representation with content and metadata+- Typeclass for loading/splitting documents from various sources+- Integration with text splitting capabilities++For more information on document loader in the original Langchain library, see:+https://python.langchain.com/docs/concepts/document_loaders/++Example usage:++@+-- Create a document+doc :: Document+doc = Document "Sample content" (fromList [("source", String "example.txt")])++-- Hypothetical file loader instance+data FileLoader = FileLoader FilePath++instance BaseLoader FileLoader where+  load (FileLoader path) = do+    content <- readFile path+    return $ Right [Document content (fromList [("source", String (T.pack path))])]+@++Test case patterns:++>>> mempty :: Document+Document {pageContent = "", metadata = fromList []}++>>> doc1 = Document "Hello" (fromList [("a", Number 1)])+>>> doc2 = Document " World" (fromList [("b", Bool True)])+>>> doc1 <> doc2+Document {pageContent = "Hello World", metadata = fromList [("a", Number 1), ("b", Bool True)]}+-}+module Langchain.DocumentLoader.Core+  ( -- * Document Representation+    Document (..)++    -- * Loading Interface+  , BaseLoader (..)+  ) where++import Data.Aeson+import Data.Map (Map, empty)+import Data.Text (Text)++{- | Document container with content and metadata.+Used for storing loaded data and associated metadata like source URLs or page numbers.++Example:++>>> Document "Hello World" (fromList [("source", String "example.txt")])+Document {pageContent = "Hello World", metadata = fromList [("source",String "example.txt")]}+-}+data Document = Document+  { pageContent :: Text+  -- ^ The text content of the document+  , metadata :: Map Text Value+  -- ^ Additional metadata (e.g., source, page number)+  }+  deriving (Show, Eq)++{- | Semigroup instance combines both content and metadata++>>> let doc1 = Document "A" (fromList [("x", Number 1)])+>>> let doc2 = Document "B" (fromList [("y", Bool True)])+>>> doc1 <> doc2+Document {pageContent = "AB", metadata = fromList [("x", Number 1), ("y", Bool True)]}+-}+instance Semigroup Document where+  doc1 <> doc2 =+    Document+      (pageContent doc1 <> pageContent doc2)+      (metadata doc1 <> metadata doc2)++{- | Monoid instance provides empty document:++>>> mempty :: Document+Document {pageContent = "", metadata = fromList []}+-}+instance Monoid Document where+  mempty = Document mempty empty++{- | Typeclass for document loading implementations.+Implementations should define how to:++1. Load full documents with 'load'+2. Load and split content with 'loadAndSplit'++Example instance for text files:++@+instance BaseLoader FilePath where+  load path = do+    content <- readFile path+    return $ Right [Document content (fromList [("source", String (T.pack path))])]++  loadAndSplit path = do+    content <- readFile path+    return $ Right (splitText defaultCharacterSplitterOps content)+@+-}+class BaseLoader m where+  -- | Load all documents from the source.+  load :: m -> IO (Either String [Document])++  -- | Load all the document and split them using recursiveCharacterSpliter+  loadAndSplit :: m -> IO (Either String [Text])++{- $examples+Key test case demonstrations:++1. Metadata merging+   >>> let doc1 = Document "A" (fromList [("x", Number 1)])+   >>> let doc2 = Document "B" (fromList [("y", Bool True)])+   >>> metadata (doc1 <> doc2)+   fromList [("x", Number 1), ("y", Bool True)]++2. File loading error handling+   >>> load (FileLoader "non-existent.txt")+   Left "File not found: non-existent.txt"++3. Content splitting+   >>> loadAndSplit (FileLoader "test.txt")+   Right ["Paragraph 1", "Paragraph 2"]+-}++--  TODO: Implement lazy versions of Document and load.+-- Lazily load documents from the source.+-- lazyLoad :: m -> IO (Either String [Document])
+ src/Langchain/DocumentLoader/FileLoader.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Langchain.DocumentLoader.FileLoader+Description : File loading implementation for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++File-based document loader implementation following LangChain's document loading patterns+Integrates with the core document splitting functionality for processing text files.++Example usage:++@+-- Load a document from file+loader = FileLoader "data.txt"+docs <- load loader+-- Right [Document {pageContent = "File content", metadata = ...}]++-- Load and split document content+chunks <- loadAndSplit loader+-- Right ["First paragraph", "Second paragraph", ...]+@+-}+module Langchain.DocumentLoader.FileLoader+  ( FileLoader (..)+  ) where++import Data.Aeson+import Data.Map (fromList)+import Data.Text (pack)+import Langchain.DocumentLoader.Core+import Langchain.TextSplitter.Character+import System.Directory (doesFileExist)++{- | File loader configuration+Specifies the file path to load documents from.++Example:++>>> FileLoader "docs/example.txt"+FileLoader "docs/example.txt"+-}+data FileLoader = FileLoader FilePath++instance BaseLoader FileLoader where+  -- \| Load document with file source metadata+  --+  --  Example:+  +  --  >>> load (FileLoader "test.txt")+  --  Right [Document {pageContent = "Test content", metadata = fromList [("source", "test.txt")]}]+  --+  load (FileLoader path) = do+    exists <- doesFileExist path+    if exists+      then do+        content <- readFile path+        let meta = fromList [("source", String $ pack path)]+        return $ Right [Document (pack content) meta]+      else+        return $ Left $ "File not found: " ++ path++  -- \| Load and split content using default character splitter+  --+  --  Example:+  +  --  >>> loadAndSplit (FileLoader "split.txt")+  --  Right ["Paragraph 1", "Paragraph 2", ...]+  --+  loadAndSplit (FileLoader path) = do+    exists <- doesFileExist path+    if exists+      then do+        content <- readFile path+        return $ Right $ splitText defaultCharacterSplitterOps (pack content)+      else+        return $ Left $ "File not found: " ++ path++{- $examples+Test case patterns:+1. Successful load with metadata+   >>> withTestFile "Content" $ \path -> load (FileLoader path)+   Right [Document {pageContent = "Content", metadata = ...}]++2. Error handling for missing files+   >>> load (FileLoader "missing.txt")+   Left "File not found: missing.txt"++3. Content splitting with default parameters+   >>> withTestFile "A\n\nB\n\nC" $ \path -> loadAndSplit (FileLoader path)+   Right ["A", "B", "C"]+-}
+ src/Langchain/DocumentLoader/PdfLoader.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Langchain.DocumentLoader.PdfLoader+Description : A PDF loader that extracts documents from PDF files.+Copyright   : (C) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++This module provides a loader for PDF files by implementing the+'BaseLoader' interface from "Langchain.DocumentLoader.Core". It uses+the 'Pdf.Document' library to open a PDF and extract its content, turning+each page into a 'Document'. Additionally, it provides a method to load the+raw content of the file and split it using a recursive character splitter.+-}+module Langchain.DocumentLoader.PdfLoader+  ( PdfLoader (..)+  ) where++import Data.Aeson+import Data.Map (fromList)+import Data.Text (pack)+import Langchain.DocumentLoader.Core+import Langchain.TextSplitter.Character+import Pdf.Document hiding (Document)+import System.Directory (doesFileExist)++-- TODO: Need some error handling for this function++{- |+An internal function+Reads a PDF file and extracts a list of 'Document's, one per page.++This function opens the PDF file at the specified 'FilePath' and uses+the Pdf.Document library to extract the text from each page. Each page's+content is wrapped in a 'Document' along with metadata indicating the page number.++Note: This function currently has minimal error handling. Improvements may be+required to properly handle various PDF parsing errors.++@param fPath The file path to the PDF file.+@return An IO action yielding a list of 'Document's extracted from the PDF.+-}+readPdf :: FilePath -> IO [Document]+readPdf fPath = do+  withPdfFile fPath $ \pdf -> do+    doc <- document pdf+    catalog <- documentCatalog doc+    rootNode <- catalogPageNode catalog+    count <- pageNodeNKids rootNode+    textList <- sequence [pageExtractText =<< pageNodePageByNum rootNode i | i <- [0 .. count - 1]]+    pure+      $ map+        ( \(content, pageNum) ->+            Document+              { pageContent = content+              , metadata = fromList [("page number", Number $ fromIntegral pageNum)]+              }+        )+      $ zip textList [1 .. count]++{- |+A loader for PDF files.++The 'PdfLoader' data type encapsulates a 'FilePath' pointing to a PDF document.+It implements the 'BaseLoader' interface to provide methods for loading and+splitting PDF content.+-}+data PdfLoader = PdfLoader FilePath++instance BaseLoader PdfLoader where+  -- \|+  --  Loads all pages from the PDF file specified by the 'PdfLoader'.+  --+  --  This function first checks whether the file exists. If it does, it uses+  --  'readPdf' to extract the content of each page as a separate 'Document'. If+  --  the file is not found, an appropriate error message is returned.+  --+  --  @param loader A 'PdfLoader' containing the file path to the PDF.+  --  @return An IO action yielding either an error message or a list of 'Document's.+  --+  load (PdfLoader path) = do+    exists <- doesFileExist path+    if exists+      then do+        content <- readPdf path+        return $ Right content+      else+        return $ Left $ "File not found: " ++ path++  -- \|+  --  Loads the raw content of the PDF file and splits it using a recursive character splitter.+  --+  --  This method reads the entire file as text (without parsing its PDF structure) and applies+  --  'splitText' with default recursive character options to divide the text into chunks.+  --  This approach is useful when only a simple text split is required rather than structured+  --  page extraction.+  --+  --  @param loader A 'PdfLoader' containing the file path to the PDF.+  --  @return An IO action yielding either an error message or a list of text chunks.+  --+  loadAndSplit (PdfLoader path) = do+    exists <- doesFileExist path+    if exists+      then do+        content <- readFile path+        return $ Right $ splitText defaultCharacterSplitterOps (pack content)+      else+        return $ Left $ "File not found: " ++ path
+ src/Langchain/Embeddings/Core.hs view
@@ -0,0 +1,101 @@+{- |+Module      : Langchain.Embeddings.Core+Description : Embedding model interface for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Haskell implementation of LangChain's embedding model abstraction, providing:++- Document vectorization for semantic search+- Query embedding for similarity comparisons+- Integration with document loading pipelines++Example usage:++@+-- Hypothetical HuggingFace embedding instance+data HuggingFaceEmbeddings = HuggingFaceEmbeddings++instance Embeddings HuggingFaceEmbeddings where+  embedDocuments _ docs = do+    -- Convert documents to vectors using HuggingFace API+    return $ Right [[0.1, 0.3, ...], ...]++  embedQuery _ query = do+    -- Convert query to vector+    return $ Right [0.2, 0.4, ...]++-- Usage with loaded documents+docs <- load (FileLoader "data.txt")+case docs of+  Right documents -> do+    vectors <- embedDocuments HuggingFaceEmbeddings documents+    -- Use vectors for semantic search+  Left err -> print err+@+-}+module Langchain.Embeddings.Core+  ( -- * Embedding Interface+    Embeddings (..)+  ) where++import Data.Text (Text)+import Langchain.DocumentLoader.Core++{- | Typeclass for embedding models following LangChain's pattern.+Converts text/documents into numerical vectors for machine learning tasks.++Implementations should handle:++- Text preprocessing+- API calls to embedding services+- Error handling for failed requests+- Consistent vector dimensionality++Example instance for a test model:++@+data TestEmbeddings = TestEmbeddings++instance Embeddings TestEmbeddings where+  embedDocuments _ _ = return $ Right [[0.1, 0.2, 0.3]]+  embedQuery _ _ = return $ Right [0.4, 0.5, 0.6]+@+-}+class Embeddings m where+  -- | Convert documents to embedding vectors+  --+  --   Example:+  --+  --   >>> let doc = Document "Hello world" mempty+  --   >>> embedDocuments TestEmbeddings [doc]+  --   Right [[0.1, 0.2, 0.3]]+  embedDocuments :: m -> [Document] -> IO (Either String [[Float]])++  -- | Convert query text to embedding vector+  --+  --   Example:+  --+  --   >>> embedQuery TestEmbeddings "Search query"+  --   Right [0.4, 0.5, 0.6]+  embedQuery :: m -> Text -> IO (Either String [Float])++{- $examples+Test case patterns:++1. Document embedding+   >>> let docs = [Document "Test content" mempty]+   >>> embedDocuments TestEmbeddings docs+   Right [[0.1, 0.2, 0.3]]++2. Query embedding+   >>> embedQuery TestEmbeddings "Test query"+   Right [0.4, 0.5, 0.6]++3. Error handling+   >>> -- Simulate failed API call+   >>> embedQuery FaultyEmbeddings "Bad request"+   Left "API request failed"+-}
+ src/Langchain/Embeddings/Ollama.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Embeddings.Ollama+Description : Ollama integration for text embeddings in LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Ollama implementation of LangChain's embedding interface. Supports document and query+embedding generation through Ollama's API.++Example usage:++@+-- Create Ollama embeddings configuration+ollamaEmb = OllamaEmbeddings+  { model = "llama3"+  , defaultTruncate = Just True+  , defaultKeepAlive = Just "5m"+  }++-- Embed query text+queryVec <- embedQuery ollamaEmb "What is Haskell?"+-- Right [0.12, 0.34, ...]++-- Embed document collection+doc <- Document "Haskell is a functional programming language" mempty+docsVec <- embedDocuments ollamaEmb [doc]+-- Right [[0.56, 0.78, ...]]+@+-}+module Langchain.Embeddings.Ollama+  ( OllamaEmbeddings (..)+  ) where++import Data.Maybe+import Data.Ollama.Embeddings+import Data.Text (Text)+import Langchain.DocumentLoader.Core+import Langchain.Embeddings.Core++{- | Ollama-specific embedding configuration+Contains parameters for controlling:++- Model selection+- Input truncation behavior+- Model caching via keep-alive++Example configuration:++>>> OllamaEmbeddings "nomic-embed" (Just False) (Just "1h")+OllamaEmbeddings {model = "nomic-embed", ...}+-}+data OllamaEmbeddings = OllamaEmbeddings+  { model :: Text+  -- ^ The name of the Ollama model to use for embeddings+  , defaultTruncate :: Maybe Bool+  -- ^ Optional flag to truncate input if supported by the API+  , defaultKeepAlive :: Maybe Text+  -- ^ Keep model loaded for specified duration (e.g., "5m")+  }+  deriving (Show, Eq)++go :: EmbeddingResp -> Either String [Float]+go embResp =+  case listToMaybe (embedding_ embResp) of+    Nothing -> Left "Embeddings are empty"+    Just x -> Right x++{- | Ollama implementation of the 'Embeddings' interface [[6]].+Uses Ollama's embedding API for vector generation. Handles:+- Multiple document embedding via batch processing+- Query embedding for similarity searches+- Error propagation from API responses++Example instance usage:+@+-- Embed multiple documents+docs <- load (FileLoader "data.txt")+case docs of+  Right documents -> do+    vecs <- embedDocuments ollamaEmb documents+    -- Use vectors for semantic search+  Left err -> print err+@+-}+instance Embeddings OllamaEmbeddings where+  -- \| Document embedding implementation [[3]]:+  --  Processes each document individually through Ollama's API.+  --+  --  Example:+  --  >>> let doc = Document "Test content" mempty+  --  >>> embedDocuments ollamaEmb [doc]+  --  Right [[0.1, 0.2, ...], ...]+  --+  embedDocuments (OllamaEmbeddings {..}) docs = do+    -- For each input text, make an individual API call+    results <- mapM (\doc -> embeddingOps model (pageContent doc) defaultTruncate defaultKeepAlive) docs+    -- Combine the results, handling errors appropriately+    return $+      sequence results >>= \resps ->+        mapM go resps++  -- \| Query embedding implementation:+  --  Generates vector representation for search queries.+  --+  --  Example:+  --  >>> embedQuery ollamaEmb "Explain monads"+  --  Right [0.3, 0.4, ...]+  --+  embedQuery (OllamaEmbeddings {..}) query = do+    res <- embeddingOps model query defaultTruncate defaultKeepAlive+    case fmap embedding_ res of+      Left err -> pure $ Left err+      Right lst ->+        case listToMaybe lst of+          Nothing -> pure $ Left "Embeddings are empty"+          Just x -> pure $ Right x
+ src/Langchain/LLM/Core.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module:      Langchain.LLM.Core+Copyright:   (c) 2025 Tushar Adhatrao+License:     MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability:   experimental++This module provides the core types and typeclasses for the Langchain library in Haskell,+which is designed to facilitate interaction with language models (LLMs). It defines a standardized+interface that allows different LLM implementations to be used interchangeably, promoting code reuse+and modularity.++The main components include:++* The 'LLM' typeclass, which defines the interface for language models.+* Data types such as 'Params' for configuring model invocations, 'Message' for conversation messages,+  and 'StreamHandler' for handling streaming responses.+* Default values like 'defaultParams' and 'defaultMessageData' for convenience.++This module is intended to be used as the foundation for building applications that interact with LLMs,+providing a consistent API across different model implementations.+-}+module Langchain.LLM.Core+  ( -- * LLM Typeclass+    LLM (..)++    -- * Parameters+  , Message (..)+  , Role (..)+  , ChatMessage+  , MessageData (..)+  , Params (..)+  , StreamHandler (..)++    -- * Default Values+  , defaultParams+  , defaultMessageData+  ) where++import Data.Aeson+import Data.List.NonEmpty+import Data.Text (Text)+import GHC.Generics++{- | Parameters for configuring language model invocations.+These parameters control aspects such as randomness, length, and stopping conditions of generated output.+This type corresponds to standard parameters in Python Langchain:+https://python.langchain.com/docs/concepts/chat_models/#standard-parameters++Example usage:++@+myParams :: Params+myParams = defaultParams+  { temperature = Just 0.7+  , maxTokens = Just 100+  }+@+-}+data Params = Params+  { temperature :: Maybe Double+  -- ^ Sampling temperature. Higher values increase randomness (creativity), while lower values make output more focused.+  , maxTokens :: Maybe Integer+  , --- ^ Maximum number of tokens to generate in the response.+    topP :: Maybe Double+  -- ^ Nucleus sampling parameter. Considers tokens whose cumulative probability mass is at least @topP@.+  , n :: Maybe Int+  -- ^ Number of responses to generate (e.g., for sampling multiple outputs).+  , stop :: Maybe [Text]+  -- ^ Sequences where generation should stop (e.g., ["\n"] stops at newlines).+  }+  deriving (Show, Eq)++{- | Callbacks for handling streaming responses from a language model.+This allows real-time processing of tokens as they are generated and an action+upon completion.++@+printHandler :: StreamHandler+printHandler = StreamHandler+  { onToken = putStrLn . ("Token: " ++)+  , onComplete = putStrLn "Streaming complete"+  }+@+-}+data StreamHandler = StreamHandler+  { onToken :: Text -> IO ()+  -- ^ Action to perform for each token received+  , onComplete :: IO ()+  -- ^ Action to perform when streaming is complete+  }++-- | Enumeration of possible roles in a conversation.+data Role+  = -- | System role, typically for instructions or context+    System+  | -- | User role, for user inputs+    User+  | -- | Assistant role, for model responses+    Assistant+  | -- | Tool role, for tool outputs or interactions+    Tool+  deriving (Eq, Show, Generic, ToJSON, FromJSON)++{- | Represents a message in a conversation, including the sender's role, content,+and additional metadata.+https://python.langchain.com/docs/concepts/messages/++@+userMsg :: Message+userMsg = Message+  { role = User+  , content = "Explain functional programming"+  , messageData = defaultMessageData+  }+@+-}+data Message = Message+  { role :: Role+  -- ^ The role of the message sender+  , content :: Text+  -- ^ The content of the message+  , messageData :: MessageData+  -- ^ Additional data associated with the message+  }+  deriving (Eq, Show)++{- | Additional data for a message, such as a name or tool calls.+This type is designed for extensibility, allowing new fields to be added without+breaking changes. Use 'defaultMessageData' for typical usage.+-}+data MessageData = MessageData+  { name :: Maybe Text+  -- ^ Optional name associated with the message+  , toolCalls :: Maybe [Text]+  -- ^ Optional list of tool calls invoked by the message+  }+  deriving (Eq, Show)++-- | JSON serialization for MessageData.+instance ToJSON MessageData where+  toJSON MessageData {..} =+    object+      [ "name" .= name+      , "tool_calls" .= toolCalls+      -- Add more fields as they are added+      ]++-- | JSON deserialization for MessageData.+instance FromJSON MessageData where+  parseJSON = withObject "MessageData" $ \v ->+    MessageData+      <$> v .:? "name"+      <*> v .:? "tool_calls"++-- | Type alias for NonEmpty Message+type ChatMessage = NonEmpty Message++{- | Default message data with all fields set to Nothing.+Use this for standard messages without additional metadata+-}+defaultMessageData :: MessageData+defaultMessageData =+  MessageData+    { name = Nothing+    , toolCalls = Nothing+    }++{- | Typeclass defining the interface for language models.+This provides methods for invoking the model, chatting with it, and streaming+responses.++@+data TestLLM = TestLLM+  { responseText :: Text+  , shouldSucceed :: Bool+  }++instance LLM TestLLM where+  generate m _ _ = pure $ if shouldSucceed m+    then Right (responseText m)+    else Left "Test error"+@+++@+ollamaLLM = Ollama "llama3.2:latest" [stdOutCallback]+response <- generate ollamaLLM "What is Haskell?" Nothing+@+-}+class LLM m where+  -- | Invoke the language model with a single prompt.+  --        Suitable for simple queries; returns either an error or generated text.++  {- === Using 'generate'+  To invoke an LLM with a single prompt:+  +  @+  let myLLM = ... -- assume this is an instance of LLM+  result <- generate myLLM "What is the meaning of life?" Nothing+  case result of+    Left err -> putStrLn $ "Error: " ++ err+    Right response -> putStrLn response+  @++  -}+  generate :: m -- ^ The type of the language model instance.+    -> Text -- ^ The prompt to send to the model.+    -> Maybe Params -- ^ Optional configuration parameters.+    -> IO (Either String Text)++  -- | Chat with the language model using a sequence of messages.+  -- Suitable for multi-turn conversations; returns either an error or the response.+  --+  chat :: m -- ^ The type of the language model instance.+    -> ChatMessage -- ^ A non-empty list of messages to send to the model.+    -> Maybe Params -- ^ Optional configuration parameters.+    -> IO (Either String Text) -- ^ The result of the chat, either an error or the response text.++  -- | Stream responses from the language model for a sequence of messages.+  -- Uses callbacks to process tokens in real-time; returns either an error or unit.+  stream :: m -> ChatMessage -> StreamHandler -> Maybe Params -> IO (Either String ())++{- | Default parameters with all fields set to Nothing.+Use this when no specific configuration is needed for the language model.++>>> generate myLLM "Hello" (Just defaultParams)+-}+defaultParams :: Params+defaultParams =+  Params+    { temperature = Nothing+    , maxTokens = Nothing+    , topP = Nothing+    , n = Nothing+    , stop = Nothing+    }
+ src/Langchain/LLM/Ollama.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.LLM.Ollama+Description : Ollama integration for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Ollama implementation of LangChain's LLM interface , supporting:++- Text generation+- Chat interactions+- Streaming responses+- Callback integration++Example usage:++@+-- Create Ollama configuration+ollamaLLM = Ollama "llama3" [stdOutCallback]++-- Generate text+response <- generate ollamaLLM "Explain Haskell monads" Nothing+-- Right "Monads in Haskell..."++-- Chat interaction+let messages = UserMessage "What's the capital of France?" :| []+chatResponse <- chat ollamaLLM messages Nothing+-- Right "The capital of France is Paris."++-- Streaming+streamHandler = StreamHandler print (putStrLn "Done")+streamResult <- stream ollamaLLM messages streamHandler Nothing+@+-}+module Langchain.LLM.Ollama (Ollama (..)) where++import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Ollama.Chat as OllamaChat+import qualified Data.Ollama.Generate as OllamaGenerate+import Data.Text (Text)+import Langchain.Callback (Callback, Event (..))+import Langchain.LLM.Core+import qualified Langchain.Runnable.Core as Run++{- | Ollama LLM configuration+Contains:++- Model name (e.g., "llama3:latest")+- Callbacks for event tracking++Example:++>>> Ollama "nomic-embed" [logCallback]+Ollama "nomic-embed"+-}+data Ollama = Ollama+  { modelName :: Text+  -- ^ The name of the Ollama model+  , callbacks :: [Callback]+  -- ^ Event handlers for LLM operations+  }++instance Show Ollama where+  show (Ollama modelName _) = "Ollama " ++ show modelName++{- | Ollama implementation of the LLM typeclass+Note: Params argument is currently ignored (see TODOs).++Example instance usage:++@+-- Generate text with error handling+case generate ollamaLLM "Hello" Nothing of+  Left err -> putStrLn $ "Error: " ++ err+  Right res -> putStrLn res+@+-}+instance LLM Ollama where+  -- \| Generate text from a prompt+  --  Returns Left on API errors, Right on success.+  --+  --  Example:+  --  >>> generate (Ollama "llama3.2" []) "Hello" Nothing+  --  Right "Hello! How can I assist you today?"+  --+  generate (Ollama model cbs) prompt _ = do+    mapM_ (\cb -> cb LLMStart) cbs+    eRes <-+      OllamaGenerate.generate+        OllamaGenerate.defaultGenerateOps+          { OllamaGenerate.modelName = model+          , OllamaGenerate.prompt = prompt+          , OllamaGenerate.stream = Nothing+          }+    case eRes of+      Left err -> do+        mapM_ (\cb -> cb (LLMError err)) cbs+        return $ Left (show err)+      Right res -> do+        mapM_ (\cb -> cb LLMEnd) cbs+        return $ Right (OllamaGenerate.response_ res)++  -- \| Chat interaction with message history.+  --  Uses Ollama's chat API for multi-turn conversations.+  --+  --  Example:+  --  >>> let msgs = UserMessage "Hi" :| [AssistantMessage "Hello!"]+  --  >>> chat (Ollama "llama3" []) msgs Nothing+  --  Right "How are you today?"+  --+  chat (Ollama model cbs) messages _ = do+    mapM_ (\cb -> cb LLMStart) cbs+    eRes <-+      OllamaChat.chat+        OllamaChat.defaultChatOps+          { OllamaChat.chatModelName = model+          , OllamaChat.messages = toOllamaMessages messages+          , OllamaChat.stream = Nothing+          }+    case eRes of+      Left err -> do+        mapM_ (\cb -> cb (LLMError err)) cbs+        return $ Left (show err)+      Right res -> do+        mapM_ (\cb -> cb LLMEnd) cbs+        return $ Right (chatRespToText res)+    where+      chatRespToText resp = maybe "" OllamaChat.content (OllamaChat.message resp)++  -- \| Streaming response handling.+  --  Processes tokens in real-time via StreamHandler.+  --+  --  Example:+  --  >>> let handler = StreamHandler (putStr . ("Token: " ++)) (putStrLn "Complete")+  --  >>> stream (Ollama "llama3" []) messages handler Nothing+  --  Token: H Token: i Complete+  --+  stream (Ollama model_ cbs) messages StreamHandler {onToken, onComplete} _ = do+    mapM_ (\cb -> cb LLMStart) cbs+    eRes <-+      OllamaChat.chat+        OllamaChat.defaultChatOps+          { OllamaChat.chatModelName = model_+          , OllamaChat.messages = toOllamaMessages messages+          , OllamaChat.stream = Just (onToken . chatRespToText, onComplete)+          }+    case eRes of+      Left err -> do+        mapM_ (\cb -> cb (LLMError err)) cbs+        return $ Left (show err)+      Right _ -> do+        mapM_ (\cb -> cb LLMEnd) cbs+        return $ Right ()+    where+      chatRespToText OllamaChat.ChatResponse {..} = maybe "" OllamaChat.content message++{- | Convert LangChain messages to Ollama format.+Current limitations:+- Ignores 'messageData' field+- No tool call support (see TODO)++Example conversion:+>>> let msg = Message System "You are an assistant" defaultMessageData+>>> toOllamaMessages (msg :| [])+NonEmpty [OllamaChat.Message System "You are an assistant" Nothing Nothing]+-}+toOllamaMessages :: NonEmpty Message -> NonEmpty OllamaChat.Message+toOllamaMessages = NonEmpty.map $ \Message {..} ->+  OllamaChat.Message (toOllamaRole role) content Nothing Nothing+  where+    toOllamaRole User = OllamaChat.User+    toOllamaRole System = OllamaChat.System+    toOllamaRole Assistant = OllamaChat.Assistant+    toOllamaRole Tool = OllamaChat.Tool++instance Run.Runnable Ollama where+  type RunnableInput Ollama = ChatMessage+  type RunnableOutput Ollama = Text++  -- TODO: need to figure out a way to pass mbParams+  -- \| Runnable interface implementation.+  --  Currently delegates to 'chat' method with default parameters.+  --+  invoke model input = chat model input Nothing++{- $examples+Test case patterns:+1. Basic generation+   >>> generate (Ollama "test-model" []) "Hello" Nothing+   Right "Mock response"++2. Error handling+   >>> generate (Ollama "invalid-model" []) "Test" Nothing+   Left "API request failed"++3. Streaming interaction+   >>> let handler = StreamHandler print (pure ())+   >>> stream (Ollama "llama3" []) (UserMessage "Hi" :| []) handler Nothing+   Right ()+-}
+ src/Langchain/LLM/OpenAI.hs view
@@ -0,0 +1,870 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- This module is not tested since I don't have the OpenAI api key.++{- |+Module      : Langchain.LLM.OpenAI+Description : OpenAI integration for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++OpenAI implementation of LangChain's LLM interface. Not tested+-}+module Langchain.LLM.OpenAI+  ( OpenAI (..)+  -- * Data Types+  , ChatCompletionRequest (..)+  , ChatCompletionResponse (..)+  , Message (..)+  , Role (..)+  , MessageContent (..)+  , TextContent (..)+  , Tool_ (..)+  , Function_ (..)+  , ToolCall (..)+  , FunctionCall_ (..)+  , Usage (..)+  , Choice (..)+  , FinishReason (..)+  , LogProbs (..)+  , LogProbContent (..)+  , TopLogProb (..)+  , AudioConfig (..)+  , AudioResponse (..)+  , Modality (..)+  , ToolChoice (..)+  , SpecificToolChoice (..)+  , ReasoningEffort (..)+  , PredictionOutput (..)+  , PredictionContent (..)+  , ResponseFormat (..)+  , StreamOptions (..)+  , WebSearchOptions (..)+  , UserLocation (..)+  , ApproximateLocation (..)+  , CompletionTokensDetails (..)+  , PromptTokensDetails (..)+  -- * Functions+  , createChatCompletion+  , defaultChatCompletionRequest+  , defaultMessage+  ) where++import Data.Aeson+import qualified Data.List.NonEmpty as NE+import Data.Map (Map)+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import GHC.Generics+import Langchain.Callback (Callback)+import qualified Langchain.LLM.Core as LLM+import Network.HTTP.Simple+import Network.HTTP.Types.Status (statusCode)++{- | Represents different roles in a conversation+User: Human user input+Assistant: AI-generated response+System: System-level instructions+Developer: Special role for developer messages+Tool: Tool interaction messages+Function: Function call messages+-}+data Role+  = User+  | Assistant+  | System+  | Developer+  | Tool+  | Function+  deriving (Show, Eq, Generic)++instance ToJSON Role where+  toJSON User = String "user"+  toJSON Assistant = String "assistant"+  toJSON System = String "system"+  toJSON Developer = String "developer"+  toJSON Tool = String "tool"+  toJSON Function = String "function"++instance FromJSON Role where+  parseJSON (String "user") = return User+  parseJSON (String "assistant") = return Assistant+  parseJSON (String "system") = return System+  parseJSON (String "developer") = return Developer+  parseJSON (String "tool") = return Tool+  parseJSON (String "function") = return Function+  parseJSON invalid = fail $ "Invalid role: " ++ show invalid++data TextContent = TextContent+  { text_ :: Text+  , contentType :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON TextContent where+  toJSON TextContent {..} =+    object+      [ "text" .= text_+      , "type" .= contentType+      ]++instance FromJSON TextContent where+  parseJSON = withObject "TextContent" $ \v ->+    TextContent+      <$> v .: "text"+      <*> v .: "type"++data MessageContent+  = StringContent Text+  | ContentParts [TextContent]+  deriving (Show, Eq, Generic)++instance ToJSON MessageContent where+  toJSON (StringContent text) = String text+  toJSON (ContentParts parts) = toJSON parts++instance FromJSON MessageContent where+  parseJSON (String s) = return $ StringContent s+  parseJSON (Array arr) = ContentParts <$> parseJSON (Array arr)+  parseJSON invalid = fail $ "Invalid message content: " ++ show invalid++data Function_ = Function_+  { name :: Text+  , description :: Maybe Text+  , parameters :: Maybe Value+  , strict :: Maybe Bool+  }+  deriving (Show, Eq, Generic)++instance ToJSON Function_ where+  toJSON Function_ {..} =+    object $+      [ "name" .= name+      ]+        ++ maybe [] (\d -> ["description" .= d]) description+        ++ maybe [] (\p -> ["parameters" .= p]) parameters+        ++ maybe [] (\s -> ["strict" .= s]) strict++instance FromJSON Function_ where+  parseJSON = withObject "Function" $ \v ->+    Function_+      <$> v .: "name"+      <*> v .:? "description"+      <*> v .:? "parameters"+      <*> v .:? "strict"++data Tool_ = Tool_+  { toolType :: Text+  , function :: Function_+  }+  deriving (Show, Eq, Generic)++instance ToJSON Tool_ where+  toJSON Tool_ {..} =+    object+      [ "type" .= toolType+      , "function" .= function+      ]++instance FromJSON Tool_ where+  parseJSON = withObject "Tool" $ \v ->+    Tool_+      <$> v .: "type"+      <*> v .: "function"++data FunctionCall_ = FunctionCall_+  { name :: Text+  , arguments :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON FunctionCall_ where+  toJSON FunctionCall_ {..} =+    object+      [ "name" .= name+      , "arguments" .= arguments+      ]++instance FromJSON FunctionCall_ where+  parseJSON = withObject "FunctionCall" $ \v ->+    FunctionCall_+      <$> v .: "name"+      <*> v .: "arguments"++data ToolCall = ToolCall+  { id_ :: Text+  , toolType :: Text+  , function :: FunctionCall_+  }+  deriving (Show, Eq, Generic)++instance ToJSON ToolCall where+  toJSON ToolCall {..} =+    object+      [ "id" .= id_+      , "type" .= toolType+      , "function" .= function+      ]++instance FromJSON ToolCall where+  parseJSON = withObject "ToolCall" $ \v ->+    ToolCall+      <$> v .: "id"+      <*> v .: "type"+      <*> v .: "function"++{- | Configuration for audio processing+Specifies format and voice preferences for text-to-speech+-}+data AudioConfig = AudioConfig+  { format :: Text+  , voice :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON AudioConfig where+  toJSON AudioConfig {..} =+    object+      [ "format" .= format+      , "voice" .= voice+      ]++instance FromJSON AudioConfig where+  parseJSON = withObject "AudioConfig" $ \v ->+    AudioConfig+      <$> v .: "format"+      <*> v .: "voice"++data AudioResponse = AudioResponse+  { data_ :: Text+  , expiresAt :: Integer+  , id_ :: Text+  , transcript :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON AudioResponse where+  toJSON AudioResponse {..} =+    object+      [ "data" .= data_+      , "expires_at" .= expiresAt+      , "id" .= id_+      , "transcript" .= transcript+      ]++instance FromJSON AudioResponse where+  parseJSON = withObject "AudioResponse" $ \v ->+    AudioResponse+      <$> v .: "data"+      <*> v .: "expires_at"+      <*> v .: "id"+      <*> v .: "transcript"++{- | Represents a single message in a conversation+Contains role, content, and optional metadata like function calls or audio responses.+-}+data Message = Message+  { role :: Role+  , content :: Maybe MessageContent+  , name :: Maybe Text+  , functionCall :: Maybe FunctionCall_+  , toolCalls :: Maybe [ToolCall]+  , toolCallId :: Maybe Text+  , audio :: Maybe AudioResponse+  , refusal :: Maybe Text+  }+  deriving (Show, Eq, Generic)++defaultMessage :: Message+defaultMessage =+  Message+    { role = User+    , content = Nothing+    , name = Nothing+    , functionCall = Nothing+    , toolCalls = Nothing+    , toolCallId = Nothing+    , audio = Nothing+    , refusal = Nothing+    }++instance ToJSON Message where+  toJSON Message {..} =+    object $+      ["role" .= role]+        ++ maybe [] (\c -> ["content" .= c]) content+        ++ maybe [] (\n -> ["name" .= n]) name+        ++ maybe [] (\fc -> ["function_call" .= fc]) functionCall+        ++ maybe [] (\tc -> ["tool_calls" .= tc]) toolCalls+        ++ maybe [] (\tcid -> ["tool_call_id" .= tcid]) toolCallId+        ++ maybe [] (\a -> ["audio" .= a]) audio+        ++ maybe [] (\r -> ["refusal" .= r]) refusal++instance FromJSON Message where+  parseJSON = withObject "Message" $ \v ->+    Message+      <$> v .: "role"+      <*> v .:? "content"+      <*> v .:? "name"+      <*> v .:? "function_call"+      <*> v .:? "tool_calls"+      <*> v .:? "tool_call_id"+      <*> v .:? "audio"+      <*> v .:? "refusal"++data Modality = TextModality | AudioModality+  deriving (Show, Eq, Generic)++instance ToJSON Modality where+  toJSON TextModality = String "text"+  toJSON AudioModality = String "audio"++instance FromJSON Modality where+  parseJSON (String "text") = return TextModality+  parseJSON (String "audio") = return AudioModality+  parseJSON invalid = fail $ "Invalid modality: " ++ show invalid++data ToolChoice = None | Auto | Required | SpecificTool SpecificToolChoice+  deriving (Show, Eq, Generic)++instance ToJSON ToolChoice where+  toJSON None = String "none"+  toJSON Auto = String "auto"+  toJSON Required = String "required"+  toJSON (SpecificTool choice) = toJSON choice++instance FromJSON ToolChoice where+  parseJSON (String "none") = return None+  parseJSON (String "auto") = return Auto+  parseJSON (String "required") = return Required+  parseJSON o@(Object _) = SpecificTool <$> parseJSON o+  parseJSON invalid = fail $ "Invalid tool choice: " ++ show invalid++data SpecificToolChoice = SpecificToolChoice+  { toolType :: Text+  , function :: Value+  }+  deriving (Show, Eq, Generic)++instance ToJSON SpecificToolChoice where+  toJSON SpecificToolChoice {..} =+    object+      [ "type" .= toolType+      , "function" .= function+      ]++instance FromJSON SpecificToolChoice where+  parseJSON = withObject "SpecificToolChoice" $ \v ->+    SpecificToolChoice+      <$> v .: "type"+      <*> v .: "function"++data ReasoningEffort = Low | Medium | High+  deriving (Show, Eq, Generic)++instance ToJSON ReasoningEffort where+  toJSON Low = String "low"+  toJSON Medium = String "medium"+  toJSON High = String "high"++instance FromJSON ReasoningEffort where+  parseJSON (String "low") = return Low+  parseJSON (String "medium") = return Medium+  parseJSON (String "high") = return High+  parseJSON invalid = fail $ "Invalid reasoning effort: " ++ show invalid++data PredictionContent = PredictionContent+  { content :: MessageContent+  , contentType :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON PredictionContent where+  toJSON PredictionContent {..} =+    object+      [ "content" .= content+      , "type" .= contentType+      ]++instance FromJSON PredictionContent where+  parseJSON = withObject "PredictionContent" $ \v ->+    PredictionContent+      <$> v .: "content"+      <*> v .: "type"++data PredictionOutput = PredictionOutput+  { predictionType :: Text+  , content :: MessageContent+  }+  deriving (Show, Eq, Generic)++instance ToJSON PredictionOutput where+  toJSON PredictionOutput {..} =+    object+      [ "type" .= predictionType+      , "content" .= content+      ]++instance FromJSON PredictionOutput where+  parseJSON = withObject "PredictionOutput" $ \v ->+    PredictionOutput+      <$> v .: "type"+      <*> v .: "content"++data ResponseFormat = JsonObjectFormat | JsonSchemaFormat Value+  deriving (Show, Eq, Generic)++instance ToJSON ResponseFormat where+  toJSON JsonObjectFormat = object ["type" .= ("json_object" :: Text)]+  toJSON (JsonSchemaFormat schema) =+    object+      [ "type" .= ("json_schema" :: Text)+      , "json_schema" .= schema+      ]++instance FromJSON ResponseFormat where+  parseJSON = withObject "ResponseFormat" $ \v -> do+    formatType <- v .: "type"+    case formatType of+      String "json_object" -> return JsonObjectFormat+      String "json_schema" -> JsonSchemaFormat <$> v .: "json_schema"+      _ -> fail $ "Invalid response format type: " ++ show formatType++data StreamOptions = StreamOptions+  { includeUsage :: Bool+  }+  deriving (Show, Eq, Generic)++instance ToJSON StreamOptions where+  toJSON StreamOptions {..} =+    object+      [ "include_usage" .= includeUsage+      ]++instance FromJSON StreamOptions where+  parseJSON = withObject "StreamOptions" $ \v ->+    StreamOptions <$> v .: "include_usage"++data ApproximateLocation = ApproximateLocation+  { locationType :: Text+  }+  deriving (Show, Eq, Generic)++instance ToJSON ApproximateLocation where+  toJSON ApproximateLocation {..} =+    object+      [ "type" .= locationType+      ]++instance FromJSON ApproximateLocation where+  parseJSON = withObject "ApproximateLocation" $ \v ->+    ApproximateLocation <$> v .: "type"++data UserLocation = UserLocation+  { approximate :: ApproximateLocation+  }+  deriving (Show, Eq, Generic)++instance ToJSON UserLocation where+  toJSON UserLocation {..} =+    object+      [ "approximate" .= approximate+      ]++instance FromJSON UserLocation where+  parseJSON = withObject "UserLocation" $ \v ->+    UserLocation <$> v .: "approximate"++data WebSearchOptions = WebSearchOptions+  { searchContextSize :: Maybe Text+  , userLocation :: Maybe UserLocation+  }+  deriving (Show, Eq, Generic)++instance ToJSON WebSearchOptions where+  toJSON WebSearchOptions {..} =+    object $+      maybe [] (\s -> ["search_context_size" .= s]) searchContextSize+        ++ maybe [] (\l -> ["user_location" .= l]) userLocation++instance FromJSON WebSearchOptions where+  parseJSON = withObject "WebSearchOptions" $ \v ->+    WebSearchOptions+      <$> v .:? "search_context_size"+      <*> v .:? "user_location"++{- | Main request type for chat completions+Contains all parameters for configuring the OpenAI chat completion API call.+-}+data ChatCompletionRequest = ChatCompletionRequest+  { messages :: [Message]+  , model :: Text+  , frequencyPenalty :: Maybe Double+  , logitBias :: Maybe (Map Text Double)+  , logprobs :: Maybe Bool+  , maxCompletionTokens :: Maybe Int+  , maxTokens :: Maybe Int+  , metadata :: Maybe (Map Text Text)+  , modalities :: Maybe [Modality]+  , n :: Maybe Int+  , parallelToolCalls :: Maybe Bool+  , prediction :: Maybe PredictionOutput+  , presencePenalty :: Maybe Double+  , reasoningEffort :: Maybe ReasoningEffort+  , responseFormat :: Maybe ResponseFormat+  , seed :: Maybe Int+  , serviceTier :: Maybe Text+  , stop :: Maybe (Either Text [Text])+  , store :: Maybe Bool+  , stream :: Maybe Bool+  , streamOptions :: Maybe StreamOptions+  , temperature :: Maybe Double+  , toolChoice :: Maybe ToolChoice+  , tools :: Maybe [Tool_]+  , topLogprobs :: Maybe Int+  , topP :: Maybe Double+  , user :: Maybe Text+  , webSearchOptions :: Maybe WebSearchOptions+  , audio :: Maybe AudioConfig+  }+  deriving (Show, Eq, Generic)++instance ToJSON ChatCompletionRequest where+  toJSON ChatCompletionRequest {..} =+    object $+      [ "messages" .= messages+      , "model" .= model+      ]+        ++ maybe [] (\fp -> ["frequency_penalty" .= fp]) frequencyPenalty+        ++ maybe [] (\lb -> ["logit_bias" .= lb]) logitBias+        ++ maybe [] (\lp -> ["logprobs" .= lp]) logprobs+        ++ maybe [] (\mt -> ["max_completion_tokens" .= mt]) maxCompletionTokens+        ++ maybe [] (\mt -> ["max_tokens" .= mt]) maxTokens+        ++ maybe [] (\md -> ["metadata" .= md]) metadata+        ++ maybe [] (\m -> ["modalities" .= m]) modalities+        ++ maybe [] (\n' -> ["n" .= n']) n+        ++ maybe [] (\ptc -> ["parallel_tool_calls" .= ptc]) parallelToolCalls+        ++ maybe [] (\p -> ["prediction" .= p]) prediction+        ++ maybe [] (\pp -> ["presence_penalty" .= pp]) presencePenalty+        ++ maybe [] (\re -> ["reasoning_effort" .= re]) reasoningEffort+        ++ maybe [] (\rf -> ["response_format" .= rf]) responseFormat+        ++ maybe [] (\s -> ["seed" .= s]) seed+        ++ maybe [] (\st -> ["service_tier" .= st]) serviceTier+        ++ maybe [] (\s -> ["stop" .= s]) stop+        ++ maybe [] (\s -> ["store" .= s]) store+        ++ maybe [] (\s -> ["stream" .= s]) stream+        ++ maybe [] (\so -> ["stream_options" .= so]) streamOptions+        ++ maybe [] (\t -> ["temperature" .= t]) temperature+        ++ maybe [] (\tc -> ["tool_choice" .= tc]) toolChoice+        ++ maybe [] (\t -> ["tools" .= t]) tools+        ++ maybe [] (\tlp -> ["top_logprobs" .= tlp]) topLogprobs+        ++ maybe [] (\tp -> ["top_p" .= tp]) topP+        ++ maybe [] (\u -> ["user" .= u]) user+        ++ maybe [] (\wso -> ["web_search_options" .= wso]) webSearchOptions+        ++ maybe [] (\a -> ["audio" .= a]) audio++-- Response Types+data FinishReason = Stop | Length | ContentFilter | ToolCalls | FunctionCall+  deriving (Show, Eq, Generic)++instance FromJSON FinishReason where+  parseJSON (String "stop") = return Stop+  parseJSON (String "length") = return Length+  parseJSON (String "content_filter") = return ContentFilter+  parseJSON (String "tool_calls") = return ToolCalls+  parseJSON (String "function_call") = return FunctionCall+  parseJSON invalid = fail $ "Invalid finish reason: " ++ show invalid++data TopLogProb = TopLogProb+  { bytes :: Maybe [Int]+  , logprob :: Double+  , token :: Text+  }+  deriving (Show, Eq, Generic)++instance FromJSON TopLogProb where+  parseJSON = withObject "TopLogProb" $ \v ->+    TopLogProb+      <$> v .:? "bytes"+      <*> v .: "logprob"+      <*> v .: "token"++data LogProbContent = LogProbContent+  { bytes :: Maybe [Int]+  , logprob :: Double+  , token :: Text+  , topLogprobs :: [TopLogProb]+  }+  deriving (Show, Eq, Generic)++instance FromJSON LogProbContent where+  parseJSON = withObject "LogProbContent" $ \v ->+    LogProbContent+      <$> v .:? "bytes"+      <*> v .: "logprob"+      <*> v .: "token"+      <*> v .: "top_logprobs"++data LogProbs = LogProbs+  { content :: Maybe [LogProbContent]+  , refusal :: Maybe [LogProbContent]+  }+  deriving (Show, Eq, Generic)++instance FromJSON LogProbs where+  parseJSON = withObject "LogProbs" $ \v ->+    LogProbs+      <$> v .:? "content"+      <*> v .:? "refusal"++data CompletionTokensDetails = CompletionTokensDetails+  { acceptedPredictionTokens :: Int+  , audioTokens :: Int+  , reasoningTokens :: Int+  , rejectedPredictionTokens :: Int+  }+  deriving (Show, Eq, Generic)++instance FromJSON CompletionTokensDetails where+  parseJSON = withObject "CompletionTokensDetails" $ \v ->+    CompletionTokensDetails+      <$> v .: "accepted_prediction_tokens"+      <*> v .: "audio_tokens"+      <*> v .: "reasoning_tokens"+      <*> v .: "rejected_prediction_tokens"++data PromptTokensDetails = PromptTokensDetails+  { audioTokens :: Int+  , cachedTokens :: Int+  }+  deriving (Show, Eq, Generic)++instance FromJSON PromptTokensDetails where+  parseJSON = withObject "PromptTokensDetails" $ \v ->+    PromptTokensDetails+      <$> v .: "audio_tokens"+      <*> v .: "cached_tokens"++data Usage = Usage+  { completionTokens :: Int+  , promptTokens :: Int+  , totalTokens :: Int+  , completionTokensDetails :: Maybe CompletionTokensDetails+  , promptTokensDetails :: Maybe PromptTokensDetails+  }+  deriving (Show, Eq, Generic)++instance FromJSON Usage where+  parseJSON = withObject "Usage" $ \v ->+    Usage+      <$> v .: "completion_tokens"+      <*> v .: "prompt_tokens"+      <*> v .: "total_tokens"+      <*> v .:? "completion_tokens_details"+      <*> v .:? "prompt_tokens_details"++data Choice = Choice+  { finishReason :: FinishReason+  , index :: Int+  , logprobs :: Maybe LogProbs+  , message :: Message+  }+  deriving (Show, Eq, Generic)++instance FromJSON Choice where+  parseJSON = withObject "Choice" $ \v ->+    Choice+      <$> v .: "finish_reason"+      <*> v .: "index"+      <*> v .:? "logprobs"+      <*> v .: "message"++data ChatCompletionResponse = ChatCompletionResponse+  { choices :: [Choice]+  , created :: Integer+  , id_ :: Text+  , responseModel :: Text+  , object_ :: Text+  , serviceTier :: Maybe Text+  , systemFingerprint :: Text+  , usage :: Usage+  }+  deriving (Show, Eq, Generic)++instance FromJSON ChatCompletionResponse where+  parseJSON = withObject "ChatCompletionResponse" $ \v ->+    ChatCompletionResponse+      <$> v .: "choices"+      <*> v .: "created"+      <*> v .: "id"+      <*> v .: "model"+      <*> v .: "object"+      <*> v .:? "service_tier"+      <*> v .: "system_fingerprint"+      <*> v .: "usage"++{- | Default chat completion request+Uses "gpt-4o-mini-2024-07-18" as the default model. All other parameters are set to Nothing.+-}+defaultChatCompletionRequest :: ChatCompletionRequest+defaultChatCompletionRequest =+  ChatCompletionRequest+    { messages = []+    , model = "gpt-4o-mini-2024-07-18"+    , frequencyPenalty = Nothing+    , logitBias = Nothing+    , logprobs = Nothing+    , maxCompletionTokens = Nothing+    , maxTokens = Nothing+    , metadata = Nothing+    , modalities = Nothing+    , n = Nothing+    , parallelToolCalls = Nothing+    , prediction = Nothing+    , presencePenalty = Nothing+    , reasoningEffort = Nothing+    , responseFormat = Nothing+    , seed = Nothing+    , serviceTier = Nothing+    , stop = Nothing+    , store = Nothing+    , stream = Nothing+    , streamOptions = Nothing+    , temperature = Nothing+    , toolChoice = Nothing+    , tools = Nothing+    , topLogprobs = Nothing+    , topP = Nothing+    , user = Nothing+    , webSearchOptions = Nothing+    , audio = Nothing+    }++{- | Creates a chat completion request+Sends the request to OpenAI API and returns the parsed response.++Example usage:+@+response <- createChatCompletion "your-api-key" request+case response of+  Right res -> print (choices res)+  Left err -> putStrLn err+@+-}+createChatCompletion :: Text -> ChatCompletionRequest -> IO (Either String ChatCompletionResponse)+createChatCompletion apiKey r = do+  request_ <- parseRequest "https://api.openai.com/v1/chat/completions"+  let req =+        setRequestMethod "POST" $+          setRequestSecure True $+            setRequestHost "api.openai.com" $+              setRequestPath "/v1/chat/completions" $+                setRequestHeader "Content-Type" ["application/json"] $+                  setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] $+                    setRequestBodyJSON r $+                      request_++  response <- httpLBS req+  let status = statusCode $ getResponseStatus response+  if status >= 200 && status < 300+    then case eitherDecode (getResponseBody response) of+      Left err -> return $ Left $ "JSON parse error: " <> err+      Right completionResponse -> return $ Right completionResponse+    else return $ Left $ "API error: " <> show status <> " " <> show (getResponseBody response)++data OpenAI = OpenAI+  { apiKey :: Text+  , openAIModelName :: Text+  , callbacks :: [Callback]+  }++instance Show OpenAI where+  show OpenAI {..} = "OpenAI " ++ show openAIModelName++instance LLM.LLM OpenAI where+  generate OpenAI {..} prompt _ = do+    eRes <-+      createChatCompletion+        apiKey+        ( defaultChatCompletionRequest+            { model = openAIModelName+            , messages =+                [ Message+                    { role = User+                    , content = Just (StringContent prompt)+                    , name = Nothing+                    , functionCall = Nothing+                    , toolCalls = Nothing+                    , toolCallId = Nothing+                    , audio = Nothing+                    , refusal = Nothing+                    }+                ]+            }+        )+    case eRes of+      Left err -> return $ Left err+      Right r -> do+        case listToMaybe (choices r) of+          Nothing -> return $ Left "Did not received any response"+          Just resp ->+            let Message {..} = message resp+             in pure $+                  Right $+                    maybe+                      ""+                      ( \c -> case c of+                          StringContent t -> t+                          ContentParts _ -> ""+                      )+                      content+  chat OpenAI {..} msgs _ = do+    eRes <-+      createChatCompletion+        apiKey+        ( defaultChatCompletionRequest+            { model = openAIModelName+            , messages = toOpenAIMessages msgs+            }+        )+    case eRes of+      Left err -> return $ Left err+      Right r -> do+        case listToMaybe (choices r) of+          Nothing -> return $ Left "Did not received any response"+          Just resp ->+            let Message {..} = message resp+             in pure $+                  Right $+                    maybe+                      ""+                      ( \c -> case c of+                          StringContent t -> t+                          ContentParts _ -> ""+                      )+                      content++  stream _ _ _ _ = return $ Left "stream functionality for OpenAI is not supported yet"++toOpenAIMessages :: LLM.ChatMessage -> [Message]+toOpenAIMessages msgs = map go (NE.toList msgs)+  where+    toRole r = case r of+      LLM.System -> System+      LLM.User -> User+      LLM.Assistant -> Assistant+      LLM.Tool -> Tool++    go :: LLM.Message -> Message+    go msg =+      defaultMessage+        { role = toRole $ LLM.role msg+        , content = Just $ StringContent (LLM.content msg)+        }
+ src/Langchain/Memory/Core.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Memory.Core+Description : Memory management for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Implementation of LangChain's memory management patterns, providing:++- Chat history tracking with size limits+- Message addition/trimming strategies+- Integration with Runnable workflows++Example usage:++@+-- Create memory with 5-message window+memory = WindowBufferMemory 5 (initialChatMessage "You are an assistant")++-- Add user message+newMemory <- addUserMessage memory "Hello, world!"++-- Retrieve current messages+messages <- messages newMemory+-- Right [Message System "...", Message User "Hello, world!"]+@+-}+module Langchain.Memory.Core+  ( BaseMemory (..)+  , WindowBufferMemory (..)+  , trimChatMessage+  , addAndTrim+  , initialChatMessage+  ) where++import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import Langchain.LLM.Core (ChatMessage, Message (..), Role (..), defaultMessageData)+import Langchain.Runnable.Core++{- | Base typeclass for memory implementations+Defines standard operations for chat history management.++Example instance:++@+instance BaseMemory MyMemory where+  messages = ...+  addUserMessage = ...+@+-}+class BaseMemory m where+  -- | Retrieve current chat history+  messages :: m -> IO (Either String ChatMessage)++  -- | Add user message to history+  addUserMessage :: m -> Text -> IO (Either String m)++  -- | Add AI response to history+  addAiMessage :: m -> Text -> IO (Either String m)++  -- | Add generic message to history+  addMessage :: m -> Message -> IO (Either String m)++  -- | Reset memory to initial state+  clear :: m -> IO (Either String m)++{- | Sliding window memory implementation.+Stores chat history with maximum size limit.++Example:++>>> let mem = WindowBufferMemory 2 (NE.singleton (Message System "Sys" defaultMessageData))+>>> addMessage mem (Message User "Hello" defaultMessageData)+Right (WindowBufferMemory {maxWindowSize = 2, ...})+-}+data WindowBufferMemory = WindowBufferMemory+  { maxWindowSize :: Int+  -- ^ Maximum number of messages to retain+  , windowBufferMessages :: ChatMessage+  -- ^ Current message buffer [[9]]+  }+  deriving (Show, Eq)++instance BaseMemory WindowBufferMemory where+  -- \| Get current messages+  --+  --  Example:+  --+  --  >>> messages (WindowBufferMemory 5 initialMessages)+  --  Right initialMessages+  --+  messages WindowBufferMemory {..} = pure $ Right windowBufferMessages++  -- \| Add message with window trimming+  --+  --  Example:+  --+  --  >>> let mem = WindowBufferMemory 2 (NE.fromList [msg1])+  --  >>> addMessage mem msg2+  --  Right (WindowBufferMemory {windowBufferMessages = [msg1, msg2]})+  --+  --  >>> addMessage mem msg3+  --  Right (WindowBufferMemory {windowBufferMessages = [msg2, msg3]})+  --+  addMessage winBuffMem@WindowBufferMemory {..} msg =+    let currentLength = NE.length windowBufferMessages+     in if currentLength >= maxWindowSize+          then+            pure $+              Right $+                winBuffMem+                  { windowBufferMessages =+                      NE.fromList $ (NE.tail windowBufferMessages) ++ [msg]+                  }+          else+            pure $+              Right $+                winBuffMem+                  { windowBufferMessages =+                      windowBufferMessages `NE.append` NE.singleton msg+                  }++  -- \| Add user message+  --+  --  Example:+  --+  --  >>> addUserMessage mem "Hello"+  --  Right (WindowBufferMemory { ... })+  --+  addUserMessage winBuffMem uMsg =+    addMessage winBuffMem (Message User uMsg defaultMessageData)++  -- \| Add AI message+  --+  --  Example:+  --+  --  >>> addAiMessage mem "Response"+  --  Right (WindowBufferMemory { ... })+  --+  addAiMessage winBuffMem uMsg =+    addMessage winBuffMem (Message Assistant uMsg defaultMessageData)++  -- \| Reset to initial system message+  --+  --  Example:+  --+  --  >>> clear mem+  --  Right (WindowBufferMemory { windowBufferMessages = [systemMsg] })+  --+  clear winBuffMem =+    pure $+      Right $+        winBuffMem+          { windowBufferMessages =+              NE.singleton $ Message System "You are an AI model" defaultMessageData+          }++{- | Trim chat history to last n messages+Example:++>>> let msgs = NE.fromList [msg1, msg2, msg3]+>>> trimChatMessage 2 msgs+[msg2, msg3]+-}+trimChatMessage :: Int -> ChatMessage -> ChatMessage+trimChatMessage n msgs = NE.fromList $ drop (max 0 (NE.length msgs - n)) (NE.toList msgs)++{- | Add and maintain window size+Example:++>>> let msgs = NE.fromList [msg1]+>>> addAndTrim 2 msg2 msgs+[msg1, msg2]+-}+addAndTrim :: Int -> Message -> ChatMessage -> ChatMessage+addAndTrim n msg msgs = trimChatMessage n (msgs `NE.append` NE.singleton msg)++{- | Create initial chat history+Example:++>>> initialChatMessage "You are Qwen"+[Message System "You are Qwen"]+-}+initialChatMessage :: Text -> ChatMessage+initialChatMessage systemPrompt = NE.singleton $ Message System systemPrompt defaultMessageData++instance Runnable WindowBufferMemory where+  type RunnableInput WindowBufferMemory = Text+  type RunnableOutput WindowBufferMemory = WindowBufferMemory++  -- \| Runnable interface for user input+  --+  --  Example:+  --+  --  >>> invoke memory "Hello"+  --  Right (WindowBufferMemory { ... })+  --+  invoke memory input = addUserMessage memory input++{- $examples+Test case patterns:+1. Message trimming+   >>> let mem = WindowBufferMemory 2 [msg1, msg2]+   >>> addMessage mem msg3+   Right [msg2, msg3]++2. Initial state+   >>> messages (WindowBufferMemory 5 initialMessages)+   Right initialMessages++3. Runnable integration+   >>> run (WindowBufferMemory 5 initialMessages) "Hello"+   Right (WindowBufferMemory { ... })+-}
+ src/Langchain/OutputParser/Core.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module:      Langchain.OutputParser.Core+Copyright:   (c) 2025 Tushar Adhatrao+License:     MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability:   experimental++This module provides the core types and instances for output parsers in the Langchain Haskell port.+Output parsers are used to transform the raw output from language models into structured data formats,+making it easier to work with the results in downstream applications.++The 'OutputParser' typeclass defines the interface for parsing model output into specific types,+and this module provides instances for common data structures such as booleans, lists, and JSON objects.++For more information on output parsers in the original Langchain library, see:+https://python.langchain.com/docs/concepts/output_parsers/+-}+module Langchain.OutputParser.Core+  ( -- * Typeclass+    OutputParser (..)++    -- * Parsers+  , CommaSeparatedList (..)+  , JSONOutputStructure (..)+  , NumberSeparatedList (..)+  ) where++import Data.Aeson+import Data.ByteString.Char8 (fromStrict)+import Data.Char (isDigit, isSpace)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Data.Text.Internal.Search (indices)++{- | Typeclass for parsing output from language models into specific types.+Instances of this class define how to convert a 'Text' output into a value of type 'a'.+-}+class OutputParser a where+  -- | Parse the given text into a value of type 'a'.+  -- Returns 'Left' with an error message if parsing fails, or 'Right' with the parsed value.+  parse :: Text -> Either String a++-- | Represents a list of text items separated by commas.+newtype CommaSeparatedList = CommaSeparatedList [Text]+  deriving (Show, Eq)++instance OutputParser Bool where+  -- \| Parse a boolean value from the text.+  -- The text is considered 'True' if it contains the word "true" (case-insensitive),+  -- and 'False' if it contains "false". Otherwise, parsing fails.+  --+  -- === Examples+  --+  -- \* Parsing "true":+  --+  -- @+  -- parse "true" :: Either String Bool == Right True+  -- @+  --+  -- \* Parsing "False":+  --+  -- @+  -- parse "False" :: Either String Bool == Right False+  -- @+  --+  -- \* Parsing invalid input:+  --+  -- @+  -- parse "yes" :: Either String Bool == Left "Invalid boolean value"+  -- @+  parse txt = do+    let txt' = T.strip $ T.toLower txt+    if length (indices "true" txt') > 0+      then+        Right True+      else+        if length (indices "false" txt') > 0+          then+            Right False+          else+            Left "Invalid boolean value"++instance OutputParser CommaSeparatedList where+  -- \| Parse a comma-separated list from the text.+  -- The text is split by commas, and each part is stripped of leading/trailing whitespace.+  --+  -- === Examples+  --+  -- \* Parsing an empty string:+  --+  -- @+  -- parse "" :: Either String CommaSeparatedList == Right (CommaSeparatedList [""])+  -- @+  --+  -- \* Parsing a single item:+  --+  -- @+  -- parse "item" :: Either String CommaSeparatedList == Right (CommaSeparatedList ["item"])+  -- @+  --+  -- \* Parsing multiple items:+  --+  -- @+  -- parse "item1,item2,item3" :: Either String CommaSeparatedList == Right (CommaSeparatedList ["item1", "item2", "item3"])+  -- @+  parse txt = Right $ CommaSeparatedList $ map T.strip $ T.splitOn "," txt++{- | JSON parser wrapper+Requires 'FromJSON' instance for target type. Uses Aeson for parsing.++Example data type:++@+data Person = Person+  { name :: Text+  , age :: Int+  } deriving (Show, Eq, FromJSON)+@++Usage:++>>> parse "{\"name\": \"Bob\", \"age\": 25}" :: Either String (JSONOutputStructure Person)+Right (JSONOutputStructure {jsonValue = Person {name = "Bob", age = 25}})+-}+newtype FromJSON a => JSONOutputStructure a = JSONOutputStructure+  { jsonValue :: a+  }+  deriving (Show, Eq, FromJSON)++-- | Instance for parsing JSON into any type that implements FromJSON.+instance FromJSON a => OutputParser (JSONOutputStructure a) where+  parse txt =+    case eitherDecode (fromStrict $ encodeUtf8 txt) of+      Left err -> Left $ "JSON parsing error: " ++ err+      Right val -> Right val++-- | Represents a list of text items separated by numbered prefixes, like "1. First item".+newtype NumberSeparatedList = NumberSeparatedList [Text]+  deriving (Show, Eq)++instance OutputParser NumberSeparatedList where+  -- \| Parse a numbered list from the text.+  -- The input is expected to be a list of items prefixed with numbers followed by dots,+  -- such as "1. First item\n2. Second item". Whitespace is trimmed from each item.+  --+  -- === Examples+  --+  -- \* Parsing a simple numbered list:+  --+  -- @+  -- parse "1. First item\n2. Second item\n3. Third item" :: Either String NumberSeparatedList == Right (NumberSeparatedList ["First item", "Second item", "Third item"])+  -- @+  --+  -- \* Handling whitespace:+  --+  -- @+  -- parse "1.   First item  \n  2.  Second item\n3. Third item" :: Either String NumberSeparatedList == Right (NumberSeparatedList ["First item", "Second item", "Third item"])+  -- @+  --+  -- \* Handling multi-digit numbers:+  --+  -- @+  -- parse "10. First item\n11. Second item\n12. Third item" :: Either String NumberSeparatedList == Right (NumberSeparatedList ["First item", "Second item", "Third item"])+  -- @+  parse txt =+    let s = trim (T.unpack txt)+     in case dropUntilAndConsumeBoundary s of+          Nothing -> Left "No valid numbered items found"+          Just rest ->+            -- Parse the rest into items and wrap them in our newtype.+            Right . NumberSeparatedList . map (T.pack . trim) $ parseItems rest++{- | Drops noise until we find a valid boundary marker (number with dot)+and then consumes the marker.+-}+dropUntilAndConsumeBoundary :: String -> Maybe String+dropUntilAndConsumeBoundary s =+  case findBoundary s of+    Nothing -> Nothing+    Just (idx, n) -> Just (drop (idx + n) s)++{- | Scans the string for the next occurrence of a valid boundary.+Returns the index and length of the marker.+-}+findBoundary :: String -> Maybe (Int, Int)+findBoundary s = go 0 s+  where+    go _ [] = Nothing+    go i xs@(_ : rest) =+      case isBoundaryAt xs of+        Just n -> Just (i, n)+        Nothing -> go (i + 1) rest++{- | Checks if the given string starts with a valid boundary.+A valid boundary has one or more digits, optional spaces,+a dot, then optional spaces. Returns the number of characters+consumed by the boundary if matched.+-}+isBoundaryAt :: String -> Maybe Int+isBoundaryAt s =+  let (digits, rest1) = span isDigit s+   in if null digits+        then Nothing+        else+          let (spaces, rest2) = span isSpace rest1+           in case rest2 of+                (c : rest3)+                  | c == '.' ->+                      let (spaces2, _) = span isSpace rest3+                       in Just (length digits + length spaces + 1 + length spaces2)+                _ -> Nothing++-- | Recursively splits the string into items using the boundary markers.+parseItems :: String -> [String]+parseItems s =+  case findBoundary s of+    Nothing -> [s] -- No further boundaries; the rest is one item.+    Just (idx, n) ->+      let item = take idx s+          rest = drop (idx + n) s+       in item : parseItems rest++-- | A simple trim function to remove leading and trailing whitespace.+trim :: String -> String+trim = f . f+  where+    f = reverse . dropWhile isSpace
+ src/Langchain/PromptTemplate.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module:      Langchain.PromptTemplate+Copyright:   (c) 2025 Tushar Adhatrao+License:     MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability:   experimental++This module provides types and functions for working with prompt templates in Langchain.+Prompt templates are used to structure inputs for language models, allowing for dynamic+insertion of variables into predefined text formats. They are essential for creating+flexible and reusable prompts that can be customized based on input data.++The main types are:++* 'PromptTemplate': A simple template with placeholders for variables.+* 'FewShotPromptTemplate': A template that includes few-shot examples for better context,+  useful in scenarios like few-shot learning.++These types are designed to be compatible with the Langchain Python library's prompt template+functionality: [Langchain PromptTemplate](https://python.langchain.com/docs/concepts/prompt_templates/).++== Examples++See the documentation for 'renderPrompt' and 'renderFewShotPrompt' for usage examples.+-}+module Langchain.PromptTemplate+  ( -- * Core Types+    PromptTemplate (..)+  , FewShotPromptTemplate (..)++    -- * Rendering Functions+  , renderPrompt+  , renderFewShotPrompt+  ) where++import qualified Data.Map.Strict as HM+import Data.Text (Text)+import qualified Data.Text as T+import Langchain.Runnable.Core (Runnable (..))++-- TODO: Add Mechanism for custom example selector++{- | Represents a prompt template with a template string.+The template string can contain placeholders of the form {key},+where key is a sequence of alphanumeric characters and underscores.+-}+newtype PromptTemplate = PromptTemplate+  { templateString :: Text+  }+  deriving (Show, Eq)++{- | Render a prompt template with the given variables.+Returns either an error message if a variable is missing or the rendered template.++=== Using 'renderPrompt'++To render a prompt template with variables:++@+let template = PromptTemplate "Hello, {name}! Welcome to {place}."+vars = HM.fromList [("name", "Alice"), ("place", "Wonderland")]+result <- renderPrompt template vars+-- Result: Right "Hello, Alice! Welcome to Wonderland."+@++If a variable is missing:++@+let vars = HM.fromList [("name", "Alice")]+result <- renderPrompt template vars+-- Result: Left "Missing variable: place"+@+-}+renderPrompt :: PromptTemplate -> HM.Map Text Text -> Either String Text+renderPrompt (PromptTemplate template) vars = interpolate vars template++{- | Represents a few-shot prompt template with examples.+This type allows for creating prompts that include example inputs and outputs,+which can be useful for few-shot learning scenarios.+-}+data FewShotPromptTemplate = FewShotPromptTemplate+  { fsPrefix :: Text+  -- ^ Text before the examples+  , fsExamples :: [HM.Map Text Text]+  -- ^ List of example variable maps+  , fsExampleTemplate :: Text+  -- ^ Template for formatting each example+  , fsExampleSeparator :: Text+  -- ^ Separator between formatted examples+  , fsSuffix :: Text+  -- ^ Text after the examples, with placeholders+  }+  deriving (Show, Eq)++{- | Render a few-shot prompt template with the given input variables.+Returns either an error message if interpolation fails or the fully rendered prompt.++=== Using 'renderFewShotPrompt'++To render a few-shot prompt template:++@+let fewShotTemplate = FewShotPromptTemplate+      { fsPrefix = "Examples of {type}:\n"+      , fsExamples =+          [ HM.fromList [("input", "Hello"), ("output", "Bonjour")]+          , HM.fromList [("input", "Goodbye"), ("output", "Au revoir")]+          ]+      , fsExampleTemplate = "Input: {input}\nOutput: {output}\n"+      , fsExampleSeparator = "\n"+      , fsSuffix = "Now translate: {query}"+      }+result <- renderFewShotPrompt fewShotTemplate+-- Result: Right "Examples of {type}:\nInput: Hello\nOutput: Bonjour\n\nInput: Goodbye\nOutput: Au revoir\nNow translate: {query}"+@+-}+renderFewShotPrompt :: FewShotPromptTemplate -> Either String Text+renderFewShotPrompt FewShotPromptTemplate {..} = do+  -- Format each example using the example template+  formattedExamples <-+    mapM+      (\ex -> interpolate ex fsExampleTemplate)+      fsExamples+  -- Join the formatted examples with the separator+  let examplesText = T.intercalate fsExampleSeparator formattedExamples+  -- Combine prefix, examples, and suffix+  return $ fsPrefix <> examplesText <> fsSuffix++{- | Interpolate variables into a template string.+Placeholders are of the form {key}, where key is a sequence of alphanumeric characters and underscores.+-}+interpolate :: HM.Map Text Text -> Text -> Either String Text+interpolate vars template = go template+  where+    go :: Text -> Either String Text+    go t =+      case T.breakOn "{" t of+        (before, after) | T.null after -> Right before+        (before, after') ->+          case T.breakOn "}" (T.drop 1 after') of+            (_, after'') | T.null after'' -> Left "Unclosed brace"+            (key, after''') ->+              let key' = T.strip key+               in case HM.lookup key' vars of+                    Just val -> do+                      rest <- go (T.drop 1 after''')+                      return $ before <> val <> rest+                    Nothing -> Left $ "Missing variable: " <> T.unpack key'++instance Runnable PromptTemplate where+  type RunnableInput PromptTemplate = HM.Map Text Text+  type RunnableOutput PromptTemplate = Text++  invoke template variables = pure $ renderPrompt template variables++{-+instance Runnable FewShotPromptTemplate where+  type RunnableInput FewShotPromptTemplate = Maybe [Text]+  type RunnableOutput FewShotPromptTemplate = Text++  invoke t m = pure $ renderFewShotPrompt t m+-}
+ src/Langchain/Retriever/Core.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Retriever.Core+Description : Retrieval mechanism implementation for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Haskell implementation of LangChain's retrieval abstraction, providing:++- Document retrieval based on semantic similarity+- Integration with vector stores+- Runnable interface for workflow composition++Example usage:++@+-- Hypothetical vector store instance+vectorStore :: MyVectorStore+vectorStore = ...++-- Create retriever+retriever :: VectorStoreRetriever MyVectorStore+retriever = VectorStoreRetriever vectorStore++-- Retrieve relevant documents+docs <- invoke retriever "Haskell programming"+-- Right [Document {pageContent = "...", ...}, ...]+@+-}+module Langchain.Retriever.Core+  ( Retriever (..)+  , VectorStoreRetriever (..)+  ) where++import Langchain.DocumentLoader.Core (Document)+import Langchain.Runnable.Core+import Langchain.VectorStore.Core++import Data.Text (Text)++{- | Typeclass for document retrieval systems+Implementations should return documents relevant to a given query.++Example instance for a custom retriever:++@+data CustomRetriever = CustomRetriever++instance Retriever CustomRetriever where+  _get_relevant_documents _ query = do+    -- Custom retrieval logic+    return $ Right [Document ("Result for: " <> query) mempty]+@+-}+class Retriever a where+  -- | Retrieve documents relevant to the query+  --+  --   Example:+  --+  --   >>> _get_relevant_documents (VectorStoreRetriever myStore) "AI"+  --   Right [Document "AI definition...", ...]+  _get_relevant_documents :: a -> Text -> IO (Either String [Document])++{- | Vector store-backed retriever implementation+Wraps any 'VectorStore' instance to provide similarity-based retrieval.++Example usage:++@+-- Using a hypothetical FAISS vector store+faissStore :: FAISSStore+faissStore = ...++-- Create vector store retriever+vsRetriever = VectorStoreRetriever faissStore++-- Get similar documents+docs <- _get_relevant_documents vsRetriever "machine learning"+-- Returns top 5 relevant documents by default+@+-}+newtype VectorStore a => VectorStoreRetriever a = VectorStoreRetriever {vs :: a}+  deriving (Eq, Show)++{- | Runnable interface for vector store retrievers+Allows integration with LangChain workflows and expressions.++Example:++>>> invoke (VectorStoreRetriever store) "Quantum computing"+Right [Document "Quantum theory...", ...]+-}+instance VectorStore a => Retriever (VectorStoreRetriever a) where+  _get_relevant_documents (VectorStoreRetriever v) query = similaritySearch v query 5++{- | Runnable interface for vector store retrievers+Allows integration with LangChain workflows and expressions.++Example:++>>> invoke (VectorStoreRetriever store) "Quantum computing"+Right [Document "Quantum theory...", ...]+-}+instance VectorStore a => Runnable (VectorStoreRetriever a) where+  type RunnableInput (VectorStoreRetriever a) = Text+  type RunnableOutput (VectorStoreRetriever a) = [Document]++  invoke retriever query = _get_relevant_documents retriever query++{- $examples+Test case patterns:+1. Basic retrieval+   >>> let retriever = VectorStoreRetriever mockStore+   >>> _get_relevant_documents retriever "Test"+   Right [Document "Test content" ...]++2. Runnable integration+   >>> run retriever "Hello"+   Right [Document "Greeting response" ...]++3. Error handling+   >>> _get_relevant_documents (VectorStoreRetriever invalidStore) "Query"+   Left "Vector store error"+-}
+ src/Langchain/Retriever/MultiQueryRetriever.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Retriever.MultiQueryRetriever+Description : Multi-query retrieval implementation for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Advanced retriever implementation that generates multiple queries from a single+input to improve document retrieval. Integrates with LLMs for query expansion+and vector stores for document retrieval++Example usage:++@+-- Create components+ollamaLLM = Ollama "llama3" []+vs = VectorStoreRetriever (createVectorStore ...)++-- Create retriever with default config+mqRetriever = newMultiQueryRetriever vs ollamaLLM++-- Retrieve documents+docs <- _get_relevant_documents mqRetriever "Haskell features"+-- Returns combined results from multiple generated queries+@+-}+module Langchain.Retriever.MultiQueryRetriever+  ( MultiQueryRetriever (..)+  , QueryGenerationPrompt (..)+  , newMultiQueryRetriever+  , defaultQueryGenerationPrompt+  , newMultiQueryRetrieverWithConfig+  , defaultMultiQueryRetrieverConfig+  , generateQueries+  ) where++import Langchain.DocumentLoader.Core (Document)+import Langchain.LLM.Core (LLM (..))+import Langchain.OutputParser.Core (NumberSeparatedList (..), OutputParser (..))+import Langchain.PromptTemplate (PromptTemplate (..), renderPrompt)+import Langchain.Retriever.Core (Retriever (..))+import qualified Langchain.Runnable.Core as Run++import Data.Either (rights)+import Data.List (nub)+import qualified Data.Map.Strict as HM+import Data.Text (Text)+import qualified Data.Text as T++{- | Query generation prompt template+Controls how the LLM generates multiple query variants from the original query.++Example prompt structure:++@+"You are an AI assistant... Original query: {query}... Generate {num_queries} versions..."+@+-}+newtype QueryGenerationPrompt = QueryGenerationPrompt PromptTemplate+  deriving (Show, Eq)++{- | Default query generation prompt+Generates 3 query variants in numbered list format. Includes instructions for+query diversity and formatting.+-}+defaultQueryGenerationPrompt :: QueryGenerationPrompt+defaultQueryGenerationPrompt =+  QueryGenerationPrompt $+    PromptTemplate+      { templateString =+          T.unlines+            [ "You are an AI language model assistant that helps users by generating multiple search queries based on their initial query."+            , "These queries should help retrieve relevant documents or information from a vector database."+            , ""+            , "Original query: {query}"+            , ""+            , "Please generate {num_queries} different versions of this query that will help the user find the most relevant information."+            , "The queries should be different but related to the original query."+            , "Return these queries in the following format: 1. query 1 \n 2. query 2 \n 3. query 3"+            , "Only return queries and nothing else"+            ]+      }++{- | Configuration for multi-query retrieval+-}+data MultiQueryRetrieverConfig = MultiQueryRetrieverConfig+  { numQueries :: Int+  -- ^ Number of queries to generate+  , queryGenerationPrompt :: QueryGenerationPrompt+  -- ^ Prompt template for query generation+  , includeMergeDocs :: Bool+  -- ^ Whether to include merged documents+  , includeOriginalQuery :: Bool+  -- ^ Whether to include results from original query+  }++{- | Default configuration+- 3 generated queries+- Includes original query results+- Uses default query generation prompt+-}+defaultMultiQueryRetrieverConfig :: MultiQueryRetrieverConfig+defaultMultiQueryRetrieverConfig =+  MultiQueryRetrieverConfig+    { numQueries = 3+    , queryGenerationPrompt = defaultQueryGenerationPrompt+    , includeMergeDocs = True+    , includeOriginalQuery = True+    }++{- | Multi-query retriever implementation+Generates multiple queries using an LLM, retrieves documents for each query,+and combines results. Improves recall by exploring different query formulations.++Example instance:++@+mqRetriever = MultiQueryRetriever+  { retriever = vectorStoreRetriever+  , llm = ollamaLLM+  , config = defaultMultiQueryRetrieverConfig+  }+@+-}+data (Retriever a, LLM m) => MultiQueryRetriever a m = MultiQueryRetriever+  { retriever :: a+  -- ^ The base retriever+  , llm :: m+  -- ^ The language model for generating queries+  , config :: MultiQueryRetrieverConfig+  -- ^ Configuration+  }++{- | Create retriever with default settings+Example:++>>> newMultiQueryRetriever vsRetriever ollamaLLM+MultiQueryRetriever {numQueries = 3, ...}+-}+newMultiQueryRetriever :: (Retriever a, LLM m) => a -> m -> MultiQueryRetriever a m+newMultiQueryRetriever r l =+  MultiQueryRetriever+    { retriever = r+    , llm = l+    , config = defaultMultiQueryRetrieverConfig+    }++{- | Create retriever with custom configuration+Example:++>>> let customCfg = defaultMultiQueryRetrieverConfig { numQueries = 5 }+>>> newMultiQueryRetrieverWithConfig vsRetriever ollamaLLM customCfg+MultiQueryRetriever {numQueries = 5, ...}+-}+newMultiQueryRetrieverWithConfig ::+  (Retriever a, LLM m) =>+  a ->+  m ->+  MultiQueryRetrieverConfig ->+  MultiQueryRetriever a m+newMultiQueryRetrieverWithConfig r l c =+  MultiQueryRetriever+    { retriever = r+    , llm = l+    , config = c+    }++{- | Generate multiple query variants using LLM+Example:++>>> generateQueries ollamaLLM prompt "Haskell" 3 True+Right ["Haskell", "Haskell features", "Haskell applications"]+-}+generateQueries ::+  LLM m => m -> QueryGenerationPrompt -> Text -> Int -> Bool -> IO (Either String [Text])+generateQueries model (QueryGenerationPrompt promptTemplate) query n includeOriginal = do+  let vars = HM.fromList [("query", query), ("num_queries", T.pack $ show n)]+  case renderPrompt promptTemplate vars of+    Left err -> return $ Left err+    Right prompt -> do+      result <- generate model prompt Nothing+      case result of+        Left err -> return $ Left err+        Right response -> do+          case parse response :: Either String NumberSeparatedList of+            Left err -> return $ Left $ "Failed to parse LLM response: " ++ err+            Right (NumberSeparatedList queries) -> do+              let uniqueQueries = nub $ filter (not . T.null) queries+              return $+                Right $+                  if includeOriginal+                    then query : uniqueQueries+                    else uniqueQueries++{- | Combine documents from multiple queries+Removes duplicates while maintaining order (simplified approach).+-}+combineDocuments :: [[Document]] -> [Document]+combineDocuments docLists =+  -- This is a simplified approach. In a production system, you'd want a more+  -- sophisticated way to identify and rank duplicate documents+  nub $ concat docLists++{- | Retriever instance implementation+1. Generates multiple queries using LLM+2. Retrieves documents for each query+3. Combines and deduplicates results++Example retrieval:++>>> _get_relevant_documents mqRetriever "Haskell"+Right [Document "Haskell is...", Document "Functional programming...", ...]+-}+instance (Retriever a, LLM m) => Retriever (MultiQueryRetriever a m) where+  _get_relevant_documents r query = do+    let baseRetriever = retriever r+        model = llm r+        cfg = config r++    -- Generate multiple queries+    queriesResult <-+      generateQueries+        model+        (queryGenerationPrompt cfg)+        query+        (numQueries cfg)+        (includeOriginalQuery cfg)++    case queriesResult of+      Left err -> return $ Left $ "Error generating queries: " ++ err+      Right queries -> do+        -- Get documents for each query+        results <- mapM (_get_relevant_documents baseRetriever) queries++        -- Filter successful results+        let validResults = rights results++        if null validResults+          then return $ Left "No valid results from any query"+          else return $ Right $ combineDocuments validResults++{-+ ghci> :set -XOverloadedStrings+ ghci> let ollamaEmbed = OllamaEmbeddings "nomic-embed-text:latest" Nothing Nothing+ ghci> let vs = emptyInMemoryVectorStore ollamaEmbed+ ghci> import Data.Map (empty)+ ghci> import Data.Either+ ghci> newVs <- addDocuments vs [Document "Tushar is 25 years old." empty]+ ghci> let newVs_ = fromRight vs newVs+ ghci> let vRet = VectorStoreRetriever newVs_+ ghci> let ollamLLM = Ollama "llama3.2" []+ ghci> let mqRet = newMultiQueryRetriever vRet ollamLLM+ ghci> documents <- _get_relevant_documents mqRet "How old is Tushar?"+ ghci> documents+    Right [Document {pageContent = "Tushar is 25 years old.", metadata = fromList []}]+ -}++{- | Runnable interface implementation+Allows integration with LangChain workflows:++>>> invoke mqRetriever "AI applications"+Right [Document "Machine learning...", ...]+-}+instance (Retriever a, LLM m) => Run.Runnable (MultiQueryRetriever a m) where+  type RunnableInput (MultiQueryRetriever a m) = Text+  type RunnableOutput (MultiQueryRetriever a m) = [Document]++  invoke r query = _get_relevant_documents r query++{- $examples+Test case patterns:+1. Query generation+   >>> generateQueries ollamaLLM prompt "Test" 2 False+   Right ["Test case", "Test example"]++2. Full retrieval flow+   >>> _get_relevant_documents mqRetriever "Haskell"+   Right [Document "Functional...", Document "Type system..."]++3. Configuration variants+   >>> let cfg = defaultMultiQueryRetrieverConfig { numQueries = 5 }+   >>> newMultiQueryRetrieverWithConfig vsRetriever ollamaLLM cfg+   MultiQueryRetriever {numQueries = 5, ...}+-}
+ src/Langchain/Runnable/Chain.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{- |+Module      : Langchain.Runnable.Chain+Description : Composition utilities for the Runnable typeclass+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>++This module provides various composition patterns for 'Runnable' instances,+allowing you to build complex processing pipelines from simpler components.++The primary abstractions include:++* 'RunnableSequence' - Chain multiple runnables sequentially+* 'RunnableBranch' - Select different processing branches based on input conditions+* 'RunnableMap' - Transform inputs or outputs when composing runnables++These abstractions follow functional programming patterns to create flexible+data processing pipelines for language model applications.+-}+module Langchain.Runnable.Chain+  ( -- * Core Data Types+    RunnableBranch (..)+  , RunnableMap (..)+  , RunnableSequence++    -- * Execution Functions+  , runBranch+  , runMap+  , runSequence++    -- * Composition Utilities+  , chain+  , branch+  , buildSequence+  , appendSequence+  , (|>>)+  ) where++import Data.List (find)+import Langchain.Runnable.Core++{- | Chains two 'Runnable' instances together sequentially.++The output of the first runnable is fed as input to the second.+If the first runnable fails, the error is returned immediately.++>>> :{+let textSplitter = TextSplitter defaultConfig+    llm = OpenAI defaultConfig+    summarizer input = chain textSplitter llm input+in summarizer "Split this text and then summarize each part."+:}+Right "The text was split into chunks and each part was summarized."+-}+chain ::+  (Runnable r1, Runnable r2, RunnableOutput r1 ~ RunnableInput r2) =>+  r1 ->+  r2 ->+  RunnableInput r1 ->+  IO (Either String (RunnableOutput r2))+chain r1 r2 input = do+  output1 <- invoke r1 input+  case output1 of+    Left err -> return $ Left err+    Right intermediate -> invoke r2 intermediate++{- | Creates a parallel composition of two 'Runnable' instances.++Both runnables receive the same input and their outputs are combined+into a tuple. If either runnable fails, the combined result fails.++>>> :{+let sentimentAnalyzer = LLMChain "Analyze sentiment of this text"+    keywordExtractor = LLMChain "Extract keywords from this text"+    analyzer text = branch sentimentAnalyzer keywordExtractor text+in analyzer "I love Haskell but monads can be challenging at first."+:}+Right ("Positive", ["Haskell", "love", "monads", "challenging"])+-}+branch ::+  (Runnable r1, Runnable r2, a ~ RunnableInput r1, a ~ RunnableInput r2) =>+  r1 ->+  r2 ->+  a ->+  IO (Either String (RunnableOutput r1, RunnableOutput r2))+branch r1 r2 input = do+  result1 <- invoke r1 input+  result2 <- invoke r2 input+  return $ (,) <$> result1 <*> result2++{- | A conditional branching structure for 'Runnable' instances.++'RunnableBranch' allows you to specify multiple condition-runnable pairs,+where the first runnable whose condition matches the input is invoked.+If no condition matches, a default runnable is used.++The conditions are functions that evaluate the input and return a boolean.+-}+data RunnableBranch a b+  = forall r.+    (Runnable r, RunnableInput r ~ a, RunnableOutput r ~ b) =>+    RunnableBranch [(a -> Bool, r)] r -- List of (condition, runnable) pairs and a default runnable++{- | Executes a 'RunnableBranch' by selecting the first matching runnable.++Evaluates each condition in order until one returns 'True', then invokes+the corresponding runnable. If no condition matches, invokes the default runnable.++>>> :{+let isShort text = length text < 100+    isQuestion text = last text == '?'+    shortTextHandler = LLMChain "Process short text"+    questionHandler = LLMChain "Answer the question"+    defaultHandler = LLMChain "Process general text"+    textProcessor = RunnableBranch [(isShort, shortTextHandler), (isQuestion, questionHandler)] defaultHandler+in runBranch textProcessor "How does this work?"+:}+Right "This is a question, so I'm handling it with the question processor."+-}+runBranch :: RunnableBranch a b -> a -> IO (Either String b)+runBranch (RunnableBranch options defaultR) input =+  case find (\(cond, _) -> cond input) options of+    Just (_, r) -> invoke r input+    Nothing -> invoke defaultR input++instance Runnable (RunnableBranch a b) where+  type RunnableInput (RunnableBranch a b) = a+  type RunnableOutput (RunnableBranch a b) = b++  invoke = runBranch++{- | A 'Runnable' that transforms input and/or output when executing another 'Runnable'.++'RunnableMap' allows you to adapt the input or output types of an existing 'Runnable'+to make it compatible with other components in your processing pipeline.+-}+data RunnableMap a b c+  = forall r.+    (Runnable r, RunnableInput r ~ b, RunnableOutput r ~ c) =>+    RunnableMap (a -> b) (c -> c) r -- input transform, output transform, and the runnable++{- | Executes a 'RunnableMap' by applying transformations to input and output.++First applies the input transformation function, then invokes the wrapped runnable,+and finally applies the output transformation function to the result (if successful).++>>> :{+let extractLength = length :: String -> Int+    isPalindrome str = str == reverse str+    lengthPalindrome = RunnableMap extractLength isPalindrome (pure True)+in runMap lengthPalindrome "hello"+:}+Right False+-}+runMap :: RunnableMap a b c -> a -> IO (Either String c)+runMap (RunnableMap inputFn outputFn r) input = do+  result <- invoke r (inputFn input)+  return $ fmap outputFn result++instance Runnable (RunnableMap a b c) where+  type RunnableInput (RunnableMap a b c) = a+  type RunnableOutput (RunnableMap a b c) = c++  invoke = runMap++{- | A sequence of 'Runnable' instances chained together.++'RunnableSequence' represents a pipeline where the output of each 'Runnable'+becomes the input to the next. This is the core abstraction for building+processing pipelines in Langchain.++The GADT construction ensures that the output type of each component+matches the input type of the next component.+-}+data RunnableSequence a b where+  RSNil :: RunnableSequence a a -- the empty chain, where the input and output types are the same.+  RSCons ::+    (Runnable r, RunnableInput r ~ a, RunnableOutput r ~ c) =>+    r ->+    RunnableSequence c b ->+    RunnableSequence a b -- RSCons adds a runnable at the front of the chain.++-- | Run a sequence of runnables, chaining the output of one as input to the next.+runSequence :: RunnableSequence a b -> RunnableInputHead a -> IO (Either String b)+runSequence RSNil input = return (Right input)+runSequence (RSCons r rs) input = do+  result <- invoke r input+  case result of+    Left err -> return (Left err)+    Right out -> runSequence rs out++instance Runnable (RunnableSequence a b) where+  type RunnableInput (RunnableSequence a b) = a+  type RunnableOutput (RunnableSequence a b) = b++  invoke = runSequence++-- | A type synonym to indicate the input type of the first runnable.+type RunnableInputHead a = a++{- | Builds a 'RunnableSequence' from two 'Runnable' instances.++This is a convenience function for creating a simple two-component sequence.++>>> :{+let parser = JSONParser defaultConfig+    validator = SchemaValidator personSchema+    personProcessor = buildSequence parser validator+in invoke personProcessor "{\"name\":\"John\",\"age\":30}"+:}+Right (Person "John" 30)+-}+buildSequence ::+  ( Runnable r1+  , Runnable r2+  , RunnableOutput r1 ~ RunnableInput r2+  ) =>+  r1 ->+  r2 ->+  RunnableSequence (RunnableInput r1) (RunnableOutput r2)+buildSequence r1 r2 = RSCons r1 (RSCons r2 RSNil)++{- | Appends a 'Runnable' to the end of a 'RunnableSequence'.++This allows you to incrementally build longer processing pipelines.++>>> :{+let retriever = DocumentRetriever defaultConfig+    llm = OpenAI defaultConfig+    formatter = OutputFormatter defaultConfig+    basePipeline = buildSequence retriever llm+    fullPipeline = appendSequence basePipeline formatter+in invoke fullPipeline "Tell me about Haskell's type system"+:}+Right "Haskell has a strong, static type system featuring type inference..."+-}+appendSequence ::+  ( Runnable r2+  , RunnableOutput (RunnableSequence a b) ~ (RunnableInput r2)+  ) =>+  RunnableSequence a b ->+  r2 ->+  RunnableSequence a (RunnableOutput r2)+appendSequence RSNil r = RSCons r RSNil+appendSequence (RSCons r1 rs) r2 = RSCons r1 (appendSequence rs r2)++{- | Operator version of 'chain' for more readable composition.++Allows for cleaner pipeline construction with an infix operator:++>>> textSplitter |>> embedder |>> retriever |>> llm $ "Explain monads in Haskell."+Right "Monads in Haskell are a design pattern that allows for sequencing computations..."+-}+(|>>) ::+  (Runnable r1, Runnable r2, RunnableOutput r1 ~ RunnableInput r2) =>+  r1 ->+  r2 ->+  RunnableInput r1 ->+  IO (Either String (RunnableOutput r2))+(|>>) = chain++infix 4 |>>
+ src/Langchain/Runnable/ConversationChain.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Runnable.ConversationChain+Description : Stateful conversation handler for LLM interactions+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>++This module provides the 'ConversationChain' implementation, which manages stateful+conversations with language models. It combines:++1. A memory component for storing conversation history+2. An LLM for generating responses+3. A prompt template for formatting the conversation++'ConversationChain' handles the full conversation lifecycle, including:++- Adding user messages to memory+- Retrieving conversation history+- Formatting the conversation context for the LLM+- Getting responses from the LLM+- Storing AI responses back to memory++This creates a complete conversation loop that maintains context across multiple turns.+-}+module Langchain.Runnable.ConversationChain+  ( -- * Types+    ConversationChain (..)+  ) where++import Data.Text (Text)+import Langchain.LLM.Core+import Langchain.Memory.Core+import Langchain.PromptTemplate+import Langchain.Runnable.Core++{- | Manages a stateful conversation between a user and a language model.++The 'ConversationChain' combines three key components:++1. @memory@: Stores and retrieves conversation history+2. @llm@: The language model that generates responses+3. @prompt@: Template for formatting the conversation for the LLM++When invoked with a user message, the 'ConversationChain':++- Adds the user message to memory+- Retrieves the updated conversation history+- Formats the conversation for the LLM using the prompt template+- Gets a response from the LLM+- Stores the AI response in memory+- Returns the AI response++Example:++@+import Data.Text (Text)+import qualified Data.Text as T+import Langchain.LLM.OpenAI (OpenAI(..))+import Langchain.Memory.ConversationBufferMemory (ConversationBufferMemory(..))+import Langchain.PromptTemplate (PromptTemplate(..), createPromptTemplate)+import Langchain.Runnable.ConversationChain (ConversationChain(..))++main :: IO ()+main = do+  -- Create memory component+  let memory = ConversationBufferMemory+        { messages = []+        , returnMessages = True+        }++  -- Create LLM+  let llm = OpenAI+        { model = "gpt-4"+        , temperature = 0.7+        }++  -- Create prompt template+  promptTemplate <- createPromptTemplate+    "You are a helpful assistant. {history}\\nHuman: {input}\\nAI:"+    ["history", "input"]++  -- Create conversation chain+  let conversation = ConversationChain+        { memory = memory+        , llm = llm+        , prompt = promptTemplate+        }++  -- Start conversation+  response1 <- invoke conversation "Hello, who are you?"+  case response1 of+    Left err -> putStrLn $ "Error: " ++ T.unpack err+    Right answer -> do+      putStrLn $ "AI: " ++ T.unpack answer++      -- Continue conversation with context+      response2 <- invoke conversation "What can you help me with?"+      case response2 of+        Left err -> putStrLn $ "Error: " ++ T.unpack err+        Right answer2 -> putStrLn $ "AI: " ++ T.unpack answer2+@++You can customize the behavior by using different memory implementations:++* 'ConversationBufferMemory' - Stores the full conversation history+* 'ConversationBufferWindowMemory' - Keeps only the most recent N exchanges+* 'ConversationSummaryMemory' - Summarizes older conversations to save tokens+* 'ConversationEntityMemory' - Tracks entities mentioned in the conversation++The prompt template can be customized to give the LLM specific instructions,+persona characteristics, or to format the conversation history in different ways.+-}+data ConversationChain m l = ConversationChain+  { memory :: m+  -- ^ Memory component that stores conversation history+  , llm :: l+  -- ^ Language model that generates responses+  , prompt :: PromptTemplate+  -- ^ Template for formatting the conversation+  }++-- | Make ConversationChain an instance of Runnable to enable composition with other components+instance (BaseMemory m, LLM l) => Runnable (ConversationChain m l) where+  type RunnableInput (ConversationChain m l) = Text+  type RunnableOutput (ConversationChain m l) = Text++  -- \| Process a user message and generate an AI response.+  --+  --  This method:+  --  1. Adds the user message to memory+  --  2. Retrieves the full conversation history+  --  3. Formats the history and input for the LLM+  --  4. Gets a response from the LLM+  --  5. Stores the AI response in memory+  --  6. Returns the AI response+  --+  --  Example:+  --+  --  @+  --  let chatbot = ConversationChain { ... }+  --+  --  -- Single turn conversation+  --  response <- invoke chatbot "Can you explain monads in Haskell?"+  --+  --  -- Multi-turn conversation with context+  --  response1 <- invoke chatbot "Who was Alan Turing?"+  --  response2 <- invoke chatbot "What was his most famous contribution?"+  --  response3 <- invoke chatbot "Can you explain it in simpler terms?"+  --  @+  --+  invoke ConversationChain {..} input = do+    -- Add user message to memory+    updatedMemResult <- addUserMessage memory input+    case updatedMemResult of+      Left err -> return $ Left err+      Right updatedMem -> do+        -- Get all messages+        messagesResult <- messages updatedMem+        case messagesResult of+          Left err -> return $ Left err+          Right allMessages -> do+            -- Format messages for the LLM+            let formattedMessages = allMessages+            -- Get response from LLM+            llmResponse <- chat llm formattedMessages Nothing+            case llmResponse of+              Left err -> return $ Left err+              Right response -> do+                -- Store AI response in memory+                _ <- addAiMessage updatedMem response+                return $ Right response
+ src/Langchain/Runnable/Core.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{- |+Module      : Langchain.Runnable.Core+Description : Core Interface of Runnable. Necessary for LangChain Expression Language (LCEL)+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>++This module defines the 'Runnable' typeclass, which is the fundamental abstraction in the+Haskell implementation of LangChain Expression Language (LCEL). A 'Runnable' represents any+component that can process an input and produce an output, potentially with side effects.++The 'Runnable' abstraction enables composition of various LLM-related components into+processing pipelines, including:++* Language Models+* Prompt Templates+* Document Retrievers+* Text Splitters+* Embedders+* Vector Stores+* Output Parsers++By implementing the 'Runnable' typeclass, components can be combined using the combinators+provided in "Langchain.Runnable.Chain".+-}+module Langchain.Runnable.Core+  ( Runnable (..)+  ) where++{- | The core 'Runnable' typeclass represents anything that can "run" with an input and produce an output.++This typeclass is the foundation of the LangChain Expression Language (LCEL) in Haskell,+allowing different components to be composed into processing pipelines.++To implement a 'Runnable', you must:++1. Define the input and output types using associated type families+2. Implement the 'invoke' method+3. Optionally override 'batch' and 'stream' for specific optimizations++Example implementation:++@+data TextSplitter = TextSplitter { chunkSize :: Int, overlap :: Int }++instance Runnable TextSplitter where+  type RunnableInput TextSplitter = String+  type RunnableOutput TextSplitter = [String]++  invoke splitter text = do+    -- Implementation of text splitting logic+    let chunks = splitTextIntoChunks (chunkSize splitter) (overlap splitter) text+    return $ Right chunks+@+-}+class Runnable r where+  -- | The type of input the runnable accepts.+  --+  -- For example, an LLM might accept 'String' or 'PromptValue' as input.+  type RunnableInput r++  -- | The type of output the runnable produces.+  --+  -- For example, an LLM might produce 'String' or 'LLMResult' as output.+  type RunnableOutput r++  -- | Core method to invoke (run) this component with a single input.+  --+  --   This is the primary method that must be implemented for any 'Runnable'.+  --   It processes a single input and returns either an error message or the output.+  --+  --   Example usage:+  --+  --   @+  --   let model = OpenAI { temperature = 0.7, model = "gpt-3.5-turbo" }+  --   result <- invoke model "Explain monads in simple terms."+  --   case result of+  --     Left err -> putStrLn $ "Error: " ++ err+  --     Right response -> putStrLn response+  --   @+  invoke :: r -> RunnableInput r -> IO (Either String (RunnableOutput r))++  -- | Batch process multiple inputs at once.+  --+  --   This method can be overridden to provide more efficient batch processing,+  --   particularly for components like LLMs that may have batch APIs.+  --+  --   The default implementation simply maps 'invoke' over each input and+  --   sequences the results.+  --+  --   Example usage:+  --+  --   @+  --   let retriever = VectorDBRetriever { ... }+  --   questions <- ["What is Haskell?", "Explain monads.", "How do I install GHC?"]+  --   result <- batch retriever questions+  --   case result of+  --     Left err -> putStrLn $ "Batch processing failed: " ++ err+  --     Right docs -> mapM_ print docs+  --   @+  batch :: r -> [RunnableInput r] -> IO (Either String [RunnableOutput r])++  -- | Default implementation of batch that processes each input sequentially+  batch r inputs = do+    results <- mapM (invoke r) inputs+    return $ sequence results++  -- | Stream results for components that support streaming.+  --+  --   This method is particularly useful for LLMs that can stream tokens as they're+  --   generated, allowing for more responsive user interfaces.+  --+  --   The callback function is called with each piece of the output as it becomes available.+  --+  --   Example usage:+  --+  --   @+  --   let model = OpenAI { temperature = 0.7, model = "gpt-3.5-turbo", streaming = True }+  --   result <- stream model "Write a story about a programmer." $ \chunk -> do+  --     putStr chunk+  --     hFlush stdout+  --   case result of+  --     Left err -> putStrLn $ "\\nError: " ++ err+  --     Right _ -> putStrLn "\\nStreaming completed successfully."+  --   @+  stream :: r -> RunnableInput r -> (RunnableOutput r -> IO ()) -> IO (Either String ())++  -- | Default implementation that invokes the runnable and then calls the callback with the full result+  stream r input callback = do+    result <- invoke r input+    case result of+      Left err -> return $ Left err+      Right output -> do+        callback output+        return $ Right ()
+ src/Langchain/Runnable/Utils.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Module      : Langchain.Runnable.Utils+Description : Utility wrappers for Runnable components in LangChain+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>++This module provides various utility wrappers for 'Runnable' components that enhance+their behavior with common patterns like:++* Configuration management+* Result caching+* Automatic retries+* Timeout handling++These utilities follow the decorator pattern, wrapping existing 'Runnable' instances+with additional functionality while preserving the original input/output types.++Note: This module is experimental and the API may change in future versions.+-}+module Langchain.Runnable.Utils+  ( -- * Configuration Management+    WithConfig (..)++    -- * Caching+  , Cached (..)+  , cached++    -- * Resilience Patterns+  , Retry (..)+  , WithTimeout (..)+  ) where++import Control.Concurrent+import Data.Map.Strict as Map+import Langchain.Runnable.Core++{- | Wrapper for 'Runnable' components with configurable behavior.++This wrapper allows attaching configuration data to a 'Runnable' instance.+The configuration data can be accessed and modified without changing the+underlying 'Runnable' implementation.++Example:++@+data LLMConfig = LLMConfig+  { temperature :: Float+  , maxTokens :: Int+  }++let+  baseModel = OpenAI defaultOpenAIConfig+  configuredModel = WithConfig+    { configuredRunnable = baseModel+    , runnableConfig = LLMConfig 0.7 100+    }++-- Later, modify the configuration without changing the model+let updatedModel = configuredModel { runnableConfig = LLMConfig 0.9 150 }++-- Use the model as a regular Runnable+result <- invoke updatedModel "Explain monads in Haskell"+@+-}+data WithConfig config r+  = (Runnable r) =>+  WithConfig+  { configuredRunnable :: r+  -- ^ The wrapped 'Runnable' instance+  , runnableConfig :: config+  -- ^ Configuration data for this 'Runnable'+  }++-- | Make WithConfig a Runnable that applies the configuration+instance (Runnable r) => Runnable (WithConfig config r) where+  type RunnableInput (WithConfig config r) = RunnableInput r+  type RunnableOutput (WithConfig config r) = RunnableOutput r++  invoke (WithConfig r1 _) input = invoke r1 input++{- | Cache results of a 'Runnable' to avoid duplicate computations.++This wrapper stores previously computed results in a thread-safe cache.+When an input is encountered again, the cached result is returned instead+of recomputing it, which can significantly improve performance for expensive+operations or when the same inputs are frequently processed.++Note: The cached results are stored in-memory and will be lost when the program+terminates. For persistent caching, consider implementing a custom wrapper that+uses database storage.++The 'RunnableInput' type must be an instance of 'Ord' for map lookups.+-}+data Cached r+  = (Runnable r, Ord (RunnableInput r)) =>+  Cached+  { cachedRunnable :: r+  -- ^ The wrapped 'Runnable' instance+  , cacheMap :: MVar (Map.Map (RunnableInput r) (RunnableOutput r))+  -- ^ Thread-safe cache storage+  }++{- | Create a new cached 'Runnable'.++This function initializes an empty cache and wraps the provided 'Runnable'+in a 'Cached' wrapper.++Example:++@+main = do+  -- Create a cached LLM to avoid redundant API calls+  let expensiveModel = OpenAI { model = "gpt-4", temperature = 0.7 }+  cachedModel <- cached expensiveModel++  -- These will all use the same cached result for identical inputs+  result1 <- invoke cachedModel "What is functional programming?"+  result2 <- invoke cachedModel "What is functional programming?"+  result3 <- invoke cachedModel "What is functional programming?"++  -- This will compute a new result+  result4 <- invoke cachedModel "What is Haskell?"+@+-}+cached :: (Runnable r, Ord (RunnableInput r)) => r -> IO (Cached r)+cached r = do+  cache <- newMVar Map.empty+  return $ Cached r cache++-- | Make Cached a Runnable that uses a cache+instance (Runnable r, Ord (RunnableInput r)) => Runnable (Cached r) where+  type RunnableInput (Cached r) = RunnableInput r+  type RunnableOutput (Cached r) = RunnableOutput r++  invoke (Cached r cacheRef) input = do+    cache <- readMVar cacheRef+    case Map.lookup input cache of+      Just output -> return $ Right output -- Cache hit: return cached result+      Nothing -> do+        -- Cache miss: compute and store resul+        result <- invoke r input+        case result of+          Left err -> return $ Left err+          Right output -> do+            modifyMVar_ cacheRef $ \c -> return $ Map.insert input output c+            return $ Right output++{- | Add retry capability to any 'Runnable'.++This wrapper automatically retries failed operations up to a specified+number of times with a configurable delay between attempts. This is particularly+useful for network operations or external API calls that might fail transiently.++Example:++@+-- Create an LLM with automatic retry for network failures+let+  baseModel = OpenAI defaultConfig+  resilientModel = Retry+    { retryRunnable = baseModel+    , maxRetries = 3+    , retryDelay = 1000000  -- 1 second delay between retries+    }++-- If the API call fails, it will retry up to 3 times+result <- invoke resilientModel "Generate a story about a Haskell programmer"+@+-}+data Retry r+  = (Runnable r) =>+  Retry+  { retryRunnable :: r+  -- ^ The wrapped 'Runnable' instance+  , maxRetries :: Int+  -- ^ Maximum number of retry attempts+  , retryDelay :: Int+  -- ^ Delay between retry attempts in microseconds+  }++-- | Make Retry a Runnable that retries on failure+instance (Runnable r) => Runnable (Retry r) where+  type RunnableInput (Retry r) = RunnableInput r+  type RunnableOutput (Retry r) = RunnableOutput r++  invoke (Retry r maxRetries_ delay) input = retryWithCount 0+    where+      retryWithCount count = do+        result <- invoke r input+        case result of+          Left err ->+            if count < maxRetries_+              then do+                threadDelay delay+                retryWithCount (count + 1)+              else return $ Left err+          Right output -> return $ Right output++{- | Add timeout capability to any 'Runnable'.++This wrapper enforces a maximum execution time for the wrapped 'Runnable'.+If the operation takes longer than the specified timeout, it is cancelled and+an error is returned. This is useful for limiting the execution time of potentially+long-running operations.++Example:++@+-- Create an LLM with a 30-second timeout+let+  baseModel = OpenAI defaultConfig+  timeboxedModel = WithTimeout+    { timeoutRunnable = baseModel+    , timeoutMicroseconds = 30000000  -- 30 seconds+    }++-- If the API call takes longer than 30 seconds, it will be cancelled+result <- invoke timeboxedModel "Generate a detailed analysis of Haskell's type system"+@++Note: This implementation uses 'forkIO' and 'killThread', which may not always+cleanly terminate the underlying operation, especially for certain types of I/O.+For critical applications, consider implementing a more robust timeout mechanism.+-}+data WithTimeout r+  = (Runnable r) =>+  WithTimeout+  { timeoutRunnable :: r+  -- ^ The wrapped 'Runnable' instance+  , timeoutMicroseconds :: Int+  -- ^ Timeout duration in microseconds+  }++-- | Make WithTimeout a Runnable that times out+instance (Runnable r) => Runnable (WithTimeout r) where+  type RunnableInput (WithTimeout r) = RunnableInput r+  type RunnableOutput (WithTimeout r) = RunnableOutput r++  invoke (WithTimeout r timeout) input = do+    resultVar <- newEmptyMVar++    -- Fork a thread to run the computation+    tid <- forkIO $ do+      result <- invoke r input+      putMVar resultVar (Just result)++    -- Set up the timeout+    timeoutTid <- forkIO $ do+      threadDelay timeout+      putMVar resultVar Nothing++    -- Wait for either result or timeout+    result <- takeMVar resultVar++    -- Kill the other thread+    killThread tid+    killThread timeoutTid++    case result of+      Just r_ -> return r_+      Nothing -> return $ Left "Operation timed out"
+ src/Langchain/TextSplitter/Character.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.TextSplitter.Character+Description : Character-based text splitting for LLM processing [[10]]+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Character-based text splitting implementation following LangChain's text splitter concepts.+Splits text into chunks based on separators and maximum chunk sizes, useful for processing+large documents with LLMs.++For more information on text splitting concepts, see the Langchain documentation:+[Langchain TextSplitter](https://python.langchain.com/docs/concepts/text_splitters/).++Example usage:++@+-- Split text using default settings (100 char chunks, double newline separator)+splitText defaultCharacterSplitterOps "Long document text..."++-- Custom configuration for 500-char chunks with paragraph splitting+customSplit = splitText (CharacterSplitterOps 500 "\n\\s*\n")+@+-}+module Langchain.TextSplitter.Character+  ( -- * Configuration+    CharacterSplitterOps (..)+  , defaultCharacterSplitterOps++    -- * Splitting Function+  , splitText+  ) where++import Data.Text (Text)+import qualified Data.Text as T++{- | Configuration for character-based text splitting +Contains:++- 'chunkSize' : Maximum characters per chunk+- 'separator' : Pattern to split text before chunking++Default values follow LangChain's recommended settings for LLM input preparation.+-}+data CharacterSplitterOps = CharacterSplitterOps+  { chunkSize :: Int+  , separator :: Text+  }+  deriving (Show, Eq)++{- | Default splitter configuration ++- 100 character chunks+- Splits on double newlines ("\n\n")++>>> defaultCharacterSplitterOps+CharacterSplitterOps {chunkSize = 100, separator = "\n\n"}+-}+defaultCharacterSplitterOps :: CharacterSplitterOps+defaultCharacterSplitterOps =+  CharacterSplitterOps+    { chunkSize = 100+    , separator = "\n\n"+    }++{- | Split text into chunks following LangChain's splitting strategy:+ -+1. Split by separator first+2. Chunk each segment into specified size+3. Preserve semantic boundaries where possible++Examples:+>>> splitText defaultCharacterSplitterOps ""+[]++>>> splitText defaultCharacterSplitterOps "Short text"+["Short text"]++>>> splitText defaultCharacterSplitterOps "Part1\n\nPart2\n\nPart3"+["Part1", "Part2", "Part3"]++>>> splitText (CharacterSplitterOps 20 "\n\n") "Very long text exceeding chunk size..."+["Very long text ex", "ceeding chunk size..."]+-}+splitText :: CharacterSplitterOps -> Text -> [Text]+splitText CharacterSplitterOps {..} txt =+  mconcat $+    map+      (T.chunksOf chunkSize . T.strip)+      (if T.null separator then [txt] else T.splitOn separator txt)++{- $examples+Test case patterns demonstrating key behaviors:++1. Empty input handling+   >>> splitText defaultCharacterSplitterOps ""+   []++2. Custom separator usage+   >>> splitText (CharacterSplitterOps 100 "|") "A|B|C"+   ["A", "B", "C"]++3. Combined splitting and chunking+   >>> splitText (CharacterSplitterOps 10 "\n") "1234567890\nABCDEFGHIJ"+   ["1234567890", "ABCDEFGHIJ"]+-}
+ src/Langchain/Tool/Core.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{- | Module      : Langchain.VectorStore.InMemory+Description : In-memory vector store implementation for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Core module defining the Tool typeclass for Langchain-Haskell integration.++This module provides a typeclass interface for creating interoperable tools+that can be used with Large Language Models (LLMs) in Haskell applications.+The design mirrors LangChain's Python tooling system [[9]] while maintaining+Haskell's type safety and functional programming principles.++Example use case:++> data Calculator = Calculator+>+> instance Tool Calculator where+>   type Input Calculator = (Int, Int)+>   type Output Calculator = Int+>   toolName _ = "calculator"+>   toolDescription _ = "Performs arithmetic operations on two integers"+>   runTool _ (a, b) = pure (a + b)+-}+module Langchain.Tool.Core+  ( Tool (..)+  ) where++import Data.Text (Text)++{- | Typeclass defining the interface for tools that can be used with LLMs.++Tools represent capabilities that can be invoked by language models,+following the LangChain framework's tooling pattern. Each tool must:++* Define input/output types using type families+* Provide a unique name and description+* Implement an IO-based execution function++The use of type families allows for flexible yet type-safe tool composition,+while the IO monad accommodates both pure and effectful implementations.+-}+class Tool a where+  -- | Input type required by the tool+  --+  -- Example: For a weather lookup tool, this might be 'LocationCoordinates'+  type Input a++  -- | Output type produced by the tool+  --+  -- Example: For a calculator tool, this could be 'Int' or 'Double'+  type Output a++  -- | Get the tool's unique identifier+  --+  -- >>> toolName (undefined :: Calculator)+  -- "calculator"+  toolName :: a -> Text++  -- | Get human-readable description of the tool's purpose+  --+  -- >>> toolDescription (undefined :: Calculator)+  -- "Performs arithmetic operations on two integers"+  toolDescription :: a -> Text++  -- | Execute the tool with given input+  --+  -- This function bridges the gap between LLM abstractions and concrete+  -- implementations. The IO context allows for:+  --+  -- * Pure computations (via 'pure')+  -- * External API calls+  -- * Database queries+  --+  -- Example implementation:+  --+  -- > runTool _ (a, b) = do+  -- >   putStrLn "Calculating..."+  -- >   pure (a + b)+  runTool :: a -> Input a -> IO (Output a)
+ src/Langchain/Tool/WebScraper.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Tool.WebScraper+Description : Tool for scrapping text content from URL+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+-}+module Langchain.Tool.WebScraper (WebScraper (..), WebPageInfo (..), fetchAndScrape) where++import Control.Exception (SomeException, try)+import Data.Aeson (ToJSON)+import qualified Data.ByteString.Lazy as LBS+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import GHC.Generics (Generic)+import Langchain.Tool.Core+import Network.HTTP.Simple+import Text.HTML.Scalpel++-- | Represents a web scraper tool that extracts content from web pages+data WebScraper = WebScraper+  deriving (Show)++-- | Stores the extracted webpage information+data WebPageInfo = WebPageInfo+  { pageTitle :: Maybe Text+  , pageHeadings :: [Text]+  , pageLinks :: [(Text, Text)] -- (Link text, URL)+  , pageText :: Text+  }+  deriving (Show, Generic)++-- Make WebPageInfo serializable to JSON+instance ToJSON WebPageInfo++-- | Input type for the WebScraper - just a URL+type ScraperInput = Text++-- | Implement the Tool typeclass for WebScraper+instance Tool WebScraper where+  type Input WebScraper = ScraperInput+  type Output WebScraper = Text++  toolName _ = "web_scraper"++  toolDescription _ =+    "Scrapes content from a webpage. Provide a valid URL, and it will extract the title,"+      <> "headings, links, and text content."++  runTool _ url = do+    result <- fetchAndScrape url+    case result of+      Left err -> pure $ "Error scraping webpage: " <> T.pack (show err)+      Right info -> pure $ T.pack (show info)++-- | Fetch HTML content from a URL and extract webpage information+fetchAndScrape :: Text -> IO (Either String WebPageInfo)+fetchAndScrape url = do+  request_ <- parseRequest (T.unpack url)+  eResp <- try $ httpLBS request_ :: IO (Either SomeException (Response LBS.ByteString))+  case eResp of+    Left err -> pure $ Left (show err)+    Right r -> do+      let rBody = (getResponseBody r)+      let htmlContent = TE.decodeUtf8 $ LBS.toStrict rBody+      let scraped = scrapeStringLike htmlContent scrapeWebPageInfo+      case scraped of+        Nothing -> pure $ Left "Failed to parse HTML content"+        Just info -> pure $ Right info++-- | Define the Scalpel scraper for extracting webpage information+scrapeWebPageInfo :: Scraper Text WebPageInfo+scrapeWebPageInfo = do+  title <- scrapeTitle+  headings <- scrapeHeadings+  links <- scrapeLinks+  t <- scrapeText+  return $ WebPageInfo title headings links t++-- | Scrape the page title+scrapeTitle :: Scraper Text (Maybe Text)+scrapeTitle = fmap listToMaybe $ texts "title"++-- | Scrape all headings (h1-h6)+scrapeHeadings :: Scraper Text [Text]+scrapeHeadings = do+  h1s <- texts "h1"+  h2s <- texts "h2"+  h3s <- texts "h3"+  h4s <- texts "h4"+  h5s <- texts "h5"+  h6s <- texts "h6"+  return $ concat [h1s, h2s, h3s, h4s, h5s, h6s]++-- | Scrape all links with their URLs+scrapeLinks :: Scraper Text [(Text, Text)]+scrapeLinks = chroots "a" $ do+  linkText <- text "a"+  linkHref <- attr "href" "a"+  return (linkText, linkHref)++-- | Scrape main text content (from p, div, span elements)+scrapeText :: Scraper Text Text+scrapeText = do+  paragraphs <- texts "p"+  divs <- texts "div"+  spans <- texts "span"+  listElems <- texts "li"+  return $ T.intercalate "\n\n" $ filter (not . T.null) $ concat [paragraphs, divs, spans, listElems]
+ src/Langchain/Tool/WikipediaTool.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Tool.WikipediaTool+Description : Tool for extracting wikipedia content.+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+-}+module Langchain.Tool.WikipediaTool+  ( -- * Configuration+    WikipediaTool (..)+  , defaultWikipediaTool++    -- * Parameters+  , defaultTopK+  , defaultDocMaxChars+  , defaultLanguageCode++    -- * Internal types+  , SearchQuery (..)+  , SearchResponse (..)+  , Page (..)+  , SearchResult (..)+  , Pages (..)+  , PageResponse (..)+  ) where++import Control.Exception (throwIO)+import Data.Aeson (FromJSON (..), decode, withObject, (.:))+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics+import Langchain.Runnable.Core (Runnable (..))+import Langchain.Tool.Core+import Network.HTTP.Simple++{- |+Wikipedia search tool configuration+The tool uses Wikipedia's API to perform searches and retrieve page extracts.++Example configuration:++> customTool = WikipediaTool+>   { topK = 3+>   , docMaxChars = 1000+>   , languageCode = "es"+>   }+-}+data WikipediaTool = WikipediaTool+  { topK :: Int+  -- ^ Number of Wikipedia pages to include in the result.+  , docMaxChars :: Int+  -- ^ Number of characters to take from each page.+  , languageCode :: Text+  -- ^ Language code to use (e.g., "en" for English).+  }+  deriving (Eq, Show)++-- | Default value for top K+defaultTopK :: Int+defaultTopK = 2++-- | Default value for max chars+defaultDocMaxChars :: Int+defaultDocMaxChars = 2000++-- | Default language+defaultLanguageCode :: Text+defaultLanguageCode = "en"++{- |+Wikipedia search tool configuration+The tool uses Wikipedia's API to perform searches and retrieve page extracts.++Example configuration:++> customTool = WikipediaTool+>   { topK = 3+>   , docMaxChars = 1000+>   , languageCode = "es"+>   }+-}+defaultWikipediaTool :: WikipediaTool+defaultWikipediaTool =+  WikipediaTool+    { topK = defaultTopK+    , docMaxChars = defaultDocMaxChars+    , languageCode = defaultLanguageCode+    }++-- | Tool instance for WikipediaTool.+instance Tool WikipediaTool where+  type Input WikipediaTool = Text++  -- \^ Natural language search query (e.g., "Quantum computing")++  type Output WikipediaTool = Text++  -- \^ Concatenated page extracts with separators++  -- \|+  --  Returns "Wikipedia" as the tool identifier+  --+  --  >>> toolName (undefined :: WikipediaTool)+  --  "Wikipedia"+  --+  toolName _ = "Wikipedia"++  -- \|+  --  Provides a description for LLM agents:+  --+  --  >>> toolDescription (undefined :: WikipediaTool)+  --  "A wrapper around Wikipedia. Useful for answering..."+  --+  toolDescription _ =+    "A wrapper around Wikipedia. Useful for answering general questions about people, places, companies, facts, historical events, or other subjects. Input should be a search query."++  -- \|+  --  Executes Wikipedia search and content retrieval.+  --  Handles API calls and response parsing, returning concatenated extracts.+  --+  --  Example flow:+  --+  --  1. Perform search query+  --  2. Retrieve top K page IDs+  --  3. Fetch and truncate page content+  --  4. Combine results with separators+  --+  --  Throws exceptions on:+  --+  --  - API request failures+  --  - JSON parsing errors+  --  - Missing page content+  --+  runTool tool q = searchWiki tool q++-- | Perform a Wikipedia search and retrieve page extracts.+searchWiki :: WikipediaTool -> Text -> IO Text+searchWiki tool q = do+  SearchResponse {..} <- performSearch tool q+  if null (search query)+    then return "no wikipedia pages found"+    else do+      let pageIds = map pageid (take (topK tool) (search query))+      pages <- mapM (getPage tool) pageIds+      let extracts = map (T.take (docMaxChars tool) . extract) pages+      return $ T.intercalate "\n\n" extracts++-- | Perform a search on Wikipedia.+performSearch :: WikipediaTool -> Text -> IO SearchResponse+performSearch tool q = do+  let params =+        M.fromList+          [ ("format", "json")+          , ("action", "query")+          , ("list", "search")+          , ("srsearch", T.unpack q)+          , ("srlimit", show (topK tool))+          ]+      url =+        T.pack $+          "https://" <> T.unpack (languageCode tool) <> ".wikipedia.org/w/api.php?" <> urlEncode params+  request <- parseRequest (T.unpack url)+  response <- httpLbs request+  let body = getResponseBody response+  case decode body of+    Just result -> return result+    Nothing -> throwIO $ userError "Failed to decode search response"++-- | Get a page extract from Wikipedia.+getPage :: WikipediaTool -> Int -> IO Page+getPage tool pageId = do+  let params =+        M.fromList+          [ ("format", "json")+          , ("action", "query")+          , ("prop", "extracts")+          , ("pageids", show pageId)+          ]+      url =+        T.pack $+          "https://" <> T.unpack (languageCode tool) <> ".wikipedia.org/w/api.php?" <> urlEncode params+  request <- parseRequest (T.unpack url)+  response <- httpLbs request+  let body = getResponseBody response+  case decode body of+    Just (PageResponse (Pages p)) -> case M.lookup (show pageId) p of+      Just page -> return page+      Nothing -> throwIO $ userError "Page not found in response"+    Nothing -> throwIO $ userError "Failed to decode page response"++-- | URL encode a map of parameters.+urlEncode :: Map String String -> String+urlEncode = concatMap (\(k, v) -> k ++ "=" ++ v ++ "&") . M.toList++-- | Data types for JSON parsing.+data SearchResponse = SearchResponse+  { query :: SearchQuery+  }+  deriving (Show, Generic, FromJSON)++-- | Type for list of search result+data SearchQuery = SearchQuery+  { search :: [SearchResult]+  }+  deriving (Show)++instance FromJSON SearchQuery where+  parseJSON = withObject "SearchQuery" $ \v ->+    SearchQuery+      <$> v .: "search"++-- | Result of SearchResult+data SearchResult = SearchResult+  { ns :: Int+  , title_ :: Text+  , pageid :: Int+  , size :: Int+  , wordcount :: Int+  , snippet :: Text+  , timestamp :: Text+  }+  deriving (Show)++instance FromJSON SearchResult where+  parseJSON = withObject "SearchResult" $ \v ->+    SearchResult+      <$> v .: "ns"+      <*> v .: "title"+      <*> v .: "pageid"+      <*> v .: "size"+      <*> v .: "wordcount"+      <*> v .: "snippet"+      <*> v .: "timestamp"++-- | Wikipedia response+data PageResponse = PageResponse+  { query :: Pages+  }+  deriving (Generic, Eq, Show, FromJSON)++-- | Collection of Wikipedia pages, where key is page id+data Pages = Pages+  { pages :: Map String Page+  }+  deriving (Generic, Eq, Show, FromJSON)++-- | Represents wikipedia page+data Page = Page+  { title :: Text+  , extract :: Text+  }+  deriving (Show, Eq)++instance FromJSON Page where+  parseJSON = withObject "Page" $ \v ->+    Page+      <$> v .: "title"+      <*> v .: "extract"++{- |+Implements Runnable compatibility layer+Note: The current implementation returns 'Right' values only,+though the type signature allows for future error handling.++Example usage:++> response <- invoke defaultWikipediaTool "Artificial intelligence"+> case response of+>   Right content -> putStrLn content+>   Left err -> print err+-}+instance Runnable WikipediaTool where+  type RunnableInput WikipediaTool = Text+  type RunnableOutput WikipediaTool = Text++  -- TODO: runTool should return an Either+  invoke tool input = fmap Right $ runTool tool input
+ src/Langchain/VectorStore/Core.hs view
@@ -0,0 +1,105 @@+{- |+Module      : Langchain.VectorStore.Core+Description : Core vector store abstraction for semantic search+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Haskell implementation of LangChain's vector store interface, providing:++- Document storage with vector embeddings+- Similarity-based search capabilities+- Integration with Runnable workflows++Example usage with hypothetical FAISS store:++@+-- Create vector store instance+faissStore :: FAISSStore+faissStore = emptyFAISSStore++-- Add documents with embeddings+docs = [Document "Haskell is functional" mempty, ...]+updatedStore <- addDocuments faissStore docs++-- Perform similarity search+results <- similaritySearch updatedStore "functional programming" 5+-- Returns top 5 relevant documents+@+-}+module Langchain.VectorStore.Core (VectorStore (..))+where++import Data.Int (Int64)+import Data.Text (Text)+import Langchain.DocumentLoader.Core++-- TODO: Add delete document mechanism, for this we need to generate and use id (Int)++{- | Vector store abstraction following LangChain's design patterns+Implementations should handle document storage, vectorization, and similarity search.++Example instance for an in-memory store:++@+data InMemoryStore = InMemoryStore+  { documents :: [Document]+  , embeddings :: [[Float]]+  }++instance VectorStore InMemoryStore where+  addDocuments store docs = ...+  similaritySearch store query k = ...+@+-}+class VectorStore m where+  -- | Add documents to the vector store+  --+  --   Example:+  --+  --   >>> addDocuments myStore [Document "Test content" mempty]+  --   Right (updatedStoreWithNewDocs)+  addDocuments :: m -> [Document] -> IO (Either String m)++  -- |+  --   Requires document ID tracking to be implemented in store instances.+  --+  --   Example usage (when implemented):+  --+  --   >>> delete myStore [123]+  --   Right (storeWithoutDoc123)+  delete :: m -> [Int64] -> IO (Either String m)++  -- | Find documents similar to query text+  --   Uses embedded vector representations for semantic search.+  --+  --   Example:+  --+  --   >>> similaritySearch store "Haskell monads" 3+  --   Right [Document "Monads in FP...", ...]+  similaritySearch :: m -> Text -> Int -> IO (Either String [Document])++  -- | Find documents similar to vector representation+  --   For direct vector comparisons without text conversion.+  --+  --   Example:+  --+  --   >>> similaritySearchByVector store [0.1, 0.3, ...] 5+  --   Right [mostSimilarDoc1, ...]+  similaritySearchByVector :: m -> [Float] -> Int -> IO (Either String [Document])++{- $examples+Test case patterns:+1. Document addition+   >>> addDocuments emptyStore [doc1, doc2]+   Right (storeWithDocs)++2. Similarity search+   >>> similaritySearch populatedStore "AI" 3+   Right [relevantDoc1, relevantDoc2, relevantDoc3]++3. Vector-based search+   >>> similaritySearchByVector store [0.5, 0.2, ...] 5+   Right [top5MatchingDocs]+-}
+ src/Langchain/VectorStore/InMemory.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.VectorStore.InMemory+Description : In-memory vector store implementation for LangChain Haskell+Copyright   : (c) 2025 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++In-memory vector store implementation following LangChain's patterns, supporting:++- Document storage with embeddings+- Cosine similarity search+- Integration with embedding models++Example usage:++@+-- Create store with Ollama embeddings+ollamaEmb = OllamaEmbeddings "nomic-embed" Nothing Nothing+inMem = emptyInMemoryVectorStore ollamaEmb++-- Add documents+docs = [Document "Hello World" mempty, Document "Haskell is functional" mempty]+updatedStore <- addDocuments inMem docs++-- Perform similarity search+results <- similaritySearch updatedStore "functional programming" 1+-- Right [Document "Haskell is functional"...]+@+-}+module Langchain.VectorStore.InMemory+  ( InMemory (..)+  , fromDocuments+  , emptyInMemoryVectorStore+  , norm+  , dotProduct+  , cosineSimilarity+  ) where++import Data.Int (Int64)+import Data.List (sortBy)+import qualified Data.Map.Strict as Map+import Data.Ord (comparing)+import Langchain.DocumentLoader.Core (Document)+import Langchain.Embeddings.Core+import Langchain.VectorStore.Core++{- | Compute dot product of two vectors+Example:++>>> dotProduct [1,2,3] [4,5,6]+32.0+-}+dotProduct :: [Float] -> [Float] -> Float+dotProduct a b = sum $ zipWith (*) a b++{- | Calculate Euclidean norm of a vector+Example:++>>> norm [3,4]+5.0+-}+norm :: [Float] -> Float+norm a = sqrt $ sum $ map (^ (2 :: Int)) a++{- | Calculate cosine similarity between vectors+Example:++>>> cosineSimilarity [1,2] [2,4]+1.0+-}+cosineSimilarity :: [Float] -> [Float] -> Float+cosineSimilarity a b = dotProduct a b / (norm a * norm b)++{- | Create empty in-memory store with embedding model+Example:++>>> emptyInMemoryVectorStore ollamaEmb+InMemory {_embeddingModel = ..., _store = empty}+-}+emptyInMemoryVectorStore :: Embeddings m => m -> InMemory m+emptyInMemoryVectorStore model = InMemory model Map.empty++{- | Initialize store from documents using embeddings+Example:++>>> fromDocuments ollamaEmb [Document "Test" mempty]+Right (InMemory {_store = ...})+-}+fromDocuments :: Embeddings m => m -> [Document] -> IO (Either String (InMemory m))+fromDocuments model docs = do+  let vs = emptyInMemoryVectorStore model+  addDocuments vs docs++{- | In-memory vector store implementation+Stores documents with:++- Embedding model reference+- Map of document IDs to (Document, embedding) pairs+-}+data Embeddings m => InMemory m = InMemory+  { embeddingModel :: m+  , store :: Map.Map Int64 (Document, [Float])+  }+  deriving (Show, Eq)++instance Embeddings m => VectorStore (InMemory m) where+  -- \| Add documents with generated embeddings+  --  Example:+  --+  --  >>> addDocuments inMem [doc1, doc2]+  --  Right (InMemory {_store = ...})+  --+  addDocuments inMem docs = do+    eRes <- embedDocuments (embeddingModel inMem) docs+    case eRes of+      Left err -> pure $ Left err+      Right floats -> do+        let currStore = store inMem+            mbMaxKey = (Map.lookupMax currStore)+            newStore = Map.fromList $ zip [(maybe 1 (\x -> fst x + 1) mbMaxKey) ..] (zip docs floats)+            newInMem = inMem {store = Map.union newStore currStore}+        pure $ Right newInMem++  -- \| Delete documents by ID+  --  Example:+  --+  --  >>> delete inMem [1, 2]+  --  Right (InMemory {_store = ...})+  --+  delete inMem ids = do+    let currStore = store inMem+        newStore = foldl (\acc i -> Map.delete i acc) currStore ids+        newInMem = inMem {store = newStore}+    pure $ Right newInMem++  -- \| Text-based similarity search+  --  Example:+  --+  --  >>> similaritySearch inMem "Haskell" 2+  --  Right [Document "Haskell is...", Document "Functional programming..."]+  --+  similaritySearch vs query k = do+    eQueryEmbedding <- embedQuery (embeddingModel vs) query+    case eQueryEmbedding of+      Left err -> return $ Left err+      Right queryVec -> similaritySearchByVector vs queryVec k++  -- \| Vector-based similarity search+  --  Uses cosine similarity for ranking+  --+  --  Example:+  --+  --  >>> similaritySearchByVector inMem [0.1, 0.3, ...] 3+  --  Right [mostRelevantDoc, ...]+  --+  similaritySearchByVector vs queryVec k = do+    let similarities =+          map+            (\(doc, vec) -> (doc, cosineSimilarity queryVec vec))+            (map snd $ Map.toList $ store vs)+        sorted = sortBy (comparing (negate . snd)) similarities -- Sort in descending order+        topK = take k sorted+    return $ Right $ map fst topK++{-+ghci> let x = OllamaEmbeddings "nomic-embed-text:latest" Nothing Nothing+ghci> let inMem = emptyInMemoryVectorStore x+ghci> eRes <- addDocuments inMem [Document "Hello World" empty, Document "Nice to meet you" empty]+ghci> let newInMem = fromRight inMem eRes+ghci> similaritySearch newInMem "World" 1+Right [Document {pageContent = "Hello World", metadata = fromList []}]+ghci> similaritySearch newInMem "Meet you" 1+Right [Document {pageContent = "Nice to meet you", metadata = fromList []}]+-}++{- $examples+Test case patterns:+1. Document addition+   >>> addDocuments inMem [Document "Test" mempty]+   Right (InMemory {_store = ...})++2. Similarity search+   >>> similaritySearch inMem "World" 1+   Right [Document "Hello World"...]++3. Vector-based search+   >>> similaritySearchByVector inMem [0.5, 0.5] 1+   Right [mostSimilarDoc]+-}
+ test/Spec.hs view
@@ -0,0 +1,42 @@+import qualified Test.Langchain.Agent.Core as AgentTest+import qualified Test.Langchain.Agent.ReactAgent as ReactAgentTest+import qualified Test.Langchain.DocumentLoader.Core as DocumentLoaderTest+import qualified Test.Langchain.Embeddings.Core as EmbeddingsTest+import qualified Test.Langchain.LLM.Core as LLMCoreTest+import qualified Test.Langchain.LLM.Ollama as OllamaLLMTest+import qualified Test.Langchain.Memory.Core as MemoryTest+import qualified Test.Langchain.OutputParser.Core as OutputParserTest+import qualified Test.Langchain.PromptTemplate as PromptTemplateTest+import qualified Test.Langchain.Retriever.Core as RetrieverTest+import qualified Test.Langchain.Runnable.Chains as RunnableChainsTest+import qualified Test.Langchain.Runnable.ConversationChains as ConverationChainsTest+import qualified Test.Langchain.Runnable.Core as RunnableTest+import qualified Test.Langchain.Runnable.Utils as RunnableUtilsTest+import qualified Test.Langchain.TextSplitter.Character as TextSplitterTest+import qualified Test.Langchain.Tool.Core as ToolTest+import qualified Test.Langchain.VectorStore.Core as VectorStoreTest+import Test.Tasty++main :: IO ()+main =+  defaultMain $+    testGroup+      "Langchain"+      [ LLMCoreTest.tests+      , OllamaLLMTest.tests+      , PromptTemplateTest.tests+      , OutputParserTest.tests+      , TextSplitterTest.tests+      , DocumentLoaderTest.tests+      , MemoryTest.tests+      , VectorStoreTest.tests+      , EmbeddingsTest.tests+      , RetrieverTest.tests+      , ToolTest.tests+      , AgentTest.tests+      , ReactAgentTest.tests+      , RunnableTest.tests+      , RunnableUtilsTest.tests+      , RunnableChainsTest.tests+      , ConverationChainsTest.tests+      ]
+ test/Test/Langchain/Agent/Core.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Agent.Core (tests) where++import Control.Exception (throwIO)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Text (Text, isInfixOf, pack)+import Langchain.Agents.Core+import Langchain.LLM.Core+import Langchain.Memory.Core (BaseMemory (..))+import Langchain.PromptTemplate+import Langchain.Tool.Core (Tool (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, testCase)++data DummyTool = DummyTool deriving (Show)++instance Tool DummyTool where+  type Input DummyTool = Text+  type Output DummyTool = Text+  toolName _ = "dummy-tool"+  toolDescription _ = "dummy tool description"+  runTool _ input = return $ "Processed: " <> input++data FaultyTool = FaultyTool deriving (Show)++instance Tool FaultyTool where+  type Input FaultyTool = Text+  type Output FaultyTool = Text+  toolName _ = "faulty-tool"+  toolDescription _ = "fulty tool description"+  runTool _ _ = throwIO $ userError "Intentional tool error"++data StepSequenceAgent = StepSequenceAgent (IORef [AgentStep]) [AnyTool]++instance Agent StepSequenceAgent where+  planNextAction (StepSequenceAgent ref _) _ = do+    steps <- readIORef ref+    case steps of+      [] -> return $ Left "No steps left"+      (step : rest) -> do+        writeIORef ref rest+        return $ Right step+  agentTools (StepSequenceAgent _ tools) = return tools+  agentPrompt _ = return $ PromptTemplate "test prompt"++-- Test Memory Implementation++data TestMemory = TestMemory [Message]++instance BaseMemory TestMemory where+  addMessage (TestMemory msgs) newMsg = return $ Right $ TestMemory (msgs ++ [newMsg])+  addUserMessage (TestMemory msgs) input = do+    let userMsg = Message User input defaultMessageData+    return $ Right $ TestMemory (msgs ++ [userMsg])+  addAiMessage (TestMemory msgs) input = do+    let aiMsg = Message System input defaultMessageData+    return $ Right $ TestMemory (msgs ++ [aiMsg])+  messages (TestMemory msgs) = return $ Right $ NE.fromList msgs+  clear _ = return $ Right (TestMemory [])++tests :: TestTree+tests =+  testGroup+    "Agent Tests"+    [ testCase "executeTool valid tool" $ do+        let dummyAnyTool = customAnyTool DummyTool id id+            tools = [dummyAnyTool]+        result <- executeTool tools "dummy-tool" "test input"+        assertEqual "Should process input" (Right "Processed: test input") result+    , testCase "executeTool tool not found" $ do+        let tools = []+        result <- executeTool tools "unknown-tool" "input"+        assertEqual "Should return tool not found error" (Left "Tool not found: unknown-tool") result+    , testCase "executeTool tool throws exception" $ do+        let faultyAnyTool = customAnyTool FaultyTool id id+            tools = [faultyAnyTool]+        result <- executeTool tools "faulty-tool" "input"+        assertBool+          "Should return execution error"+          ("Intentional tool error" `isInfixOf` (pack $ fromLeft "" result))+    , testCase "runAgentLoop max iterations exceeded" $ do+        agentRef <- newIORef []+        let agent = StepSequenceAgent agentRef []+            initialState = AgentState (TestMemory []) [] []+        result <- runAgentLoop agent initialState 10 5+        assertEqual "Should return max iteration error" (Left "Max iterations excedded") result+    , testCase "runAgent immediate finish" $ do+        agentRef <- newIORef [Finish (AgentFinish (Map.singleton "result" "success") "Finished")]+        let agent = StepSequenceAgent agentRef []+            initialState = AgentState (TestMemory []) [] []+        result <- runAgent agent initialState "input"+        assertEqual+          "Should return finish result"+          (Right (AgentFinish (Map.singleton "result" "success") "Finished"))+          result+    , testCase "runAgentLoop continue then finish" $ do+        agentRef <-+          newIORef+            [ Continue (AgentAction "dummy-tool" "input" "log")+            , Finish (AgentFinish Map.empty "Done")+            ]+        let dummyAnyTool = customAnyTool DummyTool id id+            agent = StepSequenceAgent agentRef [dummyAnyTool]+            initialState = AgentState (TestMemory []) [] []+        result <- runAgentLoop agent initialState 0 10+        assertEqual "Should finish after one step" (Right (AgentFinish Map.empty "Done")) result+    , testCase "customAnyTool wraps correctly" $ do+        let tool = customAnyTool DummyTool id id+            input = "test"+            expectedOutput = "Processed: test"+        result <- executeTool [tool] "dummy-tool" input+        assertEqual "Should apply conversions" (Right expectedOutput) result+    ]+  where+    fromLeft :: a -> Either a b -> a+    fromLeft _ (Left x) = x+    fromLeft def _ = def
+ test/Test/Langchain/Agent/ReactAgent.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Agent.ReactAgent (tests) where++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, assertEqual, assertBool)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.List.NonEmpty as NE+import Langchain.Agents.Core+import Langchain.Agents.React+import Langchain.LLM.Core+import Langchain.Memory.Core (BaseMemory(..))+import Langchain.Tool.Core (Tool(..))++--TODO: Need to fix answering parsing by stripping ": "+data MockLLM = MockLLM { mockResponse :: Text }++instance LLM MockLLM where+  generate _ _ _ = undefined+  chat (MockLLM resp) _ _ = return $ Right resp+  stream _ _ _ _ = undefined++data DummyTool = DummyTool deriving (Show)++instance Tool DummyTool where+  type Input DummyTool = Text+  type Output DummyTool = Text+  toolName _ = "dummy-tool"+  toolDescription _ = "A dummy tool for testing"+  runTool _ input = return $ "Processed: " <> input++data TestMemory = TestMemory [Message]++instance BaseMemory TestMemory where+  addMessage (TestMemory msgs) newMsg = return $ Right $ TestMemory (msgs ++ [newMsg])+  addUserMessage (TestMemory msgs) input = do+    let userMsg = Message User input defaultMessageData+    return $ Right $ TestMemory (msgs ++ [userMsg])+  addAiMessage (TestMemory msgs) input = do+    let aiMsg = Message System input defaultMessageData+    return $ Right $ TestMemory (msgs ++ [aiMsg])+  messages (TestMemory msgs) = return $ return $ NE.fromList msgs+  clear _ = pure $ Right $ TestMemory []++tests :: TestTree+tests = testGroup "React Agent Tests"+  [ testCase "parseReactOutput final answer" $ do+      let input = "Thought: I know the answer\nFinal Answer: Success"+      let result = parseReactOutput input+      case result of+        Right (ReactAgentOutputParser (Finish (AgentFinish vals _))) ->+          assertEqual "Should parse final answer" (Map.singleton "output" ": Success") vals+        _ -> assertBool "Failed to parse final answer" False++  , testCase "parseReactOutput action step" $ do+      let input = "Action: dummy-tool\nAction Input: test input"+      let result = parseReactOutput input+      case result of+        Right (ReactAgentOutputParser (Continue act)) -> do+          assertEqual "Correct tool name" ": dummy-tool" (actionToolName act)+          assertEqual "Correct input" ": test input" (actionInput act)+        _ -> assertBool "Failed to parse action" False++  , testCase "parseReactOutput invalid input" $ do+      let input = "Invalid format"+      let result = parseReactOutput input+      case result of+        Left err -> assertBool "Should return parse error" ("Could not parse" `T.isInfixOf` (T.pack err))+        _ -> assertBool "Should fail on invalid input" False++  , testCase "planNextAction generates action step" $ do+      let llm = MockLLM { mockResponse = "Action: dummy-tool\nAction Input: test" }+      let tools = [customAnyTool DummyTool id id]+      agent <- createReactAgent llm tools+      case agent of+        Left _ -> assertBool "Agent creation failed" False+        Right reactAgent -> do+          let mem = TestMemory [Message User "Solve this" defaultMessageData]+          let state = AgentState mem [] []+          result <- planNextAction reactAgent state+          case result of+            Right (Continue act) -> do+              assertEqual "Correct tool name" ": dummy-tool" (actionToolName act)+              assertEqual "Correct input" ": test" (actionInput act)+            _ -> assertBool "Should generate action step" False++  , testCase "planNextAction final answer" $ do+      let llm = MockLLM { mockResponse = "Final Answer: 42" }+      let tools = []+      agent <- createReactAgent llm tools+      case agent of+        Left _ -> assertBool "Agent creation failed" False+        Right reactAgent -> do+          let mem = TestMemory [Message User "What's the answer?" defaultMessageData]+          let state = AgentState mem [] []+          result <- planNextAction reactAgent state+          case result of+            Right (Finish (AgentFinish vals _)) ->+              assertEqual "Correct final answer" (Map.singleton "output" ": 42") vals+            _ -> assertBool "Should generate final answer" False++  , testCase "createReactAgent prompt formatting" $ do+      let llm = MockLLM { mockResponse = "" }+      let tools = [customAnyTool DummyTool id id]+      agent <- createReactAgent llm tools+      case agent of+        Right ReactAgent {..} -> do+          let expectedTools = "Tool: dummy-tool\nDescription: A dummy tool for testing"+              expectedNames = "dummy-tool"+          assertEqual "Correct tool descriptions" expectedTools (formatToolDescriptions reactTools)+          assertEqual "Correct tool names" expectedNames (formatToolNames reactTools)+        _ -> assertBool "Agent creation failed" False++  , testCase "getLastUserInput retrieves last user message" $ do+      let msgs = NE.fromList [ Message User "First" defaultMessageData+                 , Message Assistant "Response" defaultMessageData+                 , Message User "Last" defaultMessageData ] +      let result = getLastUserInput msgs+      assertEqual "Should get last user input" "Last" result++  , testCase "getLastUserInput no user messages" $ do+      let msgs = NE.fromList [ Message Assistant "Only" defaultMessageData ] +      let result = getLastUserInput msgs+      assertEqual "Should return empty" "" result+  ]+  where+    -- isLeft (Left _) = True+    -- isLeft _ = False
+ test/Test/Langchain/DocumentLoader/Core.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.DocumentLoader.Core (tests) where++import Data.Aeson (Value (..))+import Data.Map (empty, fromList)+import qualified Data.Map as Map+import qualified Data.Text as T+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty+import Test.Tasty.HUnit++import Langchain.DocumentLoader.Core+import Langchain.DocumentLoader.FileLoader++createTestFile :: FilePath -> String -> IO ()+createTestFile path content = writeFile path content++withTestFile :: String -> (FilePath -> IO a) -> IO a+withTestFile content action =+  withSystemTempDirectory "test-doc-loader" $ \dir -> do+    let filePath = dir </> "test-file.txt"+    createTestFile filePath content+    action filePath++documentTests :: TestTree+documentTests =+  testGroup+    "Document Tests"+    [ testCase "Document Semigroup instance should concatenate content and metadata" $ do+        let doc1 = Document "Hello" (fromList [("source", String "file1")])+            doc2 = Document " World" (fromList [("page", Number 1)])+            combined = doc1 <> doc2+        pageContent combined @?= "Hello World"+        metadata combined @?= fromList [("source", String "file1"), ("page", Number 1)]+    , testCase "Document Monoid instance should have identity element" $ do+        let doc = Document "Content" (fromList [("key", String "value")])+        doc <> mempty @?= doc+        mempty <> doc @?= doc+        pageContent mempty @?= ""+        metadata mempty @?= empty+    ]++fileLoaderTests :: TestTree+fileLoaderTests =+  testGroup+    "FileLoader Tests"+    [ testCase "load should return document with file content and metadata" $+        withTestFile "Test content for the file." $ \filePath -> do+          result <- load (FileLoader filePath)+          case result of+            Left err -> assertFailure $ "Expected Right but got Left: " ++ err+            Right docs@(doc : _) -> do+              length docs @?= 1+              pageContent doc @?= "Test content for the file."+              Map.lookup "source" (metadata doc) @?= Just (String $ T.pack filePath)+            Right _ -> assertFailure "Document list is empty"+    , testCase "load should return error for non-existent file" $ do+        result <- load (FileLoader "non-existent-file.txt")+        case result of+          Left err ->+            assertBool+              "Error message should mention file not found"+              (T.isInfixOf "File not found" (T.pack err))+          Right _ -> assertFailure "Expected Left for non-existent file but got Right"+    , testCase "loadAndSplit should split content using defaultCharacterSplitterOps" $+        withTestFile "Paragraph 1\n\nParagraph 2\n\nParagraph 3" $ \filePath -> do+          result <- loadAndSplit (FileLoader filePath)+          case result of+            Left err -> assertFailure $ "Expected Right but got Left: " ++ err+            Right chunks -> do+              chunks @?= ["Paragraph 1", "Paragraph 2", "Paragraph 3"]+    , testCase "loadAndSplit should return error for non-existent file" $ do+        result <- loadAndSplit (FileLoader "non-existent-file.txt")+        case result of+          Left err ->+            assertBool+              "Error message should mention file not found"+              (T.isInfixOf "File not found" (T.pack err))+          Right _ -> assertFailure "Expected Left for non-existent file but got Right"+    , testCase "load should handle empty files" $+        withTestFile "" $ \filePath -> do+          result <- load (FileLoader filePath)+          case result of+            Left err -> assertFailure $ "Expected Right but got Left: " ++ err+            Right docs@(doc : _) -> do+              length docs @?= 1+              pageContent doc @?= ""+            Right _ -> assertFailure "Document list is empty"+    , testCase "load should handle large files" $+        withTestFile (concat $ replicate 1000 "Line of test content\n") $ \filePath -> do+          result <- load (FileLoader filePath)+          case result of+            Left err -> assertFailure $ "Expected Right but got Left: " ++ err+            Right docs@(doc : _) -> do+              length docs @?= 1+              T.length (pageContent doc) @?= 21000 -- 21 chars * 1000+            Right _ -> assertFailure "Document list is empty"+    ]++tests :: TestTree+tests =+  testGroup+    "Langchain.DocumentLoader Tests"+    [ documentTests+    , fileLoaderTests+    ]
+ test/Test/Langchain/Embeddings/Core.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Embeddings.Core (tests) where++-- import Data.Ollama.Embeddings (EmbeddingResp (..))+import Data.Text (isInfixOf, pack)+import Langchain.DocumentLoader.Core+import Langchain.Embeddings.Core+import Langchain.Embeddings.Ollama+import Test.Tasty+import Test.Tasty.HUnit++{-+mockSuccessResponse :: EmbeddingResp+mockSuccessResponse = EmbeddingResp { embedding_ = [[1.0, 2.0, 3.0]] }++mockEmptyResponse :: EmbeddingResp+mockEmptyResponse = EmbeddingResp { embedding_ = [] }+-}++tests :: TestTree+tests =+  testGroup+    "Embedding Tests"+    [ testGroup+        "embedQuery Tests"+        [ testCase "Returns embedding on successful response" $ do+            let embeddings = OllamaEmbeddings "llama3.2:latest" Nothing Nothing+            result <- embedQuery embeddings "test query"+            case result of+              Left err -> assertFailure $ "Expected success, got error: " ++ err+              Right vec -> assertEqual "Correct embedding length" 3072 (length vec)+        , {-+          , testCase "Handles empty embedding response" $ do+              let embeddings = OllamaEmbeddings "nomic-embed-text:latest" Nothing Nothing+              -- Assuming embeddingOps returns Right mockEmptyResponse+              result <- embedQuery embeddings "empty query"+              case result of+                Left err -> assertEqual "Correct error message" "Embeddings are empty" err+                Right _ -> assertFailure ("Expected error for empty embedding")+                -}+          testCase "Propagates API errors" $ do+            let embeddings = OllamaEmbeddings "error-model" Nothing Nothing+            -- Assuming embeddingOps returns Left "API Failure"+            result <- embedQuery embeddings "error query"+            case result of+              Left err -> assertBool "Error message contains 'error'" ("error" `isInfixOf` (pack err))+              Right _ -> assertFailure "Expected API error propagation"+        ]+    , testGroup+        "embedDocuments Tests"+        [ testCase "Processes multiple documents successfully" $ do+            let embeddings = OllamaEmbeddings "llama3.2:latest" Nothing Nothing+                docs = replicate 3 (Document "content" mempty)+            -- Assuming each embeddingOps call returns Right mockSuccessResponse+            result <- embedDocuments embeddings docs+            case result of+              Left err -> assertFailure $ "Unexpected error: " ++ err+              Right vecs -> assertEqual "Correct number of embeddings" 3 (length vecs)+              {-+              , testCase "Handles document processing errors" $ do+                  let embeddings = OllamaEmbeddings "nomic-embed-text:latest" Nothing Nothing+                      docs = [Document "good" mempty, Document "bad" mempty]+                  -- Assuming second embeddingOps call returns Left "Partial Failure"+                  result <- embedDocuments embeddings docs+                  case result of+                    Left err -> assertBool "Error contains 'Partial Failure'" ("Partial Failure" `isInfixOf` (pack err))+                    Right _ -> assertFailure "Expected partial failure error"+              , testCase "Detects empty embeddings in response" $ do+                  let embeddings = OllamaEmbeddings "empty-embed-model" Nothing Nothing+                      docs = [Document "empty" mempty]+                  -- Assuming embeddingOps returns Right mockEmptyResponse+                  result <- embedDocuments embeddings docs+                  case result of+                    Left err -> assertEqual "Correct empty embedding error" "Embeddings are empty" err+                    Right _ -> assertFailure "Expected empty embedding error"+                                  -}+        ]+    ]+
+ test/Test/Langchain/LLM/Core.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Langchain.LLM.Core (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Data.Aeson (Result (..), decode, encode, fromJSON, toJSON)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Langchain.LLM.Core++data TestLLM = TestLLM+  { responseText :: Text+  , shouldSucceed :: Bool+  }++instance LLM TestLLM where+  generate m _ _ =+    pure $+      if shouldSucceed m+        then Right (responseText m)+        else Left "Test error"++  chat m _ _ =+    pure $+      if shouldSucceed m+        then Right (responseText m)+        else Left "Test error"++  stream m _ handler _ = do+    if shouldSucceed m+      then do+        onToken handler (responseText m)+        onComplete handler+        pure (Right ())+      else pure (Left "Test error")++tests :: TestTree+tests =+  testGroup+    "LLMCoreTest"+    [ testGroup+        "Params"+        [ testCase "creates default parameters with all Nothing fields" $ do+            let params = defaultParams+            assertEqual "temperature should be Nothing" Nothing (temperature params)+            assertEqual "maxTokens should be Nothing" Nothing (maxTokens params)+            assertEqual "topP should be Nothing" Nothing (topP params)+            assertEqual "n should be Nothing" Nothing (n params)+            assertEqual "stop should be Nothing" Nothing (stop params)+        , testCase "can override default parameters" $ do+            let params = defaultParams {temperature = Just 0.7, maxTokens = Just 100}+            assertEqual "temperature should be Just 0.7" (Just 0.7) (temperature params)+            assertEqual "maxTokens should be Just 100" (Just 100) (maxTokens params)+            assertEqual "topP should be Nothing" Nothing (topP params)+        ]+    , testGroup+        "Role"+        [ testCase "has correct equality" $ do+            assertEqual "System equals System" System System+            assertEqual "User equals User" User User+            assertEqual "Assistant equals Assistant" Assistant Assistant+            assertEqual "Tool equals Tool" Tool Tool+            assertBool "System should not equal User" (System /= User)+        , testCase "can be converted to and from JSON" $ do+            case fromJSON (toJSON System) of+              Success r -> assertEqual "JSON roundtrip for System" System r+              _ -> assertFailure "JSON conversion failed for System"+            case fromJSON (toJSON User) of+              Success r -> assertEqual "JSON roundtrip for User" User r+              _ -> assertFailure "JSON conversion failed for User"+            case fromJSON (toJSON Assistant) of+              Success r -> assertEqual "JSON roundtrip for Assistant" Assistant r+              _ -> assertFailure "JSON conversion failed for Assistant"+            case fromJSON (toJSON Tool) of+              Success r -> assertEqual "JSON roundtrip for Tool" Tool r+              _ -> assertFailure "JSON conversion failed for Tool"+        ]+    , testGroup+        "Message"+        [ testCase "creates messages with correct fields" $ do+            let msg = Message User "Hello" defaultMessageData+            assertEqual "role should be User" User (role msg)+            assertEqual "content should be 'Hello'" "Hello" (content msg)+            assertEqual "messageData should be default" defaultMessageData (messageData msg)+        , testCase "creates messages with custom message data" $ do+            let customData = defaultMessageData {name = Just "Alice"}+            let msg = Message User "Hello" customData+            assertEqual "role should be User" User (role msg)+            assertEqual "content should be 'Hello'" "Hello" (content msg)+            assertEqual "name should be Just 'Alice'" (Just "Alice") (name (messageData msg))+            assertEqual "toolCalls should be Nothing" Nothing (toolCalls (messageData msg))+        ]+    , testGroup+        "MessageData"+        [ testCase "creates default message data with all Nothing fields" $ do+            let md = defaultMessageData+            assertEqual "name should be Nothing" Nothing (name md)+            assertEqual "toolCalls should be Nothing" Nothing (toolCalls md)+        , testCase "serializes to correct JSON structure" $ do+            let md = MessageData (Just "Alice") (Just ["tool1", "tool2"])+                expected = "{\"name\":\"Alice\",\"tool_calls\":[\"tool1\",\"tool2\"]}"+            assertEqual "JSON encoding of MessageData" expected (encode md)+        , testCase "deserializes from JSON correctly" $ do+            let json = "{\"name\":\"Bob\",\"tool_calls\":[\"tool3\"]}"+                expected = MessageData (Just "Bob") (Just ["tool3"])+            assertEqual "JSON decoding of MessageData" (Just expected) (decode json)+        , testCase "handles partial JSON correctly" $ do+            let json = "{\"name\":\"Charlie\"}"+                expected = MessageData (Just "Charlie") Nothing+            assertEqual "Partial JSON decoding of MessageData" (Just expected) (decode json)+        ]+    , testGroup+        "LLM Typeclass"+        [ testGroup+            "generate"+            [ testCase "returns Right with response for successful generation" $ do+                let successLLM = TestLLM "Success response" True+                result <- generate successLLM "Test prompt" Nothing+                assertEqual "Successful generation" (Right "Success response") result+            , testCase "returns Left with error for failed generation" $ do+                let failureLLM = TestLLM "Failure response" False+                result <- generate failureLLM "Test prompt" Nothing+                assertEqual "Failed generation" (Left "Test error") result+            , testCase "works with custom parameters" $ do+                let successLLM = TestLLM "Success response" True+                    params = defaultParams {temperature = Just 0.5}+                result <- generate successLLM "Test prompt" (Just params)+                assertEqual "Generation with custom params" (Right "Success response") result+            ]+        , testGroup+            "chat"+            [ testCase "returns Right with response for successful chat" $ do+                let successLLM = TestLLM "Success response" True+                    singleMsg = Message User "Test prompt" defaultMessageData+                    chatMsgs = singleMsg :| []+                result <- chat successLLM chatMsgs Nothing+                assertEqual "Successful chat" (Right "Success response") result+            , testCase "returns Left with error for failed chat" $ do+                let failureLLM = TestLLM "Failure response" False+                    singleMsg = Message User "Test prompt" defaultMessageData+                    chatMsgs = singleMsg :| []+                result <- chat failureLLM chatMsgs Nothing+                assertEqual "Failed chat" (Left "Test error") result+            ]+        , testGroup+            "stream"+            [ testCase "calls handlers and returns Right for successful stream" $ do+                let successLLM = TestLLM "Success response" True+                    singleMsg = Message User "Test prompt" defaultMessageData+                    chatMsgs = singleMsg :| []+                    handler =+                      StreamHandler+                        { onToken = \_ -> pure ()+                        , onComplete = pure ()+                        }+                result <- stream successLLM chatMsgs handler Nothing+                assertEqual "Successful stream" (Right ()) result+            , testCase "returns Left with error for failed stream" $ do+                let failureLLM = TestLLM "Failure response" False+                    singleMsg = Message User "Test prompt" defaultMessageData+                    chatMsgs = singleMsg :| []+                    handler =+                      StreamHandler+                        { onToken = \_ -> pure ()+                        , onComplete = pure ()+                        }+                result <- stream failureLLM chatMsgs handler Nothing+                assertEqual "Failed stream" (Left "Test error") result+            ]+        ]+    , testGroup+        "ChatMessage"+        [ testCase "creates non-empty list of messages" $ do+            let msg1 = Message User "Hello" defaultMessageData+                msg2 = Message Assistant "Hi there" defaultMessageData+                chat_ = msg1 :| [msg2]+            assertEqual "ChatMessage length" 2 (length chat_)+        ]+    ]
+ test/Test/Langchain/LLM/Ollama.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Langchain.LLM.Ollama (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Data.IORef+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import qualified Data.Text as T++import Langchain.Callback (Callback, Event (..))+import Langchain.LLM.Core+import Langchain.LLM.Ollama+import qualified Langchain.Runnable.Core as Run++captureEvents :: IO (Callback, IO [Event])+captureEvents = do+  eventsRef <- newIORef []+  let callback event = modifyIORef eventsRef (event :)+  let getEvents = reverse <$> readIORef eventsRef+  return (callback, getEvents)++testModelName :: Text+testModelName = "llama3.2:latest"++tests :: TestTree+tests =+  testGroup+    "Ollama"+    [ testCase "Show instance formats Ollama correctly" $ do+        let ollama = Ollama "llama3" []+        show ollama @?= "Ollama \"llama3\""+    , testCase "generate returns text response for a prompt" $ do+        (callback, getEvents) <- captureEvents+        let ollama = Ollama testModelName [callback]+        let prompt = "What is functional programming?"+        result <- generate ollama prompt Nothing+        case result of+          Left err -> assertFailure $ "Expected success, got error: " ++ err+          Right response -> do+            assertBool "Non-empty response expected" (T.length response > 0)+            events <- getEvents+            assertBool+              "should contain all events"+              (events `shouldContainAll` [LLMStart, LLMEnd])+    , testCase "generate returns error for invalid model" $ do+        (callback, getEvents) <- captureEvents+        let ollama = Ollama "non_existent_model" [callback]+        let prompt = "Hello"+        result <- generate ollama prompt Nothing+        case result of+          Left err -> do+            assertBool "Error should mention model" ("model" `T.isInfixOf` T.pack err)+            events <- getEvents+            assertBool "LLM should tried to be started" (events `shouldContainAll` [LLMStart])+            length (filter isErrorEvent events) @?= 1+          Right _ -> assertFailure "Expected error, but got success"+    , testCase "chat returns text response for messages" $ do+        (callback, getEvents) <- captureEvents+        let ollama = Ollama testModelName [callback]+        let messages = Message User "What's the capital of France?" defaultMessageData :| []+        result <- chat ollama messages Nothing+        case result of+          Left err -> assertFailure $ "Expected success, got error: " ++ err+          Right response -> do+            assertBool "Response should mention Paris" ("paris" `T.isInfixOf` T.toLower response)+            events <- getEvents+            assertBool "LLM should be completed" (events `shouldContainAll` [LLMStart, LLMEnd])+    , testCase "chat handles multi-turn conversations" $ do+        (callback, _) <- captureEvents+        let ollama = Ollama testModelName [callback]+        let messages =+              Message System "You are a helpful assistant." defaultMessageData+                :| [ Message User "What's the capital of France?" defaultMessageData+                   , Message Assistant "The capital of France is Paris." defaultMessageData+                   , Message User "And what about Italy?" defaultMessageData+                   ]+        result <- chat ollama messages Nothing+        case result of+          Left err -> assertFailure $ "Expected success, got error: " ++ err+          Right response -> assertBool "Response should mention Rome" ("rome" `T.isInfixOf` T.toLower response)+    , testCase "stream calls handlers for streaming responses" $ do+        let ollama = Ollama testModelName []+        let messages = Message User "Count from 1 to 5 briefly." defaultMessageData :| []++        tokensRef <- newIORef []+        completedRef <- newIORef False++        let handler =+              StreamHandler+                { onToken = \token -> modifyIORef tokensRef (token :)+                , onComplete = writeIORef completedRef True+                }++        result <- stream ollama messages handler Nothing+        case result of+          Left err -> assertFailure $ "Expected success, got error: " ++ err+          Right () -> do+            tokens <- readIORef tokensRef+            assertBool "Should receive tokens" (not (null tokens))+            completed <- readIORef completedRef+            completed @?= True+    , testCase "invoke calls chat with the input messages" $ do+        let ollama = Ollama testModelName []+        let input = Message User "What is 2+2?" defaultMessageData :| []+        result <- Run.invoke ollama input+        case result of+          Left err -> assertFailure $ "Expected success, got error: " ++ err+          Right response -> assertBool "Should mention 4" ("4" `T.isInfixOf` T.toLower response)+    ]+  where+    isErrorEvent (LLMError _) = True+    isErrorEvent _ = False++    shouldContainAll xs ys = all (`elem` xs) ys
+ test/Test/Langchain/Memory/Core.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Memory.Core (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Langchain.LLM.Core (Message (..), Role (..), defaultMessageData)+import Langchain.Memory.Core+import Langchain.Runnable.Core++import qualified Data.List.NonEmpty as NE+import Data.Text (Text)++systemMsg :: Text -> Message+systemMsg text = Message System text defaultMessageData++userMsg :: Text -> Message+userMsg text = Message User text defaultMessageData++aiMsg :: Text -> Message+aiMsg text = Message Assistant text defaultMessageData++utilityTests :: TestTree+utilityTests =+  testGroup+    "Utility Functions Tests"+    [ testCase "initialChatMessage should create chat with system message" $ do+        let prompt = "You are a helpful assistant"+            result = initialChatMessage prompt+        NE.length result @?= 1+        NE.head result @?= systemMsg prompt+    , testCase "trimChatMessage should keep specified number of messages" $ do+        let msgs = NE.fromList [systemMsg "System", userMsg "User1", aiMsg "AI1", userMsg "User2"]+            trimmed = trimChatMessage 2 msgs+        NE.length trimmed @?= 2+        NE.toList trimmed @?= [aiMsg "AI1", userMsg "User2"]+    , testCase "trimChatMessage should keep all messages if n >= length" $ do+        let msgs = NE.fromList [systemMsg "System", userMsg "User1"]+            trimmed = trimChatMessage 3 msgs+        NE.length trimmed @?= 2+        NE.toList trimmed @?= [systemMsg "System", userMsg "User1"]+    , testCase "trimChatMessage should handle minimum size of 1" $ do+        let msgs = NE.fromList [systemMsg "System", userMsg "User1", aiMsg "AI1"]+            trimmed = trimChatMessage 1 msgs+        NE.length trimmed @?= 1+        NE.toList trimmed @?= [aiMsg "AI1"]+    , testCase "addAndTrim should add message and trim history" $ do+        let msgs = NE.fromList [systemMsg "System", userMsg "User1", aiMsg "AI1"]+            newMsg = userMsg "User2"+            result = addAndTrim 2 newMsg msgs+        NE.length result @?= 2+        NE.toList result @?= [aiMsg "AI1", userMsg "User2"]+    ]++windowBufferMemoryTests :: TestTree+windowBufferMemoryTests =+  testGroup+    "WindowBufferMemory Tests"+    [ testCase "messages should return current messages" $ do+        let initialMsgs = NE.fromList [systemMsg "System"]+            memory = WindowBufferMemory 3 initialMsgs+        result <- messages memory+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right msgs -> msgs @?= initialMsgs+    , testCase "addMessage should add message when under capacity" $ do+        let initialMsgs = NE.fromList [systemMsg "System"]+            memory = WindowBufferMemory 3 initialMsgs+            newMsg = userMsg "User1"+        result <- addMessage memory newMsg+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> NE.toList msgs @?= [systemMsg "System", userMsg "User1"]+    , testCase "addMessage should maintain max window size" $ do+        let initialMsgs = NE.fromList [systemMsg "System", userMsg "User1", aiMsg "AI1"]+            memory = WindowBufferMemory 3 initialMsgs+            newMsg = userMsg "User2"+        result <- addMessage memory newMsg+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> do+                NE.length msgs @?= 3+                NE.toList msgs @?= [userMsg "User1", aiMsg "AI1", userMsg "User2"]+    , testCase "addUserMessage should add message with User role" $ do+        let initialMsgs = NE.fromList [systemMsg "System"]+            memory = WindowBufferMemory 3 initialMsgs+        result <- addUserMessage memory "Hello"+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> do+                NE.length msgs @?= 2+                NE.toList msgs @?= [systemMsg "System", userMsg "Hello"]+    , testCase "addAiMessage should add message with Assistant role" $ do+        let initialMsgs = NE.fromList [systemMsg "System"]+            memory = WindowBufferMemory 3 initialMsgs+        result <- addAiMessage memory "I can help"+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> do+                NE.length msgs @?= 2+                NE.toList msgs @?= [systemMsg "System", aiMsg "I can help"]+    , testCase "clear should reset to just system message" $ do+        let initialMsgs = NE.fromList [systemMsg "System", userMsg "User1", aiMsg "AI1"]+            memory = WindowBufferMemory 3 initialMsgs+        result <- clear memory+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> do+                NE.length msgs @?= 1+                NE.head msgs @?= systemMsg "You are an AI model"+    ]++runnableTests :: TestTree+runnableTests =+  testGroup+    "Runnable Instance Tests"+    [ testCase "invoke should add user message" $ do+        let initialMsgs = NE.fromList [systemMsg "System"]+            memory = WindowBufferMemory 3 initialMsgs+        result <- invoke memory "Test input"+        case result of+          Left err -> assertFailure $ "Expected Right but got Left: " ++ err+          Right newMemory -> do+            msgsResult <- messages newMemory+            case msgsResult of+              Left err -> assertFailure $ "Expected Right but got Left: " ++ err+              Right msgs -> do+                NE.length msgs @?= 2+                NE.toList msgs @?= [systemMsg "System", userMsg "Test input"]+    ]++tests :: TestTree+tests =+  testGroup+    "Langchain.Memory.Core Tests"+    [ utilityTests+    , windowBufferMemoryTests+    , runnableTests+    ]
+ test/Test/Langchain/OutputParser/Core.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.OutputParser.Core (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Data.Aeson+import Data.Text (Text)+import Langchain.OutputParser.Core++data Person = Person+  { name :: Text+  , age :: Int+  }+  deriving (Show, Eq)++instance FromJSON Person where+  parseJSON = withObject "Person" $ \v ->+    Person+      <$> v .: "name"+      <*> v .: "age"++tests :: TestTree+tests =+  testGroup+    "OutputParser Tests"+    [ testCase "Bool parser should parse 'true'" $+        (parse "true" :: Either String Bool) @?= Right True+    , testCase "Bool parser should parse 'True'" $+        (parse "True" :: Either String Bool) @?= Right True+    , testCase "Bool parser should parse 'TRUE'" $+        (parse "TRUE" :: Either String Bool) @?= Right True+    , testCase "Bool parser should parse 'true' with whitespace" $+        (parse "  true  " :: Either String Bool) @?= Right True+    , testCase "Bool parser should parse 'false'" $+        (parse "false" :: Either String Bool) @?= Right False+    , testCase "Bool parser should parse 'False'" $+        (parse "False" :: Either String Bool) @?= Right False+    , testCase "Bool parser should parse 'FALSE'" $+        (parse "FALSE" :: Either String Bool) @?= Right False+    , testCase "Bool parser should parse 'false' with whitespace" $+        (parse "  false  " :: Either String Bool) @?= Right False+    , testCase "Bool parser should fail on invalid input" $+        case parse "not a boolean" :: Either String Bool of+          Left _ -> assertBool "Should be Left" True+          Right _ -> assertFailure "Should have failed parsing"+    , testCase "CommaSeparatedList parser should parse empty string" $+        parse "" @?= Right (CommaSeparatedList [""])+    , testCase "CommaSeparatedList parser should parse single item" $+        parse "item" @?= Right (CommaSeparatedList ["item"])+    , testCase "CommaSeparatedList parser should parse multiple items" $+        parse "item1,item2,item3" @?= Right (CommaSeparatedList ["item1", "item2", "item3"])+    , testCase "CommaSeparatedList parser should trim whitespace" $+        parse " item1 , item2 , item3 " @?= Right (CommaSeparatedList ["item1", "item2", "item3"])+    , testCase "JSONOutputStructure parser should parse valid JSON" $+        parse "{\"name\":\"John\",\"age\":30}" @?= (Right (JSONOutputStructure (Person "John" 30)))+    , testCase "JSONOutputStructure parser should fail on invalid JSON" $+        case parse "{not valid json}" :: Either String (JSONOutputStructure Person) of+          Left _ -> assertBool "Should be Left" True+          Right _ -> assertFailure "Should have failed parsing"+    , testCase "NumberSeparatedList parser should parse numbered list" $+        parse "1. First item\n2. Second item\n3. Third item"+          @?= Right (NumberSeparatedList ["First item", "Second item", "Third item"])+    , testCase "NumberSeparatedList parser should handle whitespace" $+        parse "1.   First item  \n  2.  Second item\n3. Third item"+          @?= Right (NumberSeparatedList ["First item", "Second item", "Third item"])+    , testCase "NumberSeparatedList parser should handle multi-digit numbers" $+        parse "10. First item\n11. Second item\n12. Third item"+          @?= Right (NumberSeparatedList ["First item", "Second item", "Third item"])+    , testCase "NumberSeparatedList parser should handle text before numbered list" $+        parse "Here is a list:\n1. First item\n2. Second item"+          @?= Right (NumberSeparatedList ["First item", "Second item"])+    , testCase "NumberSeparatedList parser should handle whitespace between number and dot" $+        parse "1 . First item\n2 . Second item"+          @?= Right (NumberSeparatedList ["First item", "Second item"])+    , testCase "NumberSeparatedList parser should fail if no numbers are found" $+        case parse "No numbers here, just text" :: Either String NumberSeparatedList of+          Left _ -> assertBool "Should be Left" True+          Right _ -> assertFailure "Should have failed parsing"+    ]
+ test/Test/Langchain/PromptTemplate.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.PromptTemplate (tests) where++import qualified Data.Map.Strict as HM+import qualified Data.Text as T+import Langchain.PromptTemplate+import Langchain.Runnable.Core (invoke)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "PromptTemplate Tests"+    [ testGroup+        "PromptTemplate"+        [ testCase "correctly interpolates all variables" $+            renderPrompt template vars @?= Right "Hello, Alice! Welcome to Wonderland."+        , testCase "handles templates with no variables" $+            let noVarTemplate = PromptTemplate "Hello, world!"+             in renderPrompt noVarTemplate HM.empty @?= Right "Hello, world!"+        , testCase "handles templates with repeated variables" $+            let repeatTemplate = PromptTemplate "{name} likes {food}. {name} eats {food} every day."+                repeatVars = HM.fromList [("name", "Bob"), ("food", "pizza")]+             in renderPrompt repeatTemplate repeatVars @?= Right "Bob likes pizza. Bob eats pizza every day."+        , testCase "returns an error for missing variables" $+            let missingVars = HM.fromList [("name", "Charlie")]+             in case renderPrompt template missingVars of+                  Left err -> "place" `T.isInfixOf` (T.pack err) @? "Expected error to contain 'place'"+                  Right _ -> assertFailure "Expected an error for missing variable"+                  {- TODO: Need to take care of incomplete brace cases+                  , testCase "handles unclosed braces" $+                      let invalidTemplate = PromptTemplate "Hello, {name! Welcome to {place}."+                       in case renderPrompt invalidTemplate vars of+                            Left err -> err @?= "Unclosed brace"+                            Right _ -> assertFailure "Expected an error for unclosed brace"+                  , testCase "handles complex nesting of placeholders" $+                      let complexTemplate = PromptTemplate "{{name}} is not a placeholder but {name} is."+                       in renderPrompt complexTemplate vars @?= Right "{Alice} is not a placeholder but Alice is."+                       -}+        ]+    , testCase "Runnable instance for PromptTemplate - invoke with variables" $ do+        let template1 = PromptTemplate "Hello, {name}!"+            vars1 = HM.fromList [("name", "Dave")]+        result <- invoke template1 vars1+        result @?= Right "Hello, Dave!"+    , testGroup+        "FewShotPromptTemplate"+        [ testCase "correctly formats a few-shot prompt" $+            let expected =+                  "Examples of {type}:\nInput: Hello\nOutput: Bonjour\n\nInput: Goodbye\nOutput: Au revoir\nNow translate: {query}"+             in renderFewShotPrompt fewShotTemplate @?= Right expected+        , testCase "handles empty examples list" $+            let emptyExamples = fewShotTemplate {fsExamples = []}+             in renderFewShotPrompt emptyExamples @?= Right "Examples of {type}:\n\nNow translate: {query}"+        , testCase "handles empty prefix and suffix" $+            let noPreSuf = fewShotTemplate {fsPrefix = "", fsSuffix = ""}+             in renderFewShotPrompt noPreSuf+                  @?= Right "Input: Hello\nOutput: Bonjour\n\nInput: Goodbye\nOutput: Au revoir"+        , testCase "returns an error when example variables are missing" $+            let badExamples =+                  fewShotTemplate+                    { fsExamples = [HM.fromList [("wrong", "value")]]+                    , fsExampleTemplate = "{input} translates to {output}"+                    }+             in case renderFewShotPrompt badExamples of+                  Left err -> "input" `T.isInfixOf` (T.pack err) @? "Expected error to contain 'input'"+                  Right _ -> assertFailure "Expected an error for missing example variable"+        , testCase "correctly uses the example separator" $+            let customSep = fewShotTemplate {fsExampleSeparator = " ### "}+             in renderFewShotPrompt customSep+                  @?= Right+                    "Examples of {type}:\nInput: Hello\nOutput: Bonjour ### Input: Goodbye\nOutput: Au revoir\nNow translate: {query}"+        ]+    ]+  where+    template = PromptTemplate "Hello, {name}! Welcome to {place}."+    vars = HM.fromList [("name", "Alice"), ("place", "Wonderland")]+    fewShotTemplate =+      FewShotPromptTemplate+        { fsPrefix = "Examples of {type}:\n"+        , fsExamples =+            [ HM.fromList [("input", "Hello"), ("output", "Bonjour")]+            , HM.fromList [("input", "Goodbye"), ("output", "Au revoir")]+            ]+        , fsExampleTemplate = "Input: {input}\nOutput: {output}"+        , fsExampleSeparator = "\n\n"+        , fsSuffix = "\nNow translate: {query}"+        }
+ test/Test/Langchain/Retriever/Core.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Retriever.Core (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Langchain.DocumentLoader.Core (Document (..))+import Langchain.LLM.Core (LLM (..))+import Langchain.Retriever.Core (Retriever (..))+import Langchain.Retriever.MultiQueryRetriever++import qualified Data.Map.Strict as HM++data DummyLLM = DummyLLM++--TODO: Add some real world examples here+instance LLM DummyLLM where+  -- When 'generate' is called, we return a fixed response in the format expected by the+  -- NumberSeparatedList parser. For example:+  --+  -- "1. test query 1\n2. test query 2"+  generate _ _ _ = return $ Right "1. test query 1\n2. test query 2"+  chat _ _ _ = return $ Right "dummy chat response"+  stream _ _ _ _ = return $ Right ()++data DummyRetriever = DummyRetriever++instance Retriever DummyRetriever where+  _get_relevant_documents _ query =+    return $ Right [Document (query <> " result") HM.empty]++test_generateQueries :: Assertion+test_generateQueries = do+  let dummyLLM = DummyLLM+      query = "original query"+      numQueriesToGenerate = 2+      includeOriginal = True+      queryPrompt = defaultQueryGenerationPrompt+  result <- generateQueries dummyLLM queryPrompt query numQueriesToGenerate includeOriginal+  case result of+    Left err -> assertFailure ("generateQueries failed with error: " ++ err)+    Right qs -> do+      let expectedQueries =+            [ "original query"+            , "test query 1"+            , "test query 2"+            ]+      length qs @?= 3+      qs @?= expectedQueries++-- Test the MultiQueryRetriever _get_relevant_documents implementation.+test_MultiQueryRetriever :: Assertion+test_MultiQueryRetriever = do+  let dummyLLM = DummyLLM+      dummyRetriever = DummyRetriever+      -- Create a MultiQueryRetriever using the dummy implementations.+      mqRetriever = newMultiQueryRetriever dummyRetriever dummyLLM+      originalQuery = "original query"+  result <- _get_relevant_documents mqRetriever originalQuery+  case result of+    Left err -> assertFailure ("MultiQueryRetriever failed with error: " ++ err)+    Right docs -> do+      -- Since generateQueries returns three queries (original plus two generated),+      -- and DummyRetriever returns one document per query, we expect 3 documents.+      length docs @?= 3+      let contents = map pageContent docs+          expectedContents =+            [ "original query result"+            , "test query 1 result"+            , "test query 2 result"+            ]+      contents @?= expectedContents++tests :: TestTree+tests =+  testGroup+    "Retriever Tests"+    [ testCase "generateQueries returns expected queries" test_generateQueries+    , testCase "MultiQueryRetriever retrieves and combines documents" test_MultiQueryRetriever+    ]
+ test/Test/Langchain/Runnable/Chains.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Runnable.Chains (tests) where++import Langchain.Runnable.Chain+import Langchain.Runnable.Core+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++addOne :: MockRunnable Int Int+addOne = MockRunnable (\x -> return $ Right (x + 1))++multiplyByTwo :: MockRunnable Int Int+multiplyByTwo = MockRunnable (\x -> return $ Right (x * 2))++evenCheck :: MockRunnable Int Bool+evenCheck = MockRunnable (\x -> return $ Right (even x))++failingMock :: MockRunnable a b+failingMock = MockRunnable (\_ -> return $ Left "Mock error")++data MockRunnable a b = MockRunnable {runMock :: a -> IO (Either String b)}++instance Runnable (MockRunnable a b) where+  type RunnableInput (MockRunnable a b) = a+  type RunnableOutput (MockRunnable a b) = b+  invoke = runMock++tests :: TestTree+tests =+  testGroup+    "Runnable Chain Tests"+    [ testGroup+        "RunnableBranch Tests"+        [ testCase "Selects first matching branch" $ do+            let branch1 =+                  RunnableBranch+                    [ ((== 1), addOne)+                    , ((== 2), multiplyByTwo)+                    ]+                    failingMock+            result <- runBranch branch1 1+            assertEqual "Should choose addOne branch" (Right 2) result+        , testCase "Uses default when no conditions match" $ do+            let defaultBranch = RunnableBranch [] addOne+            result <- runBranch defaultBranch 5+            assertEqual "Should use default" (Right 6) result+        ]+    , testGroup+        "RunnableMap Tests"+        [ testCase "Applies input/output transformations" $ do+            let inputMap = (* 2)+                outputMap = (+ 1)+                mapped = RunnableMap inputMap outputMap addOne+            result <- runMap mapped 3 -- 3*2=6 → addOne →7 → +1 →8+            assertEqual "Transformations applied" (Right 8) result+        ]+    , testGroup+        "RunnableSequence Tests"+        [ testCase "Executes sequence in order" $ do+            let sequence0 = buildSequence addOne multiplyByTwo+            result <- runSequence sequence0 2 -- 2+1=3 → *2=6+            assertEqual "Sequence executed" (Right 6) result++            {-+            , testCase "Handles multi-step sequences" $ do+                let sequence_ = (addOne |>> multiplyByTwo) |>> evenCheck+                result <- sequence_ 3 -- 3+1=4 → *2=8 → even → True+                assertEqual "Three-step sequence" (Right True) result+                -}+        ]+    , testGroup+        "Chain Operator Tests"+        [ testCase "Chains two runnables" $ do+            let pipeline = addOne |>> multiplyByTwo+            result <- pipeline 3+            assertEqual "3+1=4 → *2=8" (Right 8) result+        , testCase "Propagates errors in chain" $ do+            let pipeline = failingMock |>> multiplyByTwo+            result <- pipeline ()+            assertEqual "Error in first step" (Left "Mock error") result+        ]+    , testGroup+        "Branch Tests"+        [ testCase "Runs parallel branches" $ do+            result <- branch evenCheck addOne 4+            assertEqual "Both branches run" (Right (True, 5)) result+        , testCase "Handles branch errors" $ do+            result <- branch failingMock addOne 5+            assertEqual "Left error in first branch" (Left "Mock error" :: Either String (Bool, Int)) result+        ]+    ]
+ test/Test/Langchain/Runnable/ConversationChains.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Test.Langchain.Runnable.ConversationChains (tests) where++import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import Langchain.LLM.Core+import Langchain.Memory.Core (BaseMemory (..))+import Langchain.PromptTemplate (PromptTemplate (..))+import Langchain.Runnable.ConversationChain+import Langchain.Runnable.Core+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase, (@?=))++data TestMemory = TestMemory (IORef [Message])++instance BaseMemory TestMemory where+  addUserMessage (TestMemory ref) input = do+    let userMsg = Message User input defaultMessageData+    modifyIORef ref (++ [userMsg])+    return $ Right (TestMemory ref)++  addAiMessage (TestMemory ref) response = do+    let aiMsg = Message Assistant response defaultMessageData+    modifyIORef ref (++ [aiMsg])+    return $ Right (TestMemory ref)++  addMessage (TestMemory ref) msg = do+    modifyIORef ref (++ [msg])+    return $ Right (TestMemory ref)++  clear (TestMemory ref) = do+    (modifyIORef ref (const []))+    return $ Right $ TestMemory ref++  messages (TestMemory ref) = fmap Right (NE.fromList <$> readIORef ref)++data FailingMemory = FailingMemory++instance BaseMemory FailingMemory where+  addUserMessage _ _ = return $ Left "Memory error"+  addAiMessage _ _ = return $ Left "Memory error"+  messages _ = return $ Left "memory error"+  addMessage _ _ = return $ Left "memory error"+  clear _ = return $ Left "memory error"++data MockLLM = MockLLM+  { llmResponse :: Either String Text+  , receivedMessages :: IORef [Message]+  }++instance LLM MockLLM where+  chat llm0 (msgs :: NonEmpty Message) _ = do+    writeIORef (receivedMessages llm0) (NE.toList msgs)+    return (llmResponse llm0)+  generate = undefined+  stream = undefined++tests :: TestTree+tests =+  testGroup+    "ConversationChain Tests"+    [ testCase "Basic conversation flow" $ do+        memRef <- newIORef []+        let testMem = TestMemory memRef+        msgRef <- newIORef []+        let mockLLM = MockLLM (Right "Hello!") msgRef+            chain = ConversationChain testMem mockLLM (PromptTemplate "")+        result <- invoke chain "Hi"+        result @?= Right "Hello!"+        -- Verify LLM received correct messages+        received <- readIORef msgRef+        assertEqual "LLM received user message" [Message User "Hi" defaultMessageData] received+        -- Verify memory contains both messages+        mem <- readIORef memRef+        assertEqual+          "Memory has user and AI messages"+          [ Message User "Hi" defaultMessageData+          , Message Assistant "Hello!" defaultMessageData+          ]+          mem+    , testCase "Error adding user message" $ do+        nRef <- newIORef []+        let failingMem = FailingMemory+            mockLLM = MockLLM (Right "") nRef+            chain = ConversationChain failingMem mockLLM (PromptTemplate "")+        result <- invoke chain "Hi"+        result @?= Left "Memory error"+    , testCase "LLM returns error" $ do+        memRef <- newIORef []+        let testMem = TestMemory memRef+        msgRef <- newIORef []+        let mockLLM = MockLLM (Left "LLM error") msgRef+            chain = ConversationChain testMem mockLLM (PromptTemplate "")+        result <- invoke chain "Hi"+        result @?= Left "LLM error"+        -- Verify only user message in memory+        mem <- readIORef memRef+        assertEqual "Only user message in memory" [Message User "Hi" defaultMessageData] mem+    , testCase "Memory update after response" $ do+        memRef <- newIORef []+        nRef <- newIORef []+        let testMem = TestMemory memRef+            mockLLM = MockLLM (Right "Response") nRef+            chain = ConversationChain testMem mockLLM (PromptTemplate "")+        _ <- invoke chain "Test"+        mem <- readIORef memRef+        assertEqual "Memory contains both messages" 2 (length mem)+    ]
+ test/Test/Langchain/Runnable/Core.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Runnable.Core (tests) where++import Data.IORef (modifyIORef, newIORef, readIORef)+import Langchain.Runnable.Core+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++data MockRunnable a b = MockRunnable+  { runMock :: a -> IO (Either String b)+  }++instance Runnable (MockRunnable a b) where+  type RunnableInput (MockRunnable a b) = a+  type RunnableOutput (MockRunnable a b) = b+  invoke = runMock++tests :: TestTree+tests =+  testGroup+    "Runnable Tests"+    [ testCase "invoke success" $ do+        let mock = MockRunnable (\(s :: String) -> return $ Right (s ++ " processed"))+        result <- invoke mock "input"+        assertEqual "Should process input" (Right "input processed") result+    , testCase "invoke error" $ do+        let mock = MockRunnable (\(_ :: String) -> return $ Left "mock error")+        result <- invoke mock "input"+        assertEqual "Should return error" (Left "mock error" :: Either String String) result+    , testCase "batch success" $ do+        let mock = MockRunnable (\(s :: String) -> return $ Right (s ++ "!"))+        result <- batch mock ["a", "b", "c"]+        assertEqual "All inputs processed" (Right ["a!", "b!", "c!"]) result+    , testCase "batch with error" $ do+        let mock = MockRunnable $ \(s :: String) ->+              if s == "b"+                then return (Left "error in batch")+                else return (Right (s ++ "!"))+        result <- batch mock ["a", "b", "c"]+        assertEqual "Should return first error" (Left "error in batch") result+    , testCase "stream success" $ do+        ref <- newIORef []+        let mock = MockRunnable (\(s :: String) -> return $ Right (s ++ "!"))+            callback x = modifyIORef ref (++ [x])+        result <- stream mock "test" callback+        readRef <- readIORef ref+        assertEqual "Stream should succeed" (Right ()) result+        assertEqual "Callback called with correct value" ["test!"] readRef+    , testCase "stream error" $ do+        ref <- newIORef []+        let mock = MockRunnable (\(_ :: String) -> return $ Left "stream error")+            callback _ = modifyIORef ref (const ["should not be called" :: String])+        result <- stream mock "test" callback+        readRef <- readIORef ref+        assertEqual "Stream should return error" (Left "stream error") result+        assertEqual "Callback not called" [] readRef+    ]
+ test/Test/Langchain/Runnable/Utils.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Runnable.Utils (tests) where++import Control.Concurrent (threadDelay)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef)+import Langchain.Runnable.Core+import Langchain.Runnable.Utils+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++data InvocationCounter a b = InvocationCounter (IORef Int) (a -> IO (Either String b))++instance Runnable (InvocationCounter a b) where+  type RunnableInput (InvocationCounter a b) = a+  type RunnableOutput (InvocationCounter a b) = b+  invoke (InvocationCounter counter f) input = do+    modifyIORef counter (+ 1)+    f input++tests :: TestTree+tests =+  testGroup+    "Runnable Utils Tests"+    [ testGroup+        "WithConfig Tests"+        [ testCase "WithConfig delegates to underlying runnable" $ do+            let mock = MockRunnable (\s -> return $ Right (s ++ " processed"))+                config = WithConfig mock ()+            result <- invoke config "input"+            assertEqual "Should delegate to mock" (Right "input processed") result+        ]+    , testGroup+        "Cached Tests"+        [ testCase "Cached returns cached result on second call" $ do+            counter <- newIORef 0+            let mock = InvocationCounter counter (\s -> return $ Right (s ++ "!"))+            cachedMock <- cached mock+            result1 <- invoke cachedMock "test"+            _ <- readIORef counter+            result2 <- invoke cachedMock "test"+            count2 <- readIORef counter+            assertEqual "First call result" (Right "test!") result1+            assertEqual "Second call result" (Right "test!") result2+            assertEqual "Only one invocation" 1 count2+        , testCase "Cached handles different inputs separately" $ do+            counter <- newIORef 0+            let mock = InvocationCounter counter (\s -> return $ Right (s ++ "!"))+            cachedMock <- cached mock+            _ <- invoke cachedMock "test1"+            _ <- invoke cachedMock "test2"+            count <- readIORef counter+            assertEqual "Two separate invocations" 2 count+        ]+    , testGroup+        "Retry Tests"+        [ testCase "Retry succeeds after one failure" $ do+            counter <- newIORef 0+            let mock = InvocationCounter counter $ \_ -> do+                  cnt <- readIORef counter+                  if cnt < 1+                    then return $ Left "Error"+                    else return $ Right ("Success" :: String)+                retryMock = Retry mock 3 5000 -- 1 retry, 5ms delay+            result <- invoke retryMock ("input" :: String)+            cnt <- readIORef counter+            assertEqual "Retry succeeds" (Right "Success") result+            assertEqual "Invoked twice" 1 cnt+        , testCase "Retry exhausts retries and fails" $ do+            counter <- newIORef 0+            let mock = InvocationCounter counter (\_ -> return $ Left "Error")+                retryMock = Retry mock 2 1000 -- 2 retries+            result <- invoke retryMock ("input" :: String)+            cnt <- readIORef counter+            assertEqual "All retries exhausted" (Left "Error" :: Either String String) result+            assertEqual "Three attempts made" 3 cnt+        ]+    , testGroup+        "WithTimeout Tests"+        [ testCase "WithTimeout returns result before timeout" $ do+            let mock = MockRunnable (\_ -> return $ Right "Quick response")+                timeoutMock = WithTimeout mock 100000 -- 100ms timeout+            result <- invoke timeoutMock ("input" :: String)+            assertEqual "Returns result" (Right ("Quick response" :: String)) result+        , testCase "WithTimeout triggers timeout error" $ do+            let mock = MockRunnable $ \_ -> do+                  threadDelay 200000 -- 200ms delay+                  return $ Right "Too slow"+                timeoutMock = WithTimeout mock 100000 -- 100ms timeout+            result <- invoke timeoutMock ("input" :: String)+            assertEqual "Timeout error" (Left "Operation timed out" :: Either String String) result+        ]+    ]++data MockRunnable a b = MockRunnable {runMock :: a -> IO (Either String b)}++instance Runnable (MockRunnable a b) where+  type RunnableInput (MockRunnable a b) = a+  type RunnableOutput (MockRunnable a b) = b+  invoke = runMock
+ test/Test/Langchain/TextSplitter/Character.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.TextSplitter.Character (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Langchain.TextSplitter.Character++tests :: TestTree+tests =+  testGroup+    "Langchain.TextSplitter.Character Tests"+    [ testCase "defaultCharacterSplitterOps should have correct values" $ do+        chunkSize defaultCharacterSplitterOps @?= 100+        separator defaultCharacterSplitterOps @?= "\n\n"+    , testCase "splitText should return empty list for empty text" $+        splitText defaultCharacterSplitterOps "" @?= []+    , testCase "splitText should keep text as single chunk if smaller than chunk size" $ do+        let text = "This is a small text"+            ops = defaultCharacterSplitterOps+        splitText ops text @?= [text]+    , testCase "splitText should split text by separator" $ do+        let text = "Paragraph 1\n\nParagraph 2\n\nParagraph 3"+            ops = defaultCharacterSplitterOps+        splitText ops text @?= ["Paragraph 1", "Paragraph 2", "Paragraph 3"]+    , testCase "splitText should split text by chunk size" $ do+        let text =+              "This is a very long text that should be split into chunks because it exceeds the chunk size limit."+            ops = CharacterSplitterOps {chunkSize = 20, separator = "\n\n"}+        splitText ops text+          @?= [ "This is a very long "+              , "text that should be "+              , "split into chunks be"+              , "cause it exceeds the"+              , " chunk size limit."+              ]+    , testCase "splitText should handle both separator and chunk size" $ do+        let text =+              "First paragraph that is quite long.\n\nSecond paragraph that is also very long and should be split."+            ops = CharacterSplitterOps {chunkSize = 20, separator = "\n\n"}+        splitText ops text+          @?= [ "First paragraph that"+              , " is quite long."+              , "Second paragraph tha"+              , "t is also very long "+              , "and should be split."+              ]+    , testCase "splitText should work with custom separator" $ do+        let text = "Item 1|Item 2|Item 3|Item 4"+            ops = CharacterSplitterOps {chunkSize = 100, separator = "|"}+        splitText ops text @?= ["Item 1", "Item 2", "Item 3", "Item 4"]+    , testCase "splitText should handle text with no separators" $ do+        let text =+              "ThisisasinglewordwithoutanyseparatorsthatshouldstillbesplitintochunksbasedonthechunksizeAlthoughithasnoseparatorsitcanstillbesplitproperly"+            ops = CharacterSplitterOps {chunkSize = 20, separator = "|"}+        splitText ops text+          @?= [ "Thisisasinglewordwit"+              , "houtanyseparatorstha"+              , "tshouldstillbespliti"+              , "ntochunksbasedonthec"+              , "hunksizeAlthoughitha"+              , "snoseparatorsitcanst"+              , "illbesplitproperly"+              ]+    , testCase "splitText should handle multiple adjacent separators" $ do+        let text = "Item 1\n\n\n\nItem 2\n\nItem 3"+            ops = defaultCharacterSplitterOps+        splitText ops text @?= ["Item 1", "Item 2", "Item 3"]+    , testCase "splitText should handle text starting with separators" $ do+        let text = "\n\nItem 1\n\nItem 2"+            ops = defaultCharacterSplitterOps+        splitText ops text @?= ["Item 1", "Item 2"]+    , testCase "splitText should handle text ending with separators" $ do+        let text = "Item 1\n\nItem 2\n\n"+            ops = defaultCharacterSplitterOps+        splitText ops text @?= ["Item 1", "Item 2"]+    , testCase "splitText should handle small chunk size" $ do+        let text = "abc"+            ops = CharacterSplitterOps {chunkSize = 1, separator = "\n\n"}+        splitText ops text @?= ["a", "b", "c"]+    , testCase "splitText should handle chunk size zero" $ do+        let text = "test"+            ops = CharacterSplitterOps {chunkSize = 0, separator = "\n\n"}+        splitText ops text @?= []+    , testCase "splitText should handle empty separator" $ do+        let text = "test"+            ops = CharacterSplitterOps {chunkSize = 2, separator = ""}+        splitText ops text @?= ["te", "st"]+    ]
+ test/Test/Langchain/Tool/Core.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Tool.Core (tests) where++import Data.Aeson (decode)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Test.Tasty+import Test.Tasty.HUnit++import Langchain.Tool.Core+import Langchain.Tool.WebScraper+import Langchain.Tool.WikipediaTool++data MockTool = MockTool Text+  deriving (Show, Eq)++instance Tool MockTool where+  type Input MockTool = Text+  type Output MockTool = Text+  toolName (MockTool name) = name+  toolDescription _ = "A mock tool for testing"+  runTool _ input = return $ "Processed: " <> input++tests :: TestTree+tests =+  testGroup+    "Tool Tests"+    [ testCase "MockTool implements Tool interface correctly" testMockTool+    , testCase "WikipediaTool default values" testWikipediaToolDefaults+    , testCase "WikipediaTool tool name and description" testWikipediaToolMetadata+    , testCase "WikipediaTool search functionality" testWikipediaToolSearch+    , testCase "SearchResponse parsing" testSearchResponseParsing+    , testCase "PageResponse parsing" testPageResponseParsing+    , testCase "WebScraper Tool" testWebScraperTool+    ]++testWebScraperTool :: Assertion+testWebScraperTool = do+  r <- runTool WebScraper "https://hackage.haskell.org/package/scalpel-0.6.2.2"+  assertBool "Scraper should contain stuff like title" $+    T.isInfixOf "scalpel: A high level web scraping library for Haskell" r++testMockTool :: Assertion+testMockTool = do+  let mockTool = MockTool "TestTool"++  assertEqual "toolName should return the name" "TestTool" (toolName mockTool)++  assertEqual+    "toolDescription should return description"+    "A mock tool for testing"+    (toolDescription mockTool)++  result <- runTool mockTool "test input"+  assertEqual+    "runTool should process input correctly"+    "Processed: test input"+    result++testWikipediaToolDefaults :: Assertion+testWikipediaToolDefaults = do+  let tool = defaultWikipediaTool++  assertEqual+    "Default topK should be 2"+    defaultTopK+    (topK tool)++  assertEqual+    "Default docMaxChars should be 2000"+    defaultDocMaxChars+    (docMaxChars tool)++  assertEqual+    "Default language code should be 'en'"+    defaultLanguageCode+    (languageCode tool)++testWikipediaToolMetadata :: Assertion+testWikipediaToolMetadata = do+  let tool = defaultWikipediaTool++  assertEqual+    "WikipediaTool name should be 'Wikipedia'"+    "Wikipedia"+    (toolName tool)++  assertBool+    "WikipediaTool description should mention Wikipedia"+    (T.isInfixOf "Wikipedia" (toolDescription tool))++-- TODO: Actually use the WikipediaTool here+testWikipediaToolSearch :: Assertion+testWikipediaToolSearch = do+  let customTool =+        WikipediaTool+          { topK = 1+          , docMaxChars = 10+          , languageCode = "en"+          }++  assertEqual "Custom tool should have topK = 1" 1 (topK customTool)+  assertEqual "Custom tool should truncate to 10 chars" 10 (docMaxChars customTool)++-- Test JSON parsing for SearchResponse+testSearchResponseParsing :: Assertion+testSearchResponseParsing = do+  let jsonStr =+        "{\"query\": {\"search\": [{\"ns\": 0, \"title\": \"Haskell\", \"pageid\": 12345, \"size\": 1000, \"wordcount\": 200, \"snippet\": \"<span>Haskell</span> is a functional language\", \"timestamp\": \"2023-01-01\"}]}}"+      parsed = decode jsonStr :: Maybe SearchResponse++  case parsed of+    Nothing -> assertFailure "Failed to parse SearchResponse JSON"+    Just SearchResponse {..} -> do+      let searchResults = search query+      assertBool "Should have at least one search result" (not $ null searchResults)+      case searchResults of+        (firstResult : _) -> do+          assertEqual "Page ID should match" 12345 (pageid firstResult)+          assertEqual "Title should match" "Haskell" (title_ firstResult)+        _ -> pure ()++testPageResponseParsing :: Assertion+testPageResponseParsing = do+  let jsonStr =+        "{\"query\": {\"pages\": {\"12345\": {\"title\": \"Haskell\", \"extract\": \"Haskell is a functional programming language.\"}}}}"+      parsed = decode jsonStr :: Maybe PageResponse++  case parsed of+    Nothing -> assertFailure "Failed to parse PageResponse JSON"+    Just (PageResponse (Pages pagesMap)) -> do+      let maybePage = M.lookup "12345" pagesMap+      case maybePage of+        Nothing -> assertFailure "Expected page with ID 12345 not found"+        Just page -> do+          assertEqual "Page title should match" "Haskell" (title page)+          assertEqual+            "Page extract should match"+            "Haskell is a functional programming language."+            (extract page)
+ test/Test/Langchain/VectorStore/Core.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.VectorStore.Core (tests) where++import Data.Either (fromRight, isRight)+import Data.Int (Int64)+import Data.Map (empty)+import qualified Data.Map.Strict as Map+import Test.Tasty+import Test.Tasty.HUnit++import Data.Maybe (fromMaybe, listToMaybe)+import Langchain.DocumentLoader.Core (Document (..))+import Langchain.Embeddings.Core+import Langchain.VectorStore.Core+import Langchain.VectorStore.InMemory++data MockEmbeddings = MockEmbeddings+  deriving (Show, Eq)++instance Embeddings MockEmbeddings where+  embedQuery _ "World" = pure $ Right [1.0, 0.1, 0.1]+  embedQuery _ "Meet you" = pure $ Right [0.1, 0.1, 1.0]+  embedQuery _ "Both" = pure $ Right [0.5, 0.5, 0.5]+  embedQuery _ _ = pure $ Right [0.0, 0.0, 0.0]++  embedDocuments _ docs = pure $ Right $ map determineEmbedding docs+    where+      determineEmbedding doc+        | doc == Document "Hello World" empty = [1.0, 0.1, 0.1]+        | doc == Document "Nice to meet you" empty = [0.1, 0.1, 1.0]+        | doc == Document "Something completely different" empty = [0.3, 0.3, 0.3]+        | otherwise = [0.0, 0.0, 0.0]++createTestDocs :: [Document]+createTestDocs =+  [ Document "Hello World" empty+  , Document "Nice to meet you" empty+  ]++utilityTests :: TestTree+utilityTests =+  testGroup+    "Utility Functions Tests"+    [ testCase "dotProduct should compute correct dot product" $ do+        dotProduct [1.0, 2.0, 3.0] [4.0, 5.0, 6.0] @?= 32.0+    , testCase "norm should compute correct Euclidean norm" $ do+        norm [3.0, 4.0] @?= 5.0+    , testCase "cosineSimilarity should compute correct similarity" $ do+        assertBool+          "Expected near same similarity"+          ((cosineSimilarity [1.0, 2.0, 3.0] [1.0, 2.0, 3.0]) >= 0.999999)++        let similarity = cosineSimilarity [1.0, 0.0, 0.0] [0.0, 1.0, 0.0]+        assertBool "Expected near 0" (abs similarity < 0.000001)++        let oppSimilarity = cosineSimilarity [1.0, 2.0, 3.0] [-1.0, -2.0, -3.0]+        assertBool "Expected near -1" (abs (oppSimilarity + 1.0) < 0.000001)+    ]++inMemoryTests :: TestTree+inMemoryTests =+  testGroup+    "InMemory VectorStore Tests"+    [ testCase "emptyInMemoryVectorStore should create empty store" $ do+        let model = MockEmbeddings+            vs = emptyInMemoryVectorStore model+        Map.size (store vs) @?= 0+        embeddingModel vs @?= model+    , testCase "fromDocuments should create store with documents" $ do+        let model = MockEmbeddings+            docs = createTestDocs+        result <- fromDocuments model docs+        assertBool "Expected Right result" (isRight result)+        let vs = fromRight (emptyInMemoryVectorStore model) result+        Map.size (store vs) @?= 2+    , testCase "addDocuments should add documents to store" $ do+        let model = MockEmbeddings+            vs = emptyInMemoryVectorStore model+            docs = createTestDocs+        result <- addDocuments vs docs+        assertBool "Expected Right result" (isRight result)+        let updatedVs = fromRight vs result+        Map.size (store updatedVs) @?= 2++        let newDoc = Document "Something completely different" empty+        result2 <- addDocuments updatedVs [newDoc]+        assertBool "Expected Right result" (isRight result2)+        let finalVs = fromRight updatedVs result2+        Map.size (store finalVs) @?= 3+    , testCase "delete should remove documents from store" $ do+        let model = MockEmbeddings+            vs = emptyInMemoryVectorStore model+            docs = createTestDocs+        result <- addDocuments vs docs+        let updatedVs = fromRight vs result++        deleteResult <- delete updatedVs [1]+        assertBool "Expected Right result" (isRight deleteResult)+        let afterDeleteVs = fromRight updatedVs deleteResult+        Map.size (store afterDeleteVs) @?= 1+        Map.member (1 :: Int64) (store afterDeleteVs) @?= False+        Map.member (2 :: Int64) (store afterDeleteVs) @?= True+    , testCase "similaritySearch should find similar documents" $ do+        let model = MockEmbeddings+            vs = emptyInMemoryVectorStore model+            docs = createTestDocs+        result <- addDocuments vs docs+        let updatedVs = fromRight vs result++        -- Search for "World" - should return "Hello World"+        searchResult1 <- similaritySearch updatedVs "World" 1+        assertBool "Expected Right result" (isRight searchResult1)+        let docs1 = fromRight [] searchResult1+        length docs1 @?= 1+        fromMaybe (Document "" empty) (listToMaybe docs1) @?= Document "Hello World" empty++        -- Search for "Meet you" - should return "Nice to meet you"+        searchResult2 <- similaritySearch updatedVs "Meet you" 1+        assertBool "Expected Right result" (isRight searchResult2)+        let docs2 = fromRight [] searchResult2+        length docs2 @?= 1+        fromMaybe (Document "" empty) (listToMaybe docs2) @?= Document "Nice to meet you" empty++        -- Search for both documents+        searchResult3 <- similaritySearch updatedVs "Both" 2+        assertBool "Expected Right result" (isRight searchResult3)+        let docs3 = fromRight [] searchResult3+        length docs3 @?= 2+    , testCase "similaritySearchByVector should find similar documents" $ do+        let model = MockEmbeddings+            vs = emptyInMemoryVectorStore model+            docs = createTestDocs+        result <- addDocuments vs docs+        let updatedVs = fromRight vs result++        -- Search with vector similar to "Hello World"+        searchResult1 <- similaritySearchByVector updatedVs [1.0, 0.1, 0.1] 1+        assertBool "Expected Right result" (isRight searchResult1)+        let docs1 = fromRight [] searchResult1+        length docs1 @?= 1+        fromMaybe (Document "" empty) (listToMaybe docs1) @?= Document "Hello World" empty++        -- Search with vector similar to "Nice to meet you"+        searchResult2 <- similaritySearchByVector updatedVs [0.1, 0.1, 1.0] 1+        assertBool "Expected Right result" (isRight searchResult2)+        let docs2 = fromRight [] searchResult2+        length docs2 @?= 1+        fromMaybe (Document "" empty) (listToMaybe docs2) @?= Document "Nice to meet you" empty+    ]++tests :: TestTree+tests =+  testGroup+    "Langchain.VectorStore Tests"+    [ utilityTests+    , inMemoryTests+    ]