langchain-hs 0.0.5.0 → 0.0.6.0

raw patch · 113 files changed

+974/−12625 lines, 113 filesdep −aeson-qqdep −format-heavydep −http-clientdep ~aesondep ~asyncdep ~bytestringsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: aeson-qq, format-heavy, http-client, http-client-tls, http-conduit, http-types, ollama-haskell, openai, process, random, scientific, servant, servant-client, servant-client-core, servant-conduit, servant-event-stream, sqlite-simple, transformers, wai, warp

Dependency ranges changed: aeson, async, bytestring, conduit, containers, directory, filepath, langchain-hs-core, langchain-hs-graph, mtl, resourcet, stm, text, time, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +47/−1
• README.md +177/−186
• Setup.hs +0/−3
• langchain-hs.cabal +87/−155
• src/Langchain/Agent/PlanAndExecute.hs +0/−198
• src/Langchain/Agent/ReAct.hs +0/−107
• src/Langchain/Cache/Core.hs +0/−255
• src/Langchain/Callback/Manager.hs +0/−100
• src/Langchain/Chain/MapReduce.hs +0/−99
• src/Langchain/Chain/RetrievalQA.hs +0/−75
• src/Langchain/DocumentLoader/Core.hs +0/−57
• src/Langchain/DocumentLoader/Csv.hs +0/−127
• src/Langchain/DocumentLoader/DirectoryLoader.hs +0/−125
• src/Langchain/DocumentLoader/FileLoader.hs +0/−76
• src/Langchain/Embeddings/Core.hs +0/−38
• src/Langchain/Embeddings/Ollama.hs +0/−75
• src/Langchain/Embeddings/OpenAI.hs +0/−221
• src/Langchain/Guardrail/Core.hs +0/−143
• src/Langchain/MCP/Client.hs +0/−305
• src/Langchain/Memory/Core.hs +0/−173
• src/Langchain/Memory/Entity.hs +0/−99
• src/Langchain/Memory/Summary.hs +0/−103
• src/Langchain/Observability.hs +0/−275
• src/Langchain/OutputParser/Core.hs +0/−241
• src/Langchain/OutputParser/Structured.hs +0/−348
• src/Langchain/Prelude.hs +0/−439
• src/Langchain/PromptTemplate/Chat.hs +0/−25
• src/Langchain/PromptTemplate/Chat/ChatPromptTemplate.hs +0/−451
• src/Langchain/PromptTemplate/Chat/MessagesPlaceholder.hs +0/−98
• src/Langchain/PromptTemplate/FewShot.hs +0/−47
• src/Langchain/PromptTemplate/Prompt.hs +0/−104
• src/Langchain/PromptTemplate/String.hs +0/−104
• src/Langchain/Provider/Gemini.hs +0/−483
• src/Langchain/Provider/Ollama.hs +0/−396
• src/Langchain/Provider/OpenAI.hs +0/−608
• src/Langchain/Resilience/CircuitBreaker.hs +0/−119
• src/Langchain/Resilience/Retry.hs +0/−114
• src/Langchain/Retriever/BM25.hs +0/−151
• src/Langchain/Retriever/Core.hs +0/−66
• src/Langchain/Retriever/Hybrid.hs +0/−155
• src/Langchain/TextSplitter/Character.hs +0/−111
• src/Langchain/TextSplitter/Code.hs +0/−167
• src/Langchain/TextSplitter/Markdown.hs +0/−137
• src/Langchain/TextSplitter/RecursiveCharacter.hs +0/−96
• src/Langchain/TextSplitter/Token.hs +0/−90
• src/Langchain/Tool/Async.hs +0/−70
• src/Langchain/Tool/Binding.hs +0/−49
• src/Langchain/Tool/Calculator.hs +0/−68
• src/Langchain/Tool/Core.hs +0/−17
• src/Langchain/Tool/FileSystem.hs +0/−107
• src/Langchain/Tool/GenericSchema.hs +0/−175
• src/Langchain/Tool/Shell.hs +0/−71
• src/Langchain/VectorStore/Core.hs +0/−56
• src/Langchain/VectorStore/InMemory.hs +0/−99
• src/Langchain/VectorStore/SqliteVec.hs +0/−147
• test/Spec.hs +7/−81
• test/Test/Langchain/Agent/AdvancedAgentsSpec.hs +1/−1
• test/Test/Langchain/Agent/ReAct.hs +99/−38
• test/Test/Langchain/Cache/CacheSpec.hs +2/−84
• test/Test/Langchain/Callback/CallbackManagerSpec.hs +0/−27
• test/Test/Langchain/Chain/ChainsSpec.hs +0/−27
• test/Test/Langchain/Chain/RetrievalQASpec.hs +2/−2
• test/Test/Langchain/DocumentLoader/Core.hs +8/−0
• test/Test/Langchain/DocumentLoader/CsvSpec.hs +0/−35
• test/Test/Langchain/Error.hs +1/−1
• test/Test/Langchain/Graph/CompilationSpec.hs +1/−1
• test/Test/Langchain/Integration/FullRagE2ESpec.hs +0/−65
• test/Test/Langchain/Integration/OllamaChatSpec.hs +0/−46
• test/Test/Langchain/Integration/OllamaEmbeddingSpec.hs +0/−40
• test/Test/Langchain/Integration/OllamaStreamSpec.hs +0/−49
• test/Test/Langchain/Integration/OllamaToolSpec.hs +0/−92
• test/Test/Langchain/Integration/ReActAgentE2ESpec.hs +0/−42
• test/Test/Langchain/Integration/StateGraphE2ESpec.hs +0/−79
• test/Test/Langchain/Integration/StreamingCachingRetryE2ESpec.hs +0/−49
• test/Test/Langchain/MCP/McpSpec.hs +0/−36
• test/Test/Langchain/Memory/Core.hs +191/−2
• test/Test/Langchain/Memory/EntitySpec.hs +0/−33
• test/Test/Langchain/Memory/SummarySpec.hs +14/−2
• test/Test/Langchain/Memory/TokenBufferMemory.hs +14/−4
• test/Test/Langchain/ObservabilitySpec.hs +0/−80
• test/Test/Langchain/OutputParser/AdvancedParsersSpec.hs +2/−9
• test/Test/Langchain/OutputParser/Core.hs +22/−53
• test/Test/Langchain/PromptTemplate/Chat/ChatPromptTemplateSpec.hs +0/−661
• test/Test/Langchain/PromptTemplate/Chat/MessagesPlaceholderSpec.hs +0/−84
• test/Test/Langchain/PromptTemplate/FewShotSpec.hs +0/−62
• test/Test/Langchain/PromptTemplate/PromptSpec.hs +0/−59
• test/Test/Langchain/Property/CheckpointerSpec.hs +0/−56
• test/Test/Langchain/Property/ErrorSpec.hs +0/−48
• test/Test/Langchain/Property/MessageSpec.hs +0/−72
• test/Test/Langchain/Property/PromptTemplateSpec.hs +0/−74
• test/Test/Langchain/Property/RunnableSpec.hs +0/−80
• test/Test/Langchain/Property/TextSplitterSpec.hs +0/−50
• test/Test/Langchain/Provider/FixturesSpec.hs +0/−60
• test/Test/Langchain/Provider/Gemini.hs +0/−676
• test/Test/Langchain/Provider/Mock.hs +21/−2
• test/Test/Langchain/Provider/Ollama.hs +0/−165
• test/Test/Langchain/Provider/OllamaConversionSpec.hs +0/−75
• test/Test/Langchain/Provider/OpenAI.hs +0/−414
• test/Test/Langchain/Provider/TestSseServer.hs +0/−85
• test/Test/Langchain/RegressionSpec.hs +3/−15
• test/Test/Langchain/Resilience/CircuitBreakerSpec.hs +0/−40
• test/Test/Langchain/Resilience/RetrySpec.hs +0/−35
• test/Test/Langchain/Retriever/BM25Spec.hs +1/−22
• test/Test/Langchain/Retriever/Core.hs +0/−30
• test/Test/Langchain/Retriever/HybridSpec.hs +0/−40
• test/Test/Langchain/TestHelpers.hs +0/−225
• test/Test/Langchain/Tool/AdvancedToolsSpec.hs +1/−24
• test/Test/Langchain/Tool/Calculator.hs +0/−22
• test/Test/Langchain/Tool/FileSystem.hs +143/−10
• test/Test/Langchain/Tool/ProcessSpec.hs +67/−0
• test/Test/Langchain/Tool/SecuritySpec.hs +62/−0
• test/Test/Langchain/Tool/Shell.hs +1/−1
• test/Test/Langchain/VectorStore/SqliteVecSpec.hs +0/−55

@@ -1,5 +1,51 @@ # Changelog for `langchain-hs` +## 0.0.6.0 - 2026-10-15++### Highlights++- **Complete Modular Provider Architecture**:+  All concrete AI providers and protocol clients are now decoupled into standalone Hackage packages:+  - `langchain-hs-core` (0.0.6.0): Core abstractions, runnables, tools, agents, vector stores, memory, output parsers, and resilience.+  - `langchain-hs-graph` (0.0.6.0): Production StateGraph engine with state reducers, checkpointing, and time-travel replay.+  - `langchain-hs-ollama` (0.0.6.0): Ollama chat model and embeddings provider.+  - `langchain-hs-openai` (0.0.6.0): OpenAI, OpenRouter, and OpenAI-compatible provider with structured output and streaming.+  - `langchain-hs-gemini` (0.0.6.0): Google Gemini provider with function calling and SSE streaming.+  - `langchain-hs-mcp` (0.0.6.0): Model Context Protocol (MCP) client over stdio and HTTP JSON-RPC 2.0.+  - `langchain-hs` (0.0.6.0): Umbrella package re-exporting `langchain-hs-core` and `langchain-hs-graph`.++### StateGraph Productionization (`langchain-hs-graph`)++- Replaced prototype modules with robust execution combinators: `runGraph`, `runGraphWithConfig`, `runGraphInterleaved`, and `streamGraphSteps`.+- Added `runnableNode` and `chatModelNode` combinators to lift arbitrary `Runnable` and `ChatModel` instances into graph nodes.+- Full support for recursion limits, step-by-step transition logging, checkpointing, and human-in-the-loop interruption.++### Memory Hardening (`langchain-hs-core`)++- **`InVariableMemory`**: Thread-safe STM-backed transactional memory with snapshotting, resets, and clear semantics.+- **`SessionMemory`**: Multi-session conversation manager supporting per-session state isolation, active session tracking, and TTL-based pruning.+- **`FileMemory`**: Persistent file-backed conversation memory with atomic disk writes and metadata preservation across process restarts.+- **Reset Helpers**: Added explicit seed-state reset combinators `resetConversationBuffer`, `resetWindowBuffer`, `resetTokenBuffer`, and `resetEntitiesToInitial`.+- **Umbrella Prelude Re-exports**: Re-exported all memory implementations (`ConversationBufferMemory`, `SessionMemoryStore`, `EntityMemory`, `CombinedMemory`), buffer reset helpers, and `splitDocuments` in `Langchain.Prelude`.++### Output Parsers & Document Loaders++- Trimmed fragile character-scanning parsers (`NumberSeparatedList`) and redundant wrapper types (`JSONOutputStructure`) in favor of type-safe `StructuredOutput` and `TextOutputParser`.+- Hardened boolean output parser to exact normalized token recognition.+- Added standard numeric `OutputParser` instances for `Int`, `Integer`, and `Double` with whitespace stripping.+- Eliminated lazy I/O file handle leaks in `FileLoader` and `DirectoryLoader` with strict text I/O.+- Added `splitDocuments` preserving document metadata across chunk splits, and provided default `loadAndSplit` implementation in `BaseLoader`.++### Breaking Changes from 0.0.5.0++- Provider modules are no longer bundled in `langchain-hs`:+  - For Ollama: Add `langchain-hs-ollama` to dependencies and `import Langchain.Provider.Ollama`.+  - For OpenAI: Add `langchain-hs-openai` to dependencies and `import Langchain.Provider.OpenAI`.+  - For Gemini: Add `langchain-hs-gemini` to dependencies and `import Langchain.Provider.Gemini`.+  - For MCP: Add `langchain-hs-mcp` to dependencies and `import Langchain.MCP.Client`.+- `Langchain.Prelude` no longer re-exports provider-specific constructors (`newOllama`, `newOpenAI`, `newGemini`, `newStdioMcpClient`). Import the corresponding provider package.+- `JSONOutputStructure` and `NumberSeparatedList` have been removed from `Langchain.OutputParser.Core` and `Langchain.Prelude`. Use `StructuredOutput` or `TextOutputParser`.+ ## 0.0.5.0 - 2026-09-10  ### Major Architecture & Ecosystem Evolution@@ -29,7 +75,7 @@   - Migrated to `MercuryTechnologies/openai` client.   - Full PVP upper bounds across all packages for Hackage compliance. -### ⚠️ Breaking Changes from 0.0.3.0+### Breaking Changes from 0.0.3.0  - **`LangchainT` is now parameterized over `env`** (`LangchainT env m a` instead of the former implicit `LangchainConfig`).   - Replace `runLangchainT config action` with `runLangchainT env action` where `env` is your custom environment type (use `()` if you have no shared config).

@@ -1,275 +1,266 @@-# 🦜️🔗 LangChain Haskell (`langchain-hs`)+# LangChain Haskell (langchain-hs) -> **The Pure Functional, Effect-Polymorphic AI Agent & Multi-Agent Graph Engine in Haskell**->-> *A strictly typed, effect-polymorphic, AI ecosystem built on pure AST pipelines (`RunnableTree`), cyclic state machines (`StateGraph`), Model Context Protocol (MCP), and production observability.*+> Type-Safe AI Agents & Multi-Agent Graphs in Haskell ----+A functional, effect-polymorphic Haskell ecosystem for building production AI applications, featuring pure AST pipelines (`RunnableTree`), cyclic state graphs (`StateGraph`), Model Context Protocol (MCP), and OpenTelemetry observability. -[![Hackage](https://img.shields.io/badge/hackage-0.0.5.0-blue.svg)](https://hackage.haskell.org/package/langchain-hs)+[![Hackage](https://img.shields.io/badge/hackage-0.0.6.0-blue.svg)](https://hackage.haskell.org/package/langchain-hs) [![GHC](https://img.shields.io/badge/GHC-9.8%2B-purple.svg)](https://www.haskell.org/ghc/)-[![Components](https://img.shields.io/badge/components-20%20verified-brightgreen.svg)](#-20-core-components--verified-targets)-[![Providers](https://img.shields.io/badge/providers-Ollama%20%7C%20OpenAI%20%7C%20Gemini-orange.svg)](#-dual-provider-parity-ollama--openai) [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](LICENSE)-[![Whitepaper](https://img.shields.io/badge/whitepaper-read%20now-blueviolet.svg)](whitepaper.md)-------## Why `langchain-hs`?--Modern AI orchestration frameworks often struggle with race conditions, hidden side-effects, fragile dynamic schemas, and uninspectable opaque execution chains. `langchain-hs` brings mathematical precision and functional programming principles to AI development:--1. **First-Class Runnable AST Composition (`RunnableTree`)**: Every component—models, prompts, tools, chains, retrievers, and parsers—implements the `Runnable` typeclass. Connect components into trees or graphs using type-safe operators:-   - `|>>` : Sequential composition (data flows from left to right).-   - `&>&` : Parallel fan-out (concurrent evaluation of independent branches).-   - `>>>#` : Fallback chains (automatic failover if the primary branch errors).-2. **LangGraph in Haskell (`StateGraph`)**: Full cyclic state machine engine with pure monoidal state reducers (`StateReducer s`), thread-safe STM memory checkpointers (`TVar`), persistent SQLite checkpointers, Human-in-the-Loop (`HITL`) interrupts, and Time-Travel state replay.+[![Documentation](https://img.shields.io/badge/docs-website-blueviolet.svg)](https://tusharad.github.io/langchain-hs/)  --- +## Installation -### Monorepo Packages+Install `langchain-hs` and provider packages via **Cabal**: -| Package | Directory | Version | Description |-|---|---|---|---|-| `langchain-hs-core` | [`langchain-hs-core/`](./langchain-hs-core) | `0.0.5.0` | Zero-dependency pure core: `RunnableTree`, `ChatModel`, `ContentBlock`, `Tool`, and `LangchainT`. |-| `langchain-hs-graph` | [`langchain-hs-graph/`](./langchain-hs-graph) | `0.0.5.0` | Stateful graph engine: `StateGraph s m`, checkpointers, HITL, time-travel, and parallel nodes. |-| `langchain-hs` | [`./`](./) | `0.0.5.0` | Production ecosystem: Ollama/OpenAI providers, Agents, MCP, Vector Stores, Chains, Observability. |-| `examples` | [`examples/`](./examples) | - | 41 runnable executables covering all 20 components for Ollama and OpenAI. |-| `site` | [`site/`](./site) | - | Hakyll documentation website with live provider toggle and component reference. |+```bash+cabal update+cabal install langchain-hs langchain-hs-ollama langchain-hs-openai+``` ----+Or add to your `stack.yaml`: -## 20 Core Components & Verified Targets+```yaml+extra-deps:+  - langchain-hs-0.0.6.0+  - langchain-hs-core-0.0.6.0+  - langchain-hs-graph-0.0.6.0+  - langchain-hs-ollama-0.0.6.0+  - langchain-hs-openai-0.0.6.0+``` -| # | Component | Package Layer | Ollama Executable | OpenAI Executable | Documentation |-|:---:|---|---|---|---|:---:|-| 1 | **Chat Models** | `Langchain.Core.Model` | `stack run simpleollama` | `stack run simpleopenai` | [Docs](site/components/chat-models.md) |-| 2 | **Conduit Streaming** | `Langchain.Core.Stream` | `stack run streamollama` | `stack run streamopenai` | [Docs](site/components/streaming.md) |-| 3 | **Langchain Monad** | `Langchain.Core.Monad` | `stack run monadollama` | `stack run monadopenai` | [Docs](site/components/monad.md) |-| 4 | **Tools & Function Calling** | `Langchain.Core.Tool` | `stack run toolollama` | `stack run toolopenai` | [Docs](site/components/tools.md) |-| 5 | **Structured Outputs** | `Langchain.OutputParser` | `stack run jsonollama` | `stack run jsonopenai` | [Docs](site/components/structured-output.md) |-| 6 | **RAG & Embeddings** | `Langchain.Embedding` | `stack run ragollama` | `stack run ragopenai` | [Docs](site/components/rag.md) |-| 7 | **Hybrid Retrievers** | `Langchain.Retriever` | `stack run retrieverollama` | `stack run retrieveropenai` | [Docs](site/components/retrievers.md) |-| 8 | **Memory Systems** | `Langchain.Memory` | `stack run memoryollama` | `stack run memoryopenai` | [Docs](site/components/memory.md) |-| 9 | **Retrieval QA Chains** | `Langchain.Chain.RetrievalQA` | `stack run retrievalqaollama` | `stack run retrievalqaopenai` | [Docs](site/components/retrieval-qa.md) |-| 10 | **Map-Reduce Processing** | `Langchain.Chain.MapReduce` | `stack run mapreduceollama` | `stack run mapreduceopenai` | [Docs](site/components/map-reduce.md) |-| 11 | **ReAct Agent** | `Langchain.Agent.ReAct` | `stack run reactollama` | `stack run reactopenai` | [Docs](site/components/react-agent.md) |-| 12 | **Plan-and-Execute Agent** | `Langchain.Agent.PlanAndExecute` | `stack run planandexecuteollama` | `stack run planandexecuteopenai` | [Docs](site/components/plan-and-execute.md) |-| 13 | **Guardrails & Safety** | `Langchain.Guardrails` | `stack run guardrailollama` | `stack run guardrailopenai` | [Docs](site/components/guardrails.md) |-| 14 | **Resilience & Retries** | `Langchain.Resilience` | `stack run resilienceollama` | `stack run resilienceopenai` | [Docs](site/components/resilience.md) |-| 15 | **Observability & Tracing** | `Langchain.Observability` | `stack run observabilityollama` | `stack run observabilityopenai` | [Docs](site/components/observability.md) |-| 16 | **Model Context Protocol** | `Langchain.MCP.Client` | `stack run mcpollama` | `stack run mcpopenai` | [Docs](site/components/mcp.md) |-| 17 | **StateGraph Workflows** | `Langchain.Graph` | `stack run stategraphollama` | `stack run stategraphopenai` | [Docs](site/components/state-graph.md) |-| 18 | **Multi-Agent Systems** | `Langchain.Graph.MultiAgent` | `stack run multiagentollama` | `stack run multiagentopenai` | [Docs](site/components/multi-agent.md) |-| 19 | **Human-in-the-Loop (HITL)** | `Langchain.Graph.Checkpointer` | `stack run hitlollama` | `stack run hitlopenai` | [Docs](site/components/hitl.md) |-| 20 | **Runnables & AST Composition** | `Langchain.Core.Runnable` | `stack run runnableollama` | `stack run runnableopenai` | [Docs](site/components/runnables.md) |+Package reference on Hackage: [https://hackage.haskell.org/package/langchain-hs](https://hackage.haskell.org/package/langchain-hs)  --- -## Code Showcases--### 1. The Power of Runnables: Pure AST Composition+## 1. Simple Chat Calling -Compose complex multi-stage pipelines using typed operators without executing any `IO` until interpretation:+Send a prompt to an LLM (local Ollama, OpenAI, or Gemini) and retrieve a typed response:  ```haskell {-# LANGUAGE OverloadedStrings #-} module Main where +import Control.Monad.Except (runExceptT)+import qualified Data.Text.IO as T import Langchain.Prelude---- Compose pure AST pipelines with (|>>), (&>&), and (>>>#)-pipeline :: RunnableTree IO Text Text-pipeline =-      runLambda (\q -> (q, q))                          -- duplicate input query-  |>> (fetchDocuments &>& generateFollowup)              -- parallel branch fan-out-  |>> runLambda (\(docs, fup) -> renderPrompt docs fup) -- pure prompt synthesis-  |>> (invokeLLM primaryModel >>># invokeLLM backupModel) -- fallback resilience-  |>> parseStructuredResponse                           -- JSON parser+import Langchain.Provider.Ollama  main :: IO () main = do-  output <- interpret pipeline "Explain Monads in Haskell"-  print output+  -- Connect to local Ollama instance (DeepSeek, Llama 3, Gemma, etc.)+  model <- newOllama "llama3.2" defaultConfig+  +  let messages = [userMessage "Explain in two sentences why Haskell makes AI agents more reliable."]+  result <- runExceptT $ invoke model messages Nothing+  +  case result of+    Left err   -> T.putStrLn $ errorMessage err+    Right resp -> T.putStrLn $ extractMessageText resp ``` +### Output++```text+Haskell's static type system prevents common agent failures like missing dictionary keys or unexpected nulls before code ever reaches production. Furthermore, pure state transitions guarantee that autonomous agents cannot silently mutate variables behind your back.+```+ --- -### 2. Dual-Provider Chat Comparison: Ollama vs OpenAI+## 2. JSON Structured Output -#### Ollama (Local & Offline)+Guarantee that the LLM response conforms to a typed Haskell record using `FromJSON` and `ToSchema`:+ ```haskell+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-import Control.Monad.Except (runExceptT)+{-# LANGUAGE TypeApplications #-}+module Main where++import Data.Aeson (FromJSON)+import qualified Data.Text as T import qualified Data.Text.IO as T+import GHC.Generics (Generic) import Langchain.Prelude+import Langchain.Provider.Ollama +-- Define your target data schema+data Developer = Developer+  { name              :: T.Text+  , preferredLanguage :: T.Text+  , yearsOfExperience :: Int+  , favoriteLibrary   :: T.Text+  } deriving (Show, Generic, FromJSON, ToSchema)+ main :: IO () main = do-  -- Connect to local Ollama instance (DeepSeek, Llama 3, Gemma)-  model <- newOllama "gemma3" defaultConfig+  model <- newOllama "llama3.2" defaultConfig   -  let msg = [userMessage "Write a poem about functional programming"]-  res <- runExceptT $ invoke model msg Nothing-  case res of-    Left err -> T.putStrLn $ errorMessage err-    Right m  -> T.putStrLn $ extractMessageText m+  let prompt =+        [ userMessage "Extract profile: Alan has been writing Haskell for 8 years and loves langchain-hs." ]+      options = withStructuredOutput (Proxy @Developer) defaultOllamaConfig++  result <- runLangchainT () $ invoke model prompt (Just options)+  case result of+    Left err  -> T.putStrLn $ errorMessage err+    Right msg -> T.putStrLn $ extractMessageText msg ```-*Run:* `stack run simpleollama` -#### OpenAI / OpenRouter (Cloud)+### Output++```json+{+  "name": "Alan",+  "preferredLanguage": "Haskell",+  "yearsOfExperience": 8,+  "favoriteLibrary": "langchain-hs"+}+```++---++## 3. Tool Calling++Equip models with effectful Haskell tools. The LLM automatically emits structured tool calls, which your application executes and feeds back for final synthesis:+ ```haskell {-# LANGUAGE OverloadedStrings #-}-import Control.Monad.Except (runExceptT)+{-# LANGUAGE TypeApplications #-}+module Main where++import Control.Monad.IO.Class (liftIO)+import qualified Data.Text as T import qualified Data.Text.IO as T import Langchain.Prelude-import OpenAI.Common (defaultModelName, getOpenRouterModel)+import Langchain.Provider.Ollama  main :: IO () main = do-  -- Connect to OpenAI or OpenRouter using environment API key-  model <- getOpenRouterModel defaultModelName+  model <- newOllama "qwen2.5:7b" defaultConfig   -  let msg = [userMessage "Write a poem about functional programming"]-  res <- runExceptT $ invoke model msg Nothing-  case res of-    Left err -> T.putStrLn $ errorMessage err-    Right m  -> T.putStrLn $ extractMessageText m-```-*Run:* `stack run simpleopenai`-----+  -- Instantiate typed filesystem tool+  let fsTool   = findFilesTool @IO defaultSecurityPolicy+      toolCfg  = withTools [fsTool] defaultOllamaConfig+      prompt   = [userMessage "Search for Haskell source files using find_files with pattern '*.hs'."] -### 3. Stateful Graphs (`StateGraph`): Cyclic Multi-Agent Workflow+  res <- runLangchainT () $ do+    response <- invoke model prompt (Just toolCfg)+    case messageToolCalls response of+      Just (tCall:_) -> do+        liftIO $ T.putStrLn $ "Tool Invoked: " <> toolCallName tCall+        liftIO $ T.putStrLn $ "Arguments:    " <> T.pack (show (toolCallArguments tCall))+        +        -- Execute tool with LLM arguments+        execResult <- liftIO $ toolExecute fsTool (toolCallArguments tCall)+        let observation = case execResult of+              Left err  -> "Error: " <> errorMessage err+              Right out -> out+        liftIO $ T.putStrLn $ "Observation:  " <> observation+        +        -- Supply tool observation back to model for final response+        let toolMsg = (toolMessage observation) { messageName = Just (toolCallName tCall) }+            thread  = prompt ++ [response, toolMsg]+            +        finalMsg <- invoke model thread (Just toolCfg)+        liftIO $ T.putStrLn "\nFinal Assistant Answer:"+        liftIO $ T.putStrLn $ extractMessageText finalMsg+      _ -> do+        liftIO $ T.putStrLn $ extractMessageText response -```haskell-{-# LANGUAGE OverloadedStrings #-}-import Langchain.Graph.StateGraph-import Langchain.Prelude+  case res of+    Left err -> T.putStrLn $ "Error: " <> errorMessage err+    Right () -> pure ()+``` --- Pure state with a list-append reducer-data AgentState = AgentState { messages :: [Message], loopCount :: Int }+### Output --- Build the graph using pure combinators-workflow :: StateGraph AgentState IO-workflow =-  addEdge "reviewer" "planner"          -- cyclic feedback loop!-    $ addConditionalEdge "executor"-        (\s -> pure $ if done s then Right endNodeId else Right "reviewer")-    $ addEdge "planner" "executor"-    $ addEdge startNodeId "planner"-    $ addNode "reviewer" (Node reviewerNode replaceFieldReducer)-    $ addNode "executor" (Node executorNode replaceFieldReducer)-    $ addNode "planner"  (Node plannerNode  replaceFieldReducer)-    $ emptyStateGraph+```text+Tool Invoked: find_files+Arguments:    fromList [("pattern",String "*.hs")]+Observation:  ["src/Main.hs","src/Agent.hs","src/Tools.hs"] -main :: IO ()-main = do-  checkpointer <- newMemoryCheckpointer-  case compileGraph workflow of-    Left err -> print err-    Right compiled -> do-      result <- runGraph compiled initialState (Just checkpointer)-      print result+Final Assistant Answer:+I scanned the repository and identified 3 Haskell source files matching your pattern:+- src/Main.hs+- src/Agent.hs+- src/Tools.hs ```-*Run:* `stack run stategraphollama` or `stack run stategraphopenai`  --- -### 4. Model Context Protocol (MCP) Tools Integration+## 4. ReAct Agent -Connect Haskell agents to any external MCP server (e.g., Hackage doc search, SQLite, Filesystem, GitHub) over stdio:+Run an autonomous **Reason + Act** agent loop that decomposes user tasks, selects tools, evaluates observations, and iterates until completion:  ```haskell {-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad.Except (runExceptT)+import qualified Data.Text.IO as T import Langchain.Prelude+import Langchain.Provider.Ollama  main :: IO () main = do-  -- Connect to any MCP server via stdio JSON-RPC 2.0-  client <- newStdioMcpClient "docker" ["run", "-i", "--rm", "mcp/hackage-doc"]+  -- Setup sample file for demonstration+  writeFile "/tmp/server_status.txt" "Service: api-gateway, Status: Degraded, Latency: 420ms"   -  -- Discover available tools from server-  mcpTools <- listMcpTools client-  let nativeTools = map mcpToolToLangchainTool mcpTools+  model <- newOllama "qwen2.5:7b" defaultConfig   -  -- Bind tools to your ReAct or Plan-and-Execute Agent-  let agent = createReActAgent model nativeTools defaultAgentConfig-  res <- runReActAgent agent "Search Hoogle for the signature of 'traverse'"-  print res+  -- Equip agent with file inspection tools+  let policy = defaultSecurityPolicy+      tools  = [readFileTool Nothing policy, findFilesTool policy]+      agent  = defaultReActAgent model tools+      prompt = [userMessage "Inspect /tmp/server_status.txt using read_file and summarize the service health."]++  res <- runExceptT $ runReActAgent agent prompt+  case res of+    Left err  -> T.putStrLn $ errorMessage err+    Right msg -> T.putStrLn $ extractMessageText msg ```-*Run:* `stack run mcpollama` or `stack run mcpopenai` ----+### Output -## Installation+```text+[ReAct Iteration 1]+Thought: I should read the contents of /tmp/server_status.txt to check the current health status.+Action: read_file {"path": "/tmp/server_status.txt"}+Observation: Service: api-gateway, Status: Degraded, Latency: 420ms -### Stack-Add to your `stack.yaml`:-```yaml-extra-deps:-  - langchain-hs-core-0.0.5.0-  - langchain-hs-graph-0.0.5.0-  - langchain-hs-0.0.5.0-```-Then in your `.cabal` or `package.yaml`:-```yaml-dependencies:-  - langchain-hs        # full ecosystem (providers, agents, MCP, vector stores)-  - langchain-hs-core   # pure core only (no HTTP dependencies)-  - langchain-hs-graph  # graph engine only-```+[ReAct Iteration 2]+Thought: The file has been read. The api-gateway service is in a degraded state with elevated latency. I will now summarize this for the user. -### Cabal-```bash-cabal install langchain-hs+Final Answer:+The api-gateway service is currently experiencing degraded health with high latency (420ms). Immediate investigation of the gateway service is recommended. ```  --- -## Development & Quality Commands+## Documentation & Resources -The repository enforces strict code quality and formatting via `make`:+- **Hackage Package:** [https://hackage.haskell.org/package/langchain-hs](https://hackage.haskell.org/package/langchain-hs)+- **Documentation Website:** [https://tusharad.github.io/langchain-hs/](https://tusharad.github.io/langchain-hs/)+- **Whitepaper:** [whitepaper.md](whitepaper.md) (Effect polymorphism, categorical design, state graphs)+- **Examples Directory:** [`examples/`](examples/) +---++## Development & Testing+ ```bash-# Build the entire monorepo and all 41 example executables+# Build project stack build -# Run unit and property-based test suites+# Run test suite stack test -# Run HLint across all source trees (zero hints policy)+# Code quality checks make lint--# Check code formatting with Fourmolu make format-check--# Format all files in-place-make format--# Build the documentation website (Hakyll)-make site-build--# Run live documentation server with auto-reload (port 8000)-make site-watch-```-------## Documentation & Research--| Resource | Description |-|:---|:---|-| **[Hackage Docs](https://hackage.haskell.org/package/langchain-hs)** | Full Haddock API reference for all exported modules |-| **[Whitepaper](whitepaper.md)** | Deep technical dive: category theory foundations, algebraic laws, effect-polymorphic design, and advanced multi-agent patterns |-| **[Documentation Website](site/)** | Hakyll site with 20 component pages, live provider toggle, and instant search (`Cmd+K`) |-| **[Examples](examples/)** | 41 runnable executables covering every component for Ollama and OpenAI |--To build the Haddock API docs locally:-```bash-make docs-# Opens in .stack-work/install/.../doc/index.html ```  ---

@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain

@@ -1,13 +1,18 @@-cabal-version: 1.12+cabal-version: 1.22  -- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           langchain-hs-version:        0.0.5.0+version:        0.0.6.0 synopsis:       Pure functional LLM agent framework and multi-agent graph engine in Haskell-description:    Build LLM-powered applications, ReAct agents, and LangGraph-style stateful workflows in Haskell with zero unsafePerformIO.+description:    Build LLM-powered applications, ReAct agents, and LangGraph-style stateful workflows+                in Haskell. Provider-specific packages:+                  - langchain-hs-ollama+                  - langchain-hs-openai+                  - langchain-hs-gemini+                  - langchain-hs-mcp category:       AI homepage:       https://github.com/tusharad/langchain-hs#readme bug-reports:    https://github.com/tusharad/langchain-hs/issues@@ -21,7 +26,7 @@     GHC == 9.12.4   , GHC == 9.10.3   , GHC == 9.8.4-extra-source-files:+extra-doc-files:     README.md     CHANGELOG.md @@ -30,96 +35,78 @@   location: https://github.com/tusharad/langchain-hs  library-  exposed-modules:-      Langchain.Agent.PlanAndExecute-      Langchain.Agent.ReAct-      Langchain.Cache.Core-      Langchain.Callback.Manager-      Langchain.Chain.MapReduce-      Langchain.Chain.RetrievalQA-      Langchain.DocumentLoader.Core-      Langchain.DocumentLoader.Csv-      Langchain.DocumentLoader.DirectoryLoader-      Langchain.DocumentLoader.FileLoader-      Langchain.Embeddings.Core-      Langchain.Embeddings.Ollama-      Langchain.Embeddings.OpenAI-      Langchain.Guardrail.Core-      Langchain.MCP.Client-      Langchain.Memory.Core-      Langchain.Memory.Entity-      Langchain.Memory.Summary-      Langchain.Observability-      Langchain.OutputParser.Core-      Langchain.OutputParser.Structured-      Langchain.Prelude-      Langchain.PromptTemplate.Chat-      Langchain.PromptTemplate.Chat.ChatPromptTemplate-      Langchain.PromptTemplate.Chat.MessagesPlaceholder-      Langchain.PromptTemplate.FewShot-      Langchain.PromptTemplate.Prompt-      Langchain.PromptTemplate.String-      Langchain.Provider.Gemini-      Langchain.Provider.Ollama-      Langchain.Provider.OpenAI-      Langchain.Resilience.CircuitBreaker-      Langchain.Resilience.Retry-      Langchain.Retriever.BM25-      Langchain.Retriever.Core-      Langchain.Retriever.Hybrid-      Langchain.TextSplitter.Character-      Langchain.TextSplitter.Code-      Langchain.TextSplitter.Markdown-      Langchain.TextSplitter.RecursiveCharacter-      Langchain.TextSplitter.Token-      Langchain.Tool.Async-      Langchain.Tool.Binding-      Langchain.Tool.Calculator-      Langchain.Tool.Core-      Langchain.Tool.FileSystem-      Langchain.Tool.GenericSchema-      Langchain.Tool.Shell-      Langchain.VectorStore.Core-      Langchain.VectorStore.InMemory-      Langchain.VectorStore.SqliteVec   other-modules:       Paths_langchain_hs-  hs-source-dirs:-      src+  reexported-modules:+      Langchain.Error+    , Langchain.Model+    , Langchain.Model.Types+    , Langchain.Monad+    , Langchain.Stream+    , Langchain.Runnable+    , Langchain.Tool+    , Langchain.Tool.Binding+    , Langchain.Tool.Checkpoint+    , Langchain.Tool.Core+    , Langchain.Tool.FileSystem+    , Langchain.Tool.GenericSchema+    , Langchain.Tool.Process+    , Langchain.Tool.Security+    , Langchain.Tool.Shell+    , Langchain.Embeddings+    , Langchain.Embeddings.Core+    , Langchain.DocumentLoader+    , Langchain.DocumentLoader.Core+    , Langchain.DocumentLoader.DirectoryLoader+    , Langchain.DocumentLoader.FileLoader+    , Langchain.TextSplitter.Character+    , Langchain.TextSplitter.Code+    , Langchain.TextSplitter.Markdown+    , Langchain.TextSplitter.RecursiveCharacter+    , Langchain.TextSplitter.Token+    , Langchain.VectorStore+    , Langchain.VectorStore.Core+    , Langchain.VectorStore.InMemory+    , Langchain.PromptTemplate+    , Langchain.PromptTemplate.Prompt+    , Langchain.PromptTemplate.String+    , Langchain.Observability+    , Langchain.Callback+    , Langchain.Callback.Manager+    , Langchain.Retriever+    , Langchain.Retriever.Core+    , Langchain.Retriever.BM25+    , Langchain.Retriever.Hybrid+    , Langchain.Resilience+    , Langchain.Resilience.CircuitBreaker+    , Langchain.Resilience.Retry+    , Langchain.Memory+    , Langchain.Memory.Core+    , Langchain.Memory.Summary+    , Langchain.Memory.Session+    , Langchain.Memory.Entity+    , Langchain.Memory.Combined+    , Langchain.Cache+    , Langchain.Cache.Core+    , Langchain.OutputParser+    , Langchain.OutputParser.Core+    , Langchain.OutputParser.Structured+    , Langchain.Chain+    , Langchain.Chain.RetrievalQA+    , Langchain.Agent+    , Langchain.Agent.ReAct+    , Langchain.Agent.PlanAndExecute+    , Langchain.Guardrail+    , Langchain.Guardrail.Core+    , Langchain.Prelude+    , Langchain.Graph.StateGraph+    , Langchain.Graph.Checkpointer+    , Langchain.Graph.HITL   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.*-    , async ==2.2.*-    , base >=4.17 && <5-    , bytestring >=0.10 && <0.13-    , conduit >=1.2 && <1.4-    , containers >=0.6 && <0.9-    , directory >=1.3.6 && <1.4-    , filepath >=1.4 && <2-    , format-heavy ==0.1.*-    , http-client ==0.7.*-    , http-client-tls >=0.3 && <0.5-    , http-conduit ==2.*-    , http-types >=0.11 && <0.13-    , langchain-hs-core ==0.0.5.*-    , langchain-hs-graph ==0.0.5.*-    , mtl >=2.2 && <2.4-    , ollama-haskell >=0.4.0.0 && <0.5-    , openai >=2.2.1 && <3-    , process ==1.6.*-    , random ==1.2.*-    , scientific ==0.3.*-    , servant ==0.20.*-    , servant-client ==0.20.*-    , servant-client-core ==0.20.*-    , servant-conduit ==0.16.*-    , servant-event-stream ==0.4.*-    , sqlite-simple >=0.4.18 && <0.5-    , stm ==2.5.*-    , text >=1.2 && <3-    , time >=1.9 && <1.15-    , transformers >=0.5 && <0.7-    , vector >=0.12 && <0.14+      base >=4.17 && <5+    , langchain-hs-core ==0.0.6.*+    , langchain-hs-graph ==0.0.6.*   default-language: Haskell2010  test-suite langchain-hs-test@@ -129,66 +116,31 @@       Test.Langchain.Agent.AdvancedAgentsSpec       Test.Langchain.Agent.ReAct       Test.Langchain.Cache.CacheSpec-      Test.Langchain.Callback.CallbackManagerSpec-      Test.Langchain.Chain.ChainsSpec       Test.Langchain.Chain.RetrievalQASpec       Test.Langchain.DocumentLoader.Core-      Test.Langchain.DocumentLoader.CsvSpec       Test.Langchain.DocumentLoader.DirectoryLoader       Test.Langchain.Error       Test.Langchain.Graph.CompilationSpec       Test.Langchain.Guardrail.GuardrailSpec-      Test.Langchain.Integration.FullRagE2ESpec-      Test.Langchain.Integration.OllamaChatSpec-      Test.Langchain.Integration.OllamaEmbeddingSpec-      Test.Langchain.Integration.OllamaStreamSpec-      Test.Langchain.Integration.OllamaToolSpec-      Test.Langchain.Integration.ReActAgentE2ESpec-      Test.Langchain.Integration.StateGraphE2ESpec-      Test.Langchain.Integration.StreamingCachingRetryE2ESpec-      Test.Langchain.MCP.McpSpec       Test.Langchain.Memory.Core-      Test.Langchain.Memory.EntitySpec       Test.Langchain.Memory.SummarySpec       Test.Langchain.Memory.TokenBufferMemory-      Test.Langchain.ObservabilitySpec       Test.Langchain.OutputParser.AdvancedParsersSpec       Test.Langchain.OutputParser.Core-      Test.Langchain.PromptTemplate.Chat.ChatPromptTemplateSpec-      Test.Langchain.PromptTemplate.Chat.MessagesPlaceholderSpec-      Test.Langchain.PromptTemplate.FewShotSpec-      Test.Langchain.PromptTemplate.PromptSpec-      Test.Langchain.Property.CheckpointerSpec-      Test.Langchain.Property.ErrorSpec-      Test.Langchain.Property.MessageSpec-      Test.Langchain.Property.PromptTemplateSpec-      Test.Langchain.Property.RunnableSpec-      Test.Langchain.Property.TextSplitterSpec-      Test.Langchain.Provider.FixturesSpec-      Test.Langchain.Provider.Gemini       Test.Langchain.Provider.Mock-      Test.Langchain.Provider.Ollama-      Test.Langchain.Provider.OllamaConversionSpec-      Test.Langchain.Provider.OpenAI-      Test.Langchain.Provider.TestSseServer       Test.Langchain.RegressionSpec-      Test.Langchain.Resilience.CircuitBreakerSpec-      Test.Langchain.Resilience.RetrySpec       Test.Langchain.Retriever.BM25Spec-      Test.Langchain.Retriever.Core-      Test.Langchain.Retriever.HybridSpec-      Test.Langchain.TestHelpers       Test.Langchain.TextSplitter.Character       Test.Langchain.TextSplitter.CodeSpec       Test.Langchain.TextSplitter.MarkdownSpec       Test.Langchain.TextSplitter.RecursiveCharacterSpec       Test.Langchain.TextSplitter.TokenSpec       Test.Langchain.Tool.AdvancedToolsSpec-      Test.Langchain.Tool.Calculator       Test.Langchain.Tool.FileSystem+      Test.Langchain.Tool.ProcessSpec+      Test.Langchain.Tool.SecuritySpec       Test.Langchain.Tool.Shell       Test.Langchain.VectorStore.Core-      Test.Langchain.VectorStore.SqliteVecSpec       Paths_langchain_hs   hs-source-dirs:       test@@ -196,44 +148,24 @@   build-depends:       QuickCheck     , aeson-    , aeson-qq     , async     , base >=4.17 && <5     , bytestring-    , conduit >=1.2 && <1.4+    , conduit     , containers     , directory     , filepath-    , format-heavy ==0.1.*-    , http-client ==0.7.*-    , http-client-tls >=0.3 && <0.5-    , http-conduit-    , http-types     , langchain-hs-    , langchain-hs-core-    , langchain-hs-graph-    , mtl >=2.2 && <2.4-    , ollama-haskell >=0.4.0.0 && <0.5-    , openai >=2.2.1 && <3-    , process ==1.6.*-    , random ==1.2.*-    , resourcet >=1.2 && <1.4-    , scientific ==0.3.*-    , servant ==0.20.*-    , servant-client ==0.20.*-    , servant-client-core ==0.20.*-    , servant-conduit ==0.16.*-    , servant-event-stream ==0.4.*-    , sqlite-simple >=0.4.18 && <0.5-    , stm ==2.5.*+    , langchain-hs-core ==0.0.6.*+    , langchain-hs-graph ==0.0.6.*+    , mtl+    , resourcet+    , stm     , tasty     , tasty-hunit     , tasty-quickcheck     , temporary     , text-    , time >=1.9 && <1.15-    , transformers >=0.5 && <0.7-    , vector >=0.12 && <0.14-    , wai-    , warp+    , time+    , vector   default-language: Haskell2010

@@ -1,198 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--{- |-Module      : Langchain.Agent.PlanAndExecute-Description : Plan-and-Execute agent architecture using JSON structured output and effectful step executors-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Separates complex multi-step reasoning into a two-phase architecture:-1. Planner LLM generates an explicit sequence of structured steps as typed JSON.-2. Executor (an agent with tools, a function, or a model) executes each step sequentially with accumulated context.--}-module Langchain.Agent.PlanAndExecute-  ( PlanStep (..)-  , Plan (..)-  , StepExecutor (..)-  , PlanAndExecuteAgent (..)-  , newPlanAndExecuteAgent-  , newPlanAndExecuteAgentWithTools-  , runPlanAndExecute-  ) where--import Control.Applicative ((<|>))-import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.Aeson (FromJSON (..), ToJSON, Value (..), withObject, (.!=), (.:), (.:?))-import Data.Aeson.Types (prependFailure, typeMismatch)-import Data.Text (Text)-import qualified Data.Text as T-import GHC.Generics (Generic)--import Langchain.Agent.ReAct (ReActAgent, createReActAgent, runReActAgent)-import Langchain.Core.Error (LangchainError, agentError)-import Langchain.Core.Model-  ( ChatModel (..)-  , extractMessageText-  , userMessage-  )-import Langchain.Core.Tool (Tool)-import Langchain.OutputParser.Structured (StructuredOutput, TypeSchema, structuredInvoke)-import Langchain.Tool.Binding (ToolBinder (..))---- | Single step in an execution plan-data PlanStep = PlanStep-  { stepNumber :: !Int-  , stepDescription :: !Text-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass (ToJSON, TypeSchema)--instance FromJSON PlanStep where-  parseJSON = withObject "PlanStep" $ \o -> do-    num <--      o .:? "stepNumber" >>= \case-        Just n -> pure n-        Nothing ->-          o .:? "step" >>= \case-            Just n -> pure n-            Nothing -> o .:? "number" .!= 1-    desc <--      o .:? "stepDescription" >>= \case-        Just d -> pure d-        Nothing ->-          o .:? "description" >>= \case-            Just d -> pure d-            Nothing ->-              o .:? "task" >>= \case-                Just d -> pure d-                Nothing -> o .: "action"-    pure $ PlanStep num desc---- | Collection of steps forming a plan-newtype Plan = Plan-  { planSteps :: [PlanStep]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass (ToJSON, StructuredOutput, TypeSchema)--instance FromJSON Plan where-  parseJSON (Object o) = Plan <$> (o .: "planSteps" <|> o .: "steps" <|> o .: "plan")-  parseJSON (Array arr) = Plan <$> parseJSON (Array arr)-  parseJSON invalid = prependFailure "parsing Plan failed, " (typeMismatch "Object or Array" invalid)---- | Abstraction for executing individual steps of a plan (agents, models with tools, or custom runners)-class StepExecutor e m where-  executeStep :: e -> Text -> m Text--instance-  {-# OVERLAPPING #-}-  (m ~ n, ToolBinder model m, MonadIO n, MonadError LangchainError n) =>-  StepExecutor (ReActAgent model m) n-  where-  executeStep agent prompt = do-    msg <- runReActAgent agent [userMessage prompt]-    pure $ extractMessageText msg--instance-  {-# OVERLAPPING #-}-  (m ~ n, ToolBinder model m, MonadIO n, MonadError LangchainError n) =>-  StepExecutor (model, [Tool m]) n-  where-  executeStep (model, tools) prompt = do-    let agent = createReActAgent model tools-    executeStep agent prompt--instance {-# OVERLAPPING #-} (m ~ n) => StepExecutor (Text -> m Text) n where-  executeStep = id--instance {-# OVERLAPPABLE #-} (ChatModel model, MonadIO m, MonadError LangchainError m) => StepExecutor model m where-  executeStep model prompt = do-    msg <- invoke model [userMessage prompt] Nothing-    pure $ extractMessageText msg---- | Plan-and-Execute agent container-data PlanAndExecuteAgent planner executor = PlanAndExecuteAgent-  { plannerModel :: planner-  , stepExecutor :: executor-  , planPromptTemplate :: Maybe Text-  }---- | Construct a new PlanAndExecuteAgent with any StepExecutor (agent, function, or model)-newPlanAndExecuteAgent ::-  planner ->-  executor ->-  Maybe Text ->-  PlanAndExecuteAgent planner executor-newPlanAndExecuteAgent = PlanAndExecuteAgent---- | Construct a PlanAndExecuteAgent with tools using a ReActAgent as the step executor-newPlanAndExecuteAgentWithTools ::-  planner ->-  model ->-  [Tool m] ->-  Maybe Text ->-  PlanAndExecuteAgent planner (ReActAgent model m)-newPlanAndExecuteAgentWithTools planner model tools =-  PlanAndExecuteAgent planner (createReActAgent model tools)---- | Execute a goal using the Plan-and-Execute workflow with structured JSON planning-runPlanAndExecute ::-  (ChatModel planner, StepExecutor executor m, MonadIO m, MonadError LangchainError m) =>-  PlanAndExecuteAgent planner executor ->-  Text ->-  m Text-runPlanAndExecute PlanAndExecuteAgent {..} userGoal = do-  let planPrompt = case planPromptTemplate of-        Just p -> p <> "\nGoal: " <> userGoal-        Nothing ->-          "You are an expert planner. For the following goal, generate a concise step-by-step execution plan.\n"-            <> "Output JSON format: {\"planSteps\": [{\"stepNumber\": 1, \"stepDescription\": \"...\"}]}\n"-            <> "Keep the plan focused and minimal (between 2 to 3 distinct, actionable steps).\n"-            <> "Goal: "-            <> userGoal-  plan <- structuredInvoke plannerModel [userMessage planPrompt]-  if null (planSteps plan)-    then throwError $ agentError "Planner generated an empty plan" (Just "PlanAndExecuteAgent") Nothing-    else executeSteps (planSteps plan) []-  where-    executeSteps [] stepOutputs = do-      let synthesisPrompt =-            "User Goal: "-              <> userGoal-              <> "\n\nStep Execution History:\n"-              <> T.unlines-                [T.pack (show num) <> ". " <> desc <> " -> " <> out | (PlanStep num desc, out) <- stepOutputs]-              <> "\n\nProvide the final synthesized answer satisfying the goal:"-      executeStep stepExecutor synthesisPrompt-    executeSteps (currStep : restSteps) prevOutputs = do-      let stepPrompt =-            "User Goal: "-              <> userGoal-              <> ( if null prevOutputs-                     then ""-                     else-                       "\n\nCompleted Steps So Far:\n"-                         <> T.unlines-                           [T.pack (show num) <> ". " <> desc <> " -> " <> out | (PlanStep num desc, out) <- prevOutputs]-                 )-              <> "\n\nCurrent Task To Execute (Step "-              <> T.pack (show (stepNumber currStep))-              <> "): "-              <> stepDescription currStep-              <> "\nExecute this task using any appropriate tools available and provide the outcome:"-      stepOut <- executeStep stepExecutor stepPrompt-      executeSteps restSteps (prevOutputs ++ [(currStep, stepOut)])

@@ -1,107 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--{- |-Module      : Langchain.Agent.ReAct-Description : Effect-polymorphic ReAct (Reasoning + Acting) Agent engine-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Modernized ReAct agent operating over ChatModel, Tool m, and multi-modal Message history.-Uses 'ToolBinder' to pass tool definitions to the LLM provider in a provider-agnostic way.--}-module Langchain.Agent.ReAct-  ( AgentStep (..)-  , ReActAgent (..)-  , createReActAgent-  , reactStep-  , runReActAgent-  ) where--import Control.Monad (forM)-import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.List (find)--import Langchain.Core.Error (LangchainError, agentError, errorMessage)-import Langchain.Core.Model-import qualified Langchain.Core.Model.Types as M-import Langchain.Core.Tool-import Langchain.Tool.Binding (ToolBinder (..))---- | Step result of ReAct reasoning iteration-data AgentStep-  = AgentAction Message [ToolCall]-  | AgentFinish Message-  deriving (Eq, Show)---- | Effect-polymorphic ReAct Agent configuration-data ReActAgent model m = ReActAgent-  { agentModel :: model-  , agentTools :: [Tool m]-  , agentMaxIterations :: Int-  }---- | Construct a ReAct Agent instance-createReActAgent :: model -> [Tool m] -> ReActAgent model m-createReActAgent model tools =-  ReActAgent-    { agentModel = model-    , agentTools = tools-    , agentMaxIterations = 10-    }---- | Run a single step of ReAct reasoning using ChatModel-reactStep ::-  forall model m.-  (ToolBinder model m, MonadIO m, MonadError LangchainError m) =>-  model ->-  [Tool m] ->-  [Message] ->-  m AgentStep-reactStep model tools history = do-  let cfg = bindToolsConfig @model tools Nothing-  responseMsg <- invoke model history cfg-  case messageToolCalls responseMsg of-    Just tcs@(_ : _) -> pure $ AgentAction responseMsg tcs-    _ -> pure $ AgentFinish responseMsg---- | Execute the full ReAct reasoning loop until AgentFinish or max iterations reached-runReActAgent ::-  (ToolBinder model m, MonadIO m, MonadError LangchainError m) =>-  ReActAgent model m ->-  [Message] ->-  m Message-runReActAgent agent initialHistory = go initialHistory (agentMaxIterations agent)-  where-    go history maxIter-      | maxIter <= 0 = throwError $ agentError "ReAct Agent exceeded maximum iterations" Nothing Nothing-      | otherwise = do-          step <- reactStep (agentModel agent) (agentTools agent) history-          case step of-            AgentFinish finalMsg -> pure finalMsg-            AgentAction respMsg tcs -> do-              obsMsgs <- forM tcs $ \tc -> do-                let tName = toolCallName tc-                outTxt <- case find (\t -> toolName t == tName) (agentTools agent) of-                  Nothing ->-                    pure $ "Error: Tool not found: " <> tName-                  Just tool -> do-                    eOut <- toolExecute tool (toolCallArguments tc)-                    case eOut of-                      Left err ->-                        pure $ "Error executing tool " <> tName <> ": " <> errorMessage err-                      Right out ->-                        pure out-                pure $-                  (textMessage M.Tool outTxt)-                    { M.messageName = Just tName-                    , M.messageToolId = Just (toolCallId tc)-                    }-              let newHistory = history ++ [respMsg] ++ obsMsgs-              go newHistory (maxIter - 1)

@@ -1,255 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--{- |-Module      : Langchain.Cache.Core-Description : LLM response caching layer with in-memory and SQLite backends-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Transparent caching for ChatModel invocations to reduce latency, cost, and API usage.--}-module Langchain.Cache.Core-  ( CacheBackend (..)-  , InMemoryCache (..)-  , newInMemoryCache-  , SQLiteCache (..)-  , newSQLiteCache-  , CachedModel (..)-  , CacheableChatModel (..)-  , withCaching-  , computeCacheKey-  )-where--import Control.Concurrent.STM-import Control.Exception (SomeException, try)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (ToJSON, Value, decode, encode, object, (.=))-import qualified Data.ByteString.Lazy as LBS-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text as TS-import qualified Data.Text.Encoding as TE-import Database.SQLite.Simple-import Langchain.Core.Model-  ( ChatModel (..)-  , Message (..)-  )-import Langchain.Provider.Gemini (Gemini (..))-import Langchain.Provider.Ollama (ModelName (..), Ollama (..))-import Langchain.Provider.OpenAI (OpenAI (..))-import Langchain.Tool.Binding (ToolBinder (..))-import qualified Ollama.API.Chat as OllamaChat-import Ollama.Client (OllamaClient (..))-import Ollama.Client.Config (OllamaClientConfig (..))---- | Effect-polymorphic cache backend typeclass-class CacheBackend cb where-  getCache :: (MonadIO m) => cb -> Text -> m (Maybe Message)-  putCache :: (MonadIO m) => cb -> Text -> Message -> m ()-  clearCache :: (MonadIO m) => cb -> m ()---- | Thread-safe in-memory cache backed by STM TVar-newtype InMemoryCache = InMemoryCache-  { memCacheVar :: TVar (Map Text Message)-  }---- | Construct a new InMemoryCache-newInMemoryCache :: (MonadIO m) => m InMemoryCache-newInMemoryCache = liftIO $ do-  var <- newTVarIO Map.empty-  pure $ InMemoryCache var--instance CacheBackend InMemoryCache where-  getCache InMemoryCache {..} key = liftIO $ do-    m <- readTVarIO memCacheVar-    pure $ Map.lookup key m--  putCache InMemoryCache {..} key msg = liftIO $ do-    atomically $ modifyTVar' memCacheVar (Map.insert key msg)--  clearCache InMemoryCache {..} = liftIO $ do-    atomically $ writeTVar memCacheVar Map.empty---- | Persistent SQLite cache backend-newtype SQLiteCache = SQLiteCache-  { sqliteCacheDbPath :: FilePath-  }---- | Construct a new SQLiteCache and create cache table-newSQLiteCache :: (MonadIO m) => FilePath -> m SQLiteCache-newSQLiteCache dbPath = liftIO $ do-  _ <--    ( try $ withConnection dbPath $ \conn -> do-        execute_-          conn-          "CREATE TABLE IF NOT EXISTS langchain_cache (\-          \ cache_key TEXT PRIMARY KEY,\-          \ response_json TEXT NOT NULL,\-          \ created_at DATETIME DEFAULT CURRENT_TIMESTAMP\-          \);"-    ) ::-      IO (Either SomeException ())-  pure $ SQLiteCache dbPath--instance CacheBackend SQLiteCache where-  getCache SQLiteCache {..} key = liftIO $ do-    rowsRes <--      ( try $ withConnection sqliteCacheDbPath $ \conn -> do-          query conn "SELECT response_json FROM langchain_cache WHERE cache_key = ?" (Only (TS.unpack key)) ::-            IO [Only String]-      ) ::-        IO (Either SomeException [Only String])-    case rowsRes of-      Right [Only jsonStr] ->-        let bs = LBS.fromStrict (TE.encodeUtf8 (TS.pack jsonStr))-         in pure (decode bs)-      _ -> pure Nothing--  putCache SQLiteCache {..} key msg = liftIO $ do-    let jsonStr = TS.unpack $ TE.decodeUtf8 $ LBS.toStrict (encode msg)-    _ <--      ( try $ withConnection sqliteCacheDbPath $ \conn -> do-          execute-            conn-            "INSERT OR REPLACE INTO langchain_cache (cache_key, response_json) VALUES (?, ?)"-            (TS.unpack key, jsonStr)-      ) ::-        IO (Either SomeException ())-    pure ()--  clearCache SQLiteCache {..} = liftIO $ do-    _ <--      ( try $ withConnection sqliteCacheDbPath $ \conn -> do-          execute_ conn "DELETE FROM langchain_cache;"-      ) ::-        IO (Either SomeException ())-    pure ()---- | ChatModel wrapper that provides transparent response caching-data CachedModel model cache = CachedModel-  { underlyingModel :: model-  , modelCache :: cache-  }--{- | Wrap a cacheable chat model with a cache backend.--The wrapped model uses the provider-specific identity supplied by-'CacheableChatModel' when looking up responses.--}-withCaching :: model -> cache -> CachedModel model cache-withCaching = CachedModel---- | Encode a value as JSON text suitable for a cache key.-toJsonText :: (ToJSON a) => a -> Text-toJsonText = TE.decodeUtf8 . LBS.toStrict . encode--{- | Provider-specific data that distinguishes cacheable model invocations.--Implementations should include every model property and effective invocation-parameter that can affect a response, but must not include credentials.--}-class (ChatModel model) => CacheableChatModel model where-  -- | Return the JSON identity used to distinguish this model's cache entries.-  cacheModelIdentity :: model -> Maybe (ModelConfig model) -> Value--instance CacheableChatModel OpenAI where-  cacheModelIdentity OpenAI {..} _ =-    object-      [ "provider" .= ("openai" :: Text)-      , "model" .= model-      , "baseUrl" .= baseUrl-      , "temperature" .= temperature-      ]--instance CacheableChatModel Ollama where-  cacheModelIdentity o cfg =-    let effectiveOptions = cfg >>= OllamaChat.chatOptions-        effectiveKeepAlive = cfg >>= OllamaChat.chatKeepAlive-        effectiveModel = case cfg of-          Just r ->-            let m = unModelName (OllamaChat.chatModel r)-             in if TS.null m then ollamaModelName o else m-          Nothing -> ollamaModelName o-     in object-          [ "provider" .= ("ollama" :: Text)-          , "baseUrl" .= configBaseUrl (clientConfig (client o))-          , "model" .= effectiveModel-          , "config"-              .= object-                [ "tools" .= (OllamaChat.chatTools <$> cfg)-                , "format" .= (OllamaChat.chatFormat <$> cfg)-                , "options" .= effectiveOptions-                , "keep_alive" .= effectiveKeepAlive-                , "think" .= (OllamaChat.chatThink <$> cfg)-                ]-          ]--instance CacheableChatModel Gemini where-  cacheModelIdentity (Gemini _ modelName baseUrl) config-    | effectiveBaseUrl == defaultGeminiBaseUrl = defaultIdentity-    | otherwise =-        object $-          [ "provider" .= ("gemini" :: Text)-          , "model" .= modelName-          , "baseUrl" .= effectiveBaseUrl-          ]-            <> maybe [] (pure . ("config" .=)) config-    where-      effectiveBaseUrl = TS.dropWhileEnd (== '/') $ fromMaybe "" baseUrl-      defaultGeminiBaseUrl = "https://generativelanguage.googleapis.com"-      defaultIdentity =-        object $-          [ "provider" .= ("gemini" :: Text)-          , "model" .= modelName-          ]-            <> maybe [] (pure . ("config" .=)) config--{- | Compute a canonical cache key from a model identity and complete input messages.--The key includes all fields of each 'Message', so multi-modal content and-tool calls cannot collide with text-only requests.--}-computeCacheKey ::-  (CacheableChatModel model) => model -> Maybe (ModelConfig model) -> [Message] -> Text-computeCacheKey model cfg msgs =-  toJsonText $-    object-      [ "model" .= cacheModelIdentity model cfg-      , "messages" .= msgs-      ]--instance (CacheableChatModel model, CacheBackend cache) => ChatModel (CachedModel model cache) where-  type ModelConfig (CachedModel model cache) = ModelConfig model--  invoke CachedModel {..} msgs mbCfg = do-    let key = computeCacheKey underlyingModel mbCfg msgs-    mbCached <- getCache modelCache key-    case mbCached of-      Just cachedMsg -> pure cachedMsg-      Nothing -> do-        freshMsg <- invoke underlyingModel msgs mbCfg-        putCache modelCache key freshMsg-        pure freshMsg--  stream CachedModel {..} =-    stream underlyingModel---- | Delegate tool binding to the underlying model-instance-  (CacheableChatModel model, CacheBackend cache, ToolBinder model m) =>-  ToolBinder (CachedModel model cache) m-  where-  bindToolsConfig = bindToolsConfig @model

@@ -1,100 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Callback.Manager-Description : Typed event-driven callback system with synchronous and asynchronous dispatch-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Provides typed callback lifecycle events across models, tools, chains, and state graphs,-with support for filtering and non-blocking asynchronous event dispatch.--}-module Langchain.Callback.Manager-  ( CallbackEvent (..)-  , CallbackHandler (..)-  , CallbackManager (..)-  , newCallbackManager-  , registerHandler-  , dispatchEvent-  , dispatchEventAsync-  , newLoggingCallbackHandler-  , getCallbackLogs-  ) where--import Control.Concurrent.Async (async)-import Control.Concurrent.STM-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (FromJSON, ToJSON, Value)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock (UTCTime)-import GHC.Generics (Generic)---- | Comprehensive lifecycle events emitted across Langchain components-data CallbackEvent-  = OnLLMStart !Text ![Text] !UTCTime -- Model name, Prompt inputs, Timestamp-  | OnLLMEnd !Text !Text !Int !UTCTime -- Model name, Output text, Latency micros, Timestamp-  | OnToolStart !Text !Value !UTCTime -- Tool name, Arguments, Timestamp-  | OnToolEnd !Text !Text !Int !UTCTime -- Tool name, Output text, Latency micros, Timestamp-  | OnRetrieverStart !Text !Text !UTCTime -- Retriever name, Query, Timestamp-  | OnRetrieverEnd !Text ![Text] !Int !UTCTime -- Retriever name, Retrieved snippets, Latency micros, Timestamp-  | OnChainStart !Text !Text !UTCTime -- Chain name, Input, Timestamp-  | OnChainEnd !Text !Text !Int !UTCTime -- Chain name, Output, Latency micros, Timestamp-  | OnGraphNodeStart !Text !Text !UTCTime -- NodeId, State summary, Timestamp-  | OnGraphNodeEnd !Text !Text !Int !UTCTime -- NodeId, Next node/state summary, Latency micros, Timestamp-  | OnError !Text !Text !UTCTime -- Component name, Error message, Timestamp-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Handler for processing emitted callback events-data CallbackHandler = CallbackHandler-  { handlerName :: !Text-  , handleEvent :: CallbackEvent -> IO ()-  }---- | Thread-safe CallbackManager backed by STM TVar-newtype CallbackManager = CallbackManager-  { handlersVar :: TVar [CallbackHandler]-  }---- | Construct an empty CallbackManager-newCallbackManager :: MonadIO m => m CallbackManager-newCallbackManager = liftIO $ do-  var <- newTVarIO []-  pure $ CallbackManager var---- | Register a new callback handler-registerHandler :: MonadIO m => CallbackManager -> CallbackHandler -> m ()-registerHandler CallbackManager {..} handler = liftIO $ do-  atomically $ modifyTVar' handlersVar (\handlers -> handlers ++ [handler])---- | Dispatch an event synchronously to all registered handlers-dispatchEvent :: MonadIO m => CallbackManager -> CallbackEvent -> m ()-dispatchEvent CallbackManager {..} event = liftIO $ do-  handlers <- readTVarIO handlersVar-  mapM_ (`handleEvent` event) handlers---- | Dispatch an event asynchronously in background threads without blocking-dispatchEventAsync :: MonadIO m => CallbackManager -> CallbackEvent -> m ()-dispatchEventAsync CallbackManager {..} event = liftIO $ do-  handlers <- readTVarIO handlersVar-  mapM_ (\h -> async (handleEvent h event)) handlers---- | Create a simple callback handler that logs event descriptions into an STM TVar-newLoggingCallbackHandler :: MonadIO m => Text -> m (CallbackHandler, TVar [Text])-newLoggingCallbackHandler name = liftIO $ do-  logsVar <- newTVarIO []-  let handler =-        CallbackHandler-          { handlerName = name-          , handleEvent = \event -> atomically $ modifyTVar' logsVar (\logs -> logs ++ [T.pack (show event)])-          }-  pure (handler, logsVar)---- | Read all logs accumulated by a logging callback handler-getCallbackLogs :: MonadIO m => TVar [Text] -> m [Text]-getCallbackLogs = liftIO . readTVarIO

@@ -1,99 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Chain.MapReduce-Description : Map-Reduce document summarization and synthesis chain-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Applies a map LLM prompt individually over each document, then combines and synthesizes results-using a reduce LLM prompt.--}-module Langchain.Chain.MapReduce-  ( MapReduceChain (..)-  , newMapReduceChain-  , defaultMapPrompt-  , defaultReducePrompt-  , runMapReduceChain-  ) where--import Control.Monad (forM)-import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model-  ( ChatModel (..)-  , Message-  , extractMessageText-  , userMessage-  )-import Langchain.DocumentLoader.Core (Document (..))-import Langchain.PromptTemplate.Prompt (PromptTemplate, fromTemplate, renderPrompt)---- | Map-Reduce chain configuration-data MapReduceChain model = MapReduceChain-  { mapReduceModel :: model-  , mapPromptTemplate :: PromptTemplate-  , reducePromptTemplate :: PromptTemplate-  , mapDocVar :: Text-  , reduceDocVar :: Text-  }---- | Default map prompt for individual document summarization-defaultMapPrompt :: PromptTemplate-defaultMapPrompt =-  fromTemplate-    "Summarize the key information in the following document concisely:\n\n{document}\n\nSummary:"---- | Default reduce prompt for synthesizing all document summaries-defaultReducePrompt :: PromptTemplate-defaultReducePrompt =-  fromTemplate-    "Combine and synthesize the following summaries into a comprehensive final response:\n\n{summaries}\n\nFinal Synthesis:"---- | Construct a new MapReduceChain-newMapReduceChain :: model -> MapReduceChain model-newMapReduceChain m =-  MapReduceChain-    { mapReduceModel = m-    , mapPromptTemplate = defaultMapPrompt-    , reducePromptTemplate = defaultReducePrompt-    , mapDocVar = "document"-    , reduceDocVar = "summaries"-    }---- | Execute MapReduceChain across documents-runMapReduceChain ::-  (ChatModel model, MonadIO m, MonadError LangchainError m) =>-  MapReduceChain model ->-  [Document] ->-  Map Text Text ->-  m Message-runMapReduceChain MapReduceChain {..} docs baseVars = do-  -- Phase 1: Map over each document-  summaries <- forM docs $ \doc -> do-    let docTxt = TL.toStrict (pageContent doc)-        vars = Map.insert mapDocVar docTxt baseVars-    rendered <- case renderPrompt mapPromptTemplate vars of-      Left err -> throwError err-      Right p -> pure p-    resp <- invoke mapReduceModel [userMessage rendered] Nothing-    pure $ extractMessageText resp--  -- Phase 2: Reduce summaries into final synthesis-  let combinedSummaries = T.intercalate "\n\n---\n\n" summaries-      reduceVars = Map.insert reduceDocVar combinedSummaries baseVars-  renderedReduce <- case renderPrompt reducePromptTemplate reduceVars of-    Left err -> throwError err-    Right p -> pure p-  invoke mapReduceModel [userMessage renderedReduce] Nothing

@@ -1,75 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Chain.RetrievalQA-Description : Effect-polymorphic RetrievalQA chain-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--RetrievalQA chain combining retriever search, context assembly, prompt rendering,-and ChatModel question answering.--}-module Langchain.Chain.RetrievalQA-  ( RetrievalQA (..)-  , newRetrievalQA-  , defaultQAPrompt-  , runRetrievalQA-  ) where--import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.Map.Strict (fromList)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model-  ( ChatModel (..)-  , Message-  , systemMessage-  , userMessage-  )-import Langchain.DocumentLoader.Core (Document (..))-import Langchain.PromptTemplate.Prompt (PromptTemplate, fromTemplate, renderPrompt)-import Langchain.Retriever.Core (Retriever (..))---- | QA Chain configuration combining retrieval and LLM response generation.-data RetrievalQA model retriever = RetrievalQA-  { model :: model-  , retriever :: retriever-  , prompt :: PromptTemplate-  }---- | Construct a new RetrievalQA chain with default prompt-newRetrievalQA :: model -> retriever -> RetrievalQA model retriever-newRetrievalQA m r = RetrievalQA m r defaultQAPrompt---- | Default QA prompt template-defaultQAPrompt :: PromptTemplate-defaultQAPrompt =-  fromTemplate-    ( "Use the following pieces of context to answer the question at the end.\n"-        <> "If you don't know the answer, just say that you don't know, don't try to make up an answer.\n\n"-        <> "Context:\n{context}"-    )---- | Execute RetrievalQA chain on a user question-runRetrievalQA ::-  (ChatModel model, Retriever retriever, MonadIO m, MonadError LangchainError m) =>-  RetrievalQA model retriever ->-  Text ->-  m Message-runRetrievalQA RetrievalQA {..} question = do-  docs <- getRelevantDocuments retriever question-  let contextText = T.intercalate "\n\n" $ map (TL.toStrict . pageContent) docs-      vars = fromList [("context", contextText)]-  renderedPrompt <- case renderPrompt prompt vars of-    Left err -> throwError err-    Right p -> pure p-  let conversation = [systemMessage renderedPrompt, userMessage question]-  invoke model conversation Nothing

@@ -1,57 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--{- |-Module      : Langchain.DocumentLoader.Core-Description : Core document loading functionality for LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Implementation of LangChain's document loading abstraction.--}-module Langchain.DocumentLoader.Core-  ( Document (..)-  , BaseLoader (..)-  ) where--import Control.Monad.Except (MonadError)-import Control.Monad.IO.Class (MonadIO)-import Data.Aeson (Value)-import Data.Map (Map, empty)-import qualified Data.Text as TS-import Data.Text.Lazy (Text)--import Langchain.Core.Error (LangchainError)---- | Document container with content and metadata-data Document = Document-  { pageContent :: Text-  -- ^ The text content of the document-  , metadata :: Map TS.Text Value-  -- ^ Additional metadata (e.g., source, page number)-  }-  deriving (Show, Eq)--instance Semigroup Document where-  doc1 <> doc2 =-    Document-      (pageContent doc1 <> pageContent doc2)-      (metadata doc1 <> metadata doc2)--instance Monoid Document where-  mempty = Document mempty empty---- | Effect-polymorphic BaseLoader typeclass-class BaseLoader loader where-  -- | Load all documents from the source-  load ::-    (MonadIO m, MonadError LangchainError m) =>-    loader ->-    m [Document]--  -- | Load all documents and split their content-  loadAndSplit ::-    (MonadIO m, MonadError LangchainError m) =>-    loader ->-    m [Text]

@@ -1,127 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.DocumentLoader.Csv-Description : CSV file document loader-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Loads CSV files as LangChain Documents where each row produces a Document.--}-module Langchain.DocumentLoader.Csv-  ( CsvLoader (..)-  , defaultCsvLoader-  , parseCsvRows-  ) where--import Control.Exception (try)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Aeson (Value (..))-import qualified Data.Map.Strict as Map-import qualified Data.Text as TS-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TLIO--import Langchain.Core.Error (documentLoaderError)-import Langchain.DocumentLoader.Core (BaseLoader (..), Document (..))-import Langchain.TextSplitter.Character (defaultCharacterSplitterOps, splitText)---- | Configuration options for CSV loader-data CsvLoader = CsvLoader-  { csvFilePath :: FilePath-  , csvDelimiter :: Char-  , csvContentColumns :: Maybe [TS.Text]-  -- ^ Optional list of columns to include in pageContent. If Nothing, all columns are concatenated.-  , csvSplitter :: Maybe (Text -> [Text])-  }---- | Default CSV loader configuration-defaultCsvLoader :: FilePath -> CsvLoader-defaultCsvLoader path =-  CsvLoader-    { csvFilePath = path-    , csvDelimiter = ','-    , csvContentColumns = Nothing-    , csvSplitter = Nothing-    }--instance BaseLoader CsvLoader where-  load loader = do-    contentRes <- liftIO $ try $ TLIO.readFile (csvFilePath loader)-    content <- case contentRes of-      Left err ->-        throwError $-          documentLoaderError-            (TS.pack $ "Failed to read CSV file: " ++ show (err :: IOError))-            (Just "CsvLoader")-            Nothing-      Right c -> pure c--    let rows = parseCsvRows (csvDelimiter loader) content-    case rows of-      [] -> pure []-      (headers : dataRows) -> do-        let headerTexts = map (TS.pack . TL.unpack . TL.strip) headers-            docs =-              [ makeDocument headerTexts (map TL.strip row) (csvContentColumns loader) (csvFilePath loader) idx-              | (idx, row) <- zip [1 ..] dataRows-              , not (null row) && not (all TL.null row)-              ]-        pure docs--  loadAndSplit loader = do-    docs <- load loader-    let splitter = case csvSplitter loader of-          Just s -> s-          Nothing -> splitText defaultCharacterSplitterOps-    pure $ concatMap (splitter . pageContent) docs--makeDocument :: [TS.Text] -> [Text] -> Maybe [TS.Text] -> FilePath -> Int -> Document-makeDocument headers values mbSelectedCols filePath rowIdx =-  let pairs = zip headers values-      metaMap =-        Map.fromList-          [ (h, String (TS.pack $ TL.unpack val))-          | (h, val) <- pairs-          ]-      metaWithSource =-        Map.insert "source" (String $ TS.pack filePath) $-          Map.insert "row" (Number $ fromIntegral rowIdx) metaMap-      contentLines = case mbSelectedCols of-        Just selected ->-          [ h <> ": " <> TS.pack (TL.unpack val)-          | (h, val) <- pairs-          , h `elem` selected-          ]-        Nothing ->-          [ h <> ": " <> TS.pack (TL.unpack val)-          | (h, val) <- pairs-          ]-      content = TL.pack $ TS.unpack $ TS.intercalate "\n" contentLines-   in Document content metaWithSource---- | Robust CSV line parser supporting quoted cells with commas-parseCsvRows :: Char -> Text -> [[Text]]-parseCsvRows delim text =-  let allLines = TL.lines text-   in map (parseCsvLine delim) allLines--parseCsvLine :: Char -> Text -> [Text]-parseCsvLine delim line = go False [] "" (TL.unpack line)-  where-    go :: Bool -> [Text] -> String -> String -> [Text]-    go _ acc cur [] = reverse (TL.pack (reverse cur) : acc)-    go inQuote acc cur ('"' : cs) =-      case cs of-        ('"' : rest) -> go inQuote acc ('"' : cur) rest-        _ -> go (not inQuote) acc cur cs-    go inQuote acc cur (c : cs)-      | c == delim && not inQuote =-          go inQuote (TL.pack (reverse cur) : acc) "" cs-      | otherwise =-          go inQuote acc (c : cur) cs

@@ -1,125 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.DocumentLoader.DirectoryLoader-Description : Directory loading implementation for LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--DirectoryLoader document loader reads files from disk into Documents.--}-module Langchain.DocumentLoader.DirectoryLoader-  ( DirectoryLoader (..)-  , DirectoryLoaderOptions (..)-  , defaultDirectoryLoaderOptions-  ) where--import Control.Concurrent.Async (mapConcurrently)-import Control.Monad (filterM, forM)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Maybe (listToMaybe)-import qualified Data.Text as T-import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)-import System.FilePath (takeExtension, takeFileName, (</>))--import Langchain.Core.Error (documentLoaderError)-import Langchain.DocumentLoader.Core-import Langchain.DocumentLoader.FileLoader (FileLoader (FileLoader))-import Langchain.TextSplitter.Character---- | Options for directory loading behavior-data DirectoryLoaderOptions = DirectoryLoaderOptions-  { recursiveDepth :: Maybe Int-  -- ^ Nothing = unlimited depth, Just 0 = No recursive, Just 3 = 3 level deep-  , extensions :: [String]-  -- ^ File extensions to include (e.g., [".txt", ".md"])-  , excludeHidden :: Bool-  -- ^ Whether to exclude hidden files (starting with '.')-  , useMultithreading :: Bool-  -- ^ Whether to use multithreading when loading files-  }-  deriving (Eq, Show)---- | Default directory loader options-defaultDirectoryLoaderOptions :: DirectoryLoaderOptions-defaultDirectoryLoaderOptions =-  DirectoryLoaderOptions-    { recursiveDepth = Nothing-    , extensions = []-    , excludeHidden = True-    , useMultithreading = False-    }---- | Directory loader configuration-data DirectoryLoader = DirectoryLoader-  { dirPath :: FilePath-  , directoryLoaderOptions :: DirectoryLoaderOptions-  }-  deriving (Eq, Show)---- | Helper to check if a file should be included based on options-shouldIncludeFile :: DirectoryLoaderOptions -> FilePath -> Bool-shouldIncludeFile opts path =-  let ext = takeExtension path-      fName = takeFileName path-      isHidden = listToMaybe fName == Just '.'-      matchesExt = null (extensions opts) || ext `elem` extensions opts-      passesHiddenCheck = not (excludeHidden opts) || not isHidden-   in matchesExt && passesHiddenCheck---- | Get all files in a directory, with controlled recursion-getFilesInDirectory :: DirectoryLoaderOptions -> Int -> FilePath -> IO [FilePath]-getFilesInDirectory opts currentDepth dir = do-  let canRecurse = case recursiveDepth opts of-        Nothing -> True-        Just maxD -> currentDepth < maxD--  entries <- listDirectory dir-  let fullPaths = map (dir </>) entries--  files <- filterM doesFileExist fullPaths-  let filteredFiles = filter (shouldIncludeFile opts) files--  subFiles <--    if canRecurse-      then do-        subdirs <- filterM doesDirectoryExist fullPaths-        let visibleSubdirs =-              if excludeHidden opts-                then filter (\d -> not (null d) && listToMaybe d /= Just '.') subdirs-                else subdirs--        if useMultithreading opts && not (null visibleSubdirs)-          then-            concat-              <$> mapConcurrently-                (getFilesInDirectory opts (currentDepth + 1))-                visibleSubdirs-          else concat <$> mapM (getFilesInDirectory opts (currentDepth + 1)) visibleSubdirs-      else pure []--  pure $ filteredFiles ++ subFiles--instance BaseLoader DirectoryLoader where-  load DirectoryLoader {..} = do-    exists <- liftIO $ doesDirectoryExist dirPath-    if exists-      then do-        filePaths <- liftIO $ getFilesInDirectory directoryLoaderOptions 0 dirPath-        fmap concat $ forM filePaths $ \path ->-          load (FileLoader path)-      else-        throwError $-          documentLoaderError-            (T.pack $ "Directory does not exist: " ++ dirPath)-            (Just "DirectoryLoader")-            (Just $ T.pack dirPath)--  loadAndSplit dirLoader = do-    documents <- load dirLoader-    pure $ splitText defaultCharacterSplitterOps (pageContent $ mconcat documents)

@@ -1,76 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.DocumentLoader.FileLoader-Description : File loading implementation for LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--File-based document loader implementation following LangChain's document loading patterns.--}-module Langchain.DocumentLoader.FileLoader-  ( FileLoader (..)-  ) where--import Control.Exception (SomeException, try)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Aeson-import Data.Map (fromList)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import System.Directory (doesFileExist)--import Langchain.Core.Error (documentLoaderError)-import Langchain.DocumentLoader.Core-import Langchain.TextSplitter.Character---- | File loader configuration-newtype FileLoader = FileLoader FilePath-  deriving (Eq, Show)--instance BaseLoader FileLoader where-  load (FileLoader path) = do-    exists <- liftIO $ doesFileExist path-    if exists-      then do-        eContent <- liftIO $ try (readFile path)-        case eContent of-          Left err ->-            throwError $-              documentLoaderError-                (T.pack $ "Error reading file " ++ path ++ ": " ++ show (err :: SomeException))-                (Just "FileLoader")-                (Just $ T.pack path)-          Right content -> do-            let meta = fromList [("source", String $ T.pack path)]-            pure [Document (TL.pack content) meta]-      else-        throwError $-          documentLoaderError-            (T.pack $ "File not found: " ++ path)-            (Just "FileLoader")-            (Just $ T.pack path)--  loadAndSplit (FileLoader path) = do-    exists <- liftIO $ doesFileExist path-    if exists-      then do-        eContent <- liftIO $ try (readFile path)-        case eContent of-          Left err ->-            throwError $-              documentLoaderError-                (T.pack $ "Error reading file " ++ path ++ ": " ++ show (err :: SomeException))-                (Just "FileLoader")-                (Just $ T.pack path)-          Right content -> pure $ splitText defaultCharacterSplitterOps (TL.pack content)-      else-        throwError $-          documentLoaderError-            (T.pack $ "File not found: " ++ path)-            (Just "FileLoader")-            (Just $ T.pack path)

@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--{- |-Module      : Langchain.Embeddings.Core-Description : Effect-polymorphic embedding model interface-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Effect-polymorphic Embeddings typeclass.--}-module Langchain.Embeddings.Core-  ( Embeddings (..)-  ) where--import Control.Monad.Except (MonadError)-import Control.Monad.IO.Class (MonadIO)-import Data.Text (Text)--import Langchain.Core.Error (LangchainError)-import Langchain.DocumentLoader.Core (Document)---- | Effect-polymorphic Embeddings typeclass-class Embeddings embed where-  -- | Convert documents to embedding vectors-  embedDocuments ::-    (MonadIO m, MonadError LangchainError m) =>-    embed ->-    [Document] ->-    m [[Float]]--  -- | Convert query text to embedding vector-  embedQuery ::-    (MonadIO m, MonadError LangchainError m) =>-    embed ->-    Text ->-    m [Float]

@@ -1,75 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Embeddings.Ollama-Description : Ollama integration for text embeddings in LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Ollama implementation of LangChain's embedding interface using ollama-haskell 0.3.0.0.--}-module Langchain.Embeddings.Ollama-  ( OllamaEmbeddings (..)-  ) where--import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import Langchain.Core.Error (llmError)-import Langchain.DocumentLoader.Core (Document (..))-import Langchain.Embeddings.Core--import Ollama.API.Embed (EmbedRequest (..), EmbedResponse (..), embed)-import Ollama.Client (defaultClient)-import Ollama.Types.Common (ModelName (..))-import Ollama.Types.Options (ModelOptions)--data OllamaEmbeddings = OllamaEmbeddings-  { model :: Text-  , defaultTruncate :: Maybe Bool-  , defaultKeepAlive :: Maybe Text-  , modelOptions :: Maybe ModelOptions-  }-  deriving (Show, Eq)--instance Embeddings OllamaEmbeddings where-  embedDocuments (OllamaEmbeddings {..}) docs = do-    client <- liftIO defaultClient-    let inputs = map (TL.toStrict . pageContent) docs-        req =-          EmbedRequest-            { embModel = ModelName model-            , embInput = Right inputs-            , embTruncate = defaultTruncate-            , embOptions = modelOptions-            , embKeepAlive = defaultKeepAlive-            , embDimensions = Nothing-            }-    eRes <- liftIO $ embed client req-    case eRes of-      Left ollamaErr -> throwError $ llmError (T.pack (show ollamaErr)) (Just "OllamaEmbeddings") Nothing-      Right resp -> pure $ map (map realToFrac) (erEmbeddings resp)--  embedQuery (OllamaEmbeddings {..}) query = do-    client <- liftIO defaultClient-    let req =-          EmbedRequest-            { embModel = ModelName model-            , embInput = Left query-            , embTruncate = defaultTruncate-            , embOptions = modelOptions-            , embKeepAlive = defaultKeepAlive-            , embDimensions = Nothing-            }-    eRes <- liftIO $ embed client req-    case eRes of-      Left err -> throwError $ llmError (T.pack (show err)) (Just "OllamaEmbeddings") Nothing-      Right resp -> case erEmbeddings resp of-        (vec : _) -> pure $ map realToFrac vec-        [] -> throwError $ llmError "Embeddings are empty" (Just "OllamaEmbeddings") Nothing

@@ -1,221 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}--{- |-Module      : Langchain.Embeddings.OpenAI-Description : OpenAI integration for text embeddings in LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--OpenAI implementation of LangChain's embedding interface.--}-module Langchain.Embeddings.OpenAI-  ( OpenAIEmbeddings (..)-  , defaultOpenAIEmbeddings-  , textEmbedding3Small-  , textEmbedding3Large-  , textEmbeddingAda-  , EncodingFormat (..)-  ) where--import Control.Exception (SomeException, try)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Aeson-import qualified Data.ByteString.Lazy as LBS-import Data.Maybe-import Data.Text (Text, unpack)-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text.Lazy as TL-import qualified Data.Vector as V-import GHC.Generics--import Langchain.Core.Error (llmError)-import Langchain.DocumentLoader.Core-import Langchain.Embeddings.Core-import Network.HTTP.Conduit-import Network.HTTP.Simple-  ( getResponseBody-  , getResponseStatus-  , setRequestBodyJSON-  , setRequestHeader-  , setRequestMethod-  )-import Network.HTTP.Types.Status (statusCode)---- Internal types for serialization of OpenAI request.-data EncodingFormat = FloatFormat | Base64Format-  deriving (Eq, Show, Generic)--data EmbeddingsInput = TextInput Text | TextList [Text]-  deriving (Show, Eq)--data OpenAIEmbeddingsRequest = OpenAIEmbeddingsRequest-  { inputReq :: EmbeddingsInput-  , modelReq :: Text-  , dimensionsReq :: Maybe Int-  , encodingFormatReq :: Maybe EncodingFormat-  }-  deriving (Show, Eq, Generic)--instance ToJSON EncodingFormat where-  toJSON FloatFormat = String "float"-  toJSON Base64Format = String "base64"--instance ToJSON EmbeddingsInput where-  toJSON (TextInput t) = String t-  toJSON (TextList t) = Array (V.fromList $ map String t)--instance ToJSON OpenAIEmbeddingsRequest where-  toJSON OpenAIEmbeddingsRequest {..} =-    object $-      [ "input" .= inputReq-      , "model" .= modelReq-      ]-        ++ catMaybes-          [ ("dimensions" .=) <$> dimensionsReq-          , ("encoding_format" .=) <$> encodingFormatReq-          ]---- Response-data EmbeddingsUsage = EmbeddingsUsage-  { promptTokens :: Int-  , totalTokens :: Int-  }-  deriving (Eq, Show, Generic)--data EmbeddingsObject = EmbeddingsObject-  { embeddings :: [Float]-  , index :: Maybe Int-  , objectType :: Text-  }-  deriving (Eq, Show, Generic)--data OpenAIEmbeddingsResponse = OpenAIEmbeddingsResponse-  { objectTypeResp :: Text-  , dataList :: [EmbeddingsObject]-  , responseModel :: Text-  , usage :: Maybe EmbeddingsUsage-  }-  deriving (Eq, Show, Generic)--instance FromJSON EmbeddingsUsage where-  parseJSON = withObject "EmbeddingsUsage" $ \v ->-    EmbeddingsUsage-      <$> v .: "prompt_tokens"-      <*> v .: "total_tokens"--instance FromJSON EmbeddingsObject where-  parseJSON = withObject "EmbeddingsObject" $ \v ->-    EmbeddingsObject-      <$> v .: "embedding"-      <*> v .:? "index"-      <*> v .: "object"--instance FromJSON OpenAIEmbeddingsResponse where-  parseJSON = withObject "OpenAIEmbeddingsResponse" $ \v ->-    OpenAIEmbeddingsResponse-      <$> v .: "object"-      <*> v .: "data"-      <*> v .: "model"-      <*> v .:? "usage"---- | Embeddings type for OpenAI-data OpenAIEmbeddings = OpenAIEmbeddings-  { apiKey :: Text-  , baseUrl :: Maybe String-  , model :: Text-  , dimensions :: Maybe Int-  , encodingFormat :: Maybe EncodingFormat-  , timeout :: Maybe Int-  }-  deriving (Eq, Generic)--instance Show OpenAIEmbeddings where-  show OpenAIEmbeddings {..} = "OpenAIEmbeddings " <> "model " <> unpack model--openAIEmbeddingsRequest ::-  OpenAIEmbeddings -> [Text] -> IO (Either String OpenAIEmbeddingsResponse)-openAIEmbeddingsRequest OpenAIEmbeddings {..} txts = do-  eReq <- try $ parseRequest $ fromMaybe "https://api.openai.com/v1" baseUrl <> "/embeddings"-  case eReq of-    Left (err :: SomeException) -> pure $ Left $ "Invalid URL: " ++ show err-    Right request_ -> do-      manager <--        newManager-          tlsManagerSettings-            { managerResponseTimeout =-                responseTimeoutMicro (fromMaybe 60 timeout * 1000000)-            }-      let req =-            setRequestMethod "POST" $-              setRequestHeader "Content-Type" ["application/json"] $-                setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] $-                  setRequestBodyJSON-                    ( OpenAIEmbeddingsRequest-                        { inputReq = TextList txts-                        , modelReq = model-                        , dimensionsReq = dimensions-                        , encodingFormatReq = encodingFormat-                        }-                    )-                    request_--      eResponse <- try (httpLbs req manager) :: IO (Either SomeException (Response LBS.ByteString))-      case eResponse of-        Left err -> pure $ Left $ "Network error: " ++ show err-        Right response -> do-          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)--instance Embeddings OpenAIEmbeddings where-  embedDocuments openAIEmbeddings docs = do-    eRes <- liftIO $ openAIEmbeddingsRequest openAIEmbeddings (map (TL.toStrict . pageContent) docs)-    case eRes of-      Left err -> throwError $ llmError (T.pack err) (Just "OpenAIEmbeddings") Nothing-      Right (OpenAIEmbeddingsResponse {..}) -> pure $ map embeddings dataList--  embedQuery openAIEmbeddings query = do-    eRes <- liftIO $ openAIEmbeddingsRequest openAIEmbeddings [query]-    case eRes of-      Left err -> throwError $ llmError (T.pack err) (Just "OpenAIEmbeddings") Nothing-      Right (OpenAIEmbeddingsResponse {..}) ->-        case listToMaybe dataList of-          Nothing -> throwError $ llmError "Embeddings are empty" (Just "OpenAIEmbeddings") Nothing-          Just x -> pure $ embeddings x--textEmbedding3Small :: Text-textEmbedding3Small = "text-embedding-3-small"--textEmbedding3Large :: Text-textEmbedding3Large = "text-embedding-3-large"--textEmbeddingAda :: Text-textEmbeddingAda = "text-embedding-ada-002"--defaultOpenAIEmbeddings :: OpenAIEmbeddings-defaultOpenAIEmbeddings =-  OpenAIEmbeddings-    { apiKey = ""-    , baseUrl = pure "https://api.openai.com/v1"-    , model = textEmbedding3Small-    , dimensions = Nothing-    , encodingFormat = Nothing-    , timeout = Nothing-    }

@@ -1,143 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.Guardrail.Core-Description : Agent input/output validation guardrails and safety filters-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Composable guardrails for validating prompt safety, topic restriction, and response format constraints.--}-module Langchain.Guardrail.Core-  ( GuardrailResult (..)-  , Guardrail (..)-  , contentSafetyGuardrail-  , topicGuardrail-  , outputLengthGuardrail-  , composeGuardrails-  , withGuardrails-  ) where--import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.Text (Text)-import qualified Data.Text as T--import Langchain.Core.Error (LangchainError, agentError)-import Langchain.Core.Model-  ( ChatModel (..)-  , extractMessageText-  , userMessage-  )---- | Outcome of evaluating a guardrail check-data GuardrailResult-  = GuardrailPass-  | GuardrailFail !Text -- Reason for failure-  deriving (Show, Eq)---- | Composable guardrail container-data Guardrail m = Guardrail-  { guardrailName :: !Text-  , validateInput :: Text -> m GuardrailResult-  , validateOutput :: Text -> m GuardrailResult-  }---- | Simple keyword-based content safety guardrail-contentSafetyGuardrail :: MonadIO m => [Text] -> Guardrail m-contentSafetyGuardrail forbiddenWords =-  Guardrail-    { guardrailName = "ContentSafety"-    , validateInput = \input ->-        let lower = T.toLower input-            matched = filter (`T.isInfixOf` lower) (map T.toLower forbiddenWords)-         in pure $-              if null matched-                then GuardrailPass-                else GuardrailFail ("Input contains forbidden content: " <> T.intercalate ", " matched)-    , validateOutput = \output ->-        let lower = T.toLower output-            matched = filter (`T.isInfixOf` lower) (map T.toLower forbiddenWords)-         in pure $-              if null matched-                then GuardrailPass-                else GuardrailFail ("Output contains forbidden content: " <> T.intercalate ", " matched)-    }---- | Output length guardrail-outputLengthGuardrail :: MonadIO m => Int -> Guardrail m-outputLengthGuardrail maxLen =-  Guardrail-    { guardrailName = "OutputLength"-    , validateInput = \_ -> pure GuardrailPass-    , validateOutput = \out ->-        if T.length out <= maxLen-          then pure GuardrailPass-          else-            pure $-              GuardrailFail-                ("Output length (" <> T.pack (show (T.length out)) <> ") exceeds limit of " <> T.pack (show maxLen))-    }---- | LLM-based topic relevance guardrail-topicGuardrail ::-  (ChatModel model, MonadIO m, MonadError LangchainError m) => model -> Text -> Guardrail m-topicGuardrail model allowedTopic =-  Guardrail-    { guardrailName = "TopicRestriction"-    , validateInput = \input -> do-        let prompt =-              "Allowed Topic: "-                <> allowedTopic-                <> "\n\nUser Input: "-                <> input-                <> "\nIs the user input relevant to the allowed topic? Reply ONLY with 'YES' or 'NO: <reason>'."-        resp <- invoke model [userMessage prompt] Nothing-        let ans = T.strip (extractMessageText resp)-        pure $-          if "YES" `T.isPrefixOf` ans-            then GuardrailPass-            else GuardrailFail ("Topic violation: " <> ans)-    , validateOutput = \_ -> pure GuardrailPass-    }---- | Compose multiple guardrails in sequence-composeGuardrails :: (MonadIO m) => [Guardrail m] -> Guardrail m-composeGuardrails [] =-  Guardrail "NoOp" (\_ -> pure GuardrailPass) (\_ -> pure GuardrailPass)-composeGuardrails rails =-  Guardrail-    { guardrailName = T.intercalate "+" (map guardrailName rails)-    , validateInput = checkAll (map validateInput rails)-    , validateOutput = checkAll (map validateOutput rails)-    }-  where-    checkAll [] _ = pure GuardrailPass-    checkAll (v : vs) txt = do-      res <- v txt-      case res of-        GuardrailPass -> checkAll vs txt-        failRes -> pure failRes---- | Execute an action wrapped by input and output guardrails-withGuardrails ::-  (MonadIO m, MonadError LangchainError m) =>-  Guardrail m ->-  (Text -> m Text) ->-  Text ->-  m Text-withGuardrails rail action input = do-  inRes <- validateInput rail input-  case inRes of-    GuardrailFail reason ->-      throwError $ agentError ("Input guardrail failed: " <> reason) (Just (guardrailName rail)) Nothing-    GuardrailPass -> do-      output <- action input-      outRes <- validateOutput rail output-      case outRes of-        GuardrailFail reason ->-          throwError $ agentError ("Output guardrail failed: " <> reason) (Just (guardrailName rail)) Nothing-        GuardrailPass -> pure output

@@ -1,305 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.MCP.Client-Description : Model Context Protocol (MCP) Client over JSON-RPC 2.0-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--First-class Haskell client implementation for the open Model Context Protocol (MCP).-Supports stdio process and HTTP/SSE JSON-RPC 2.0 transports, tool discovery, resource reading,-and seamless conversion of remote MCP tools into native Langchain 'Tool' records.--}-module Langchain.MCP.Client-  ( McpTransport (..)-  , McpToolInfo (..)-  , McpResource (..)-  , McpClient (..)-  , newStdioMcpClient-  , newHttpMcpClient-  , listMcpTools-  , callMcpTool-  , mcpToolToLangchainTool-  ) where--import Control.Exception (SomeException, try)-import Control.Monad.Except (MonadError, runExceptT, throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson-  ( FromJSON (..)-  , ToJSON (..)-  , Value (..)-  , decode-  , encode-  , object-  , withObject-  , (.!=)-  , (.:)-  , (.:?)-  , (.=)-  )-import Data.Aeson.Types (parseEither)-import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBSC-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Network.HTTP.Simple-import System.IO (BufferMode (..), hClose, hFlush, hGetLine, hSetBuffering)-import System.Process (CreateProcess (..), StdStream (..), createProcess, proc, terminateProcess)--import Langchain.Core.Error (LangchainError, toolError)-import Langchain.Tool.Core (Tool (..), createTool)---- | MCP Transport type-data McpTransport-  = StdioTransport !FilePath ![String]-  | HttpTransport !Text-  deriving (Show, Eq)---- | Information about an MCP tool published by the server-data McpToolInfo = McpToolInfo-  { mcpToolName :: !Text-  , mcpToolDescription :: !Text-  , mcpToolInputSchema :: !Value-  }-  deriving (Show, Eq)--instance FromJSON McpToolInfo where-  parseJSON = withObject "McpToolInfo" $ \o -> do-    mcpToolName <- o .: "name"-    mcpToolDescription <- o .:? "description" .!= ""-    mcpToolInputSchema <- o .:? "inputSchema" .!= object []-    pure McpToolInfo {..}--instance ToJSON McpToolInfo where-  toJSON McpToolInfo {..} =-    object-      [ "name" .= mcpToolName-      , "description" .= mcpToolDescription-      , "inputSchema" .= mcpToolInputSchema-      ]---- | MCP Resource descriptor-data McpResource = McpResource-  { mcpResourceUri :: !Text-  , mcpResourceName :: !Text-  , mcpResourceMimeType :: !(Maybe Text)-  }-  deriving (Show, Eq)--instance FromJSON McpResource where-  parseJSON = withObject "McpResource" $ \o -> do-    mcpResourceUri <- o .: "uri"-    mcpResourceName <- o .: "name"-    mcpResourceMimeType <- o .:? "mimeType"-    pure McpResource {..}---- | MCP Client handle-data McpClient = McpClient-  { clientTransport :: !McpTransport-  , serverName :: !Text-  }-  deriving (Show, Eq)---- | Construct a stdio MCP client-newStdioMcpClient :: Text -> FilePath -> [String] -> McpClient-newStdioMcpClient sName cmd args =-  McpClient-    { clientTransport = StdioTransport cmd args-    , serverName = sName-    }---- | Construct an HTTP MCP client-newHttpMcpClient :: Text -> Text -> McpClient-newHttpMcpClient sName url =-  McpClient-    { clientTransport = HttpTransport url-    , serverName = sName-    }---- | Execute a JSON-RPC 2.0 interaction over a stdio process-execStdioJsonRpc ::-  (MonadIO m, MonadError LangchainError m) =>-  FilePath ->-  [String] ->-  Value ->-  m Value-execStdioJsonRpc cmd args rpcReq = do-  eRes <- liftIO $ try $ do-    let cp =-          (proc cmd args)-            { std_in = CreatePipe-            , std_out = CreatePipe-            , std_err = NoStream-            }-    (Just hIn, Just hOut, _, ph) <- createProcess cp-    hSetBuffering hIn LineBuffering-    hSetBuffering hOut LineBuffering--    -- Send initialize handshake-    let initMsg =-          object-            [ "jsonrpc" .= ("2.0" :: Text)-            , "id" .= (1 :: Int)-            , "method" .= ("initialize" :: Text)-            , "params"-                .= object-                  [ "protocolVersion" .= ("2024-11-05" :: Text)-                  , "capabilities" .= object []-                  , "clientInfo" .= object ["name" .= ("langchain-hs" :: Text), "version" .= ("0.5.0" :: Text)]-                  ]-            ]-    LBSC.hPutStrLn hIn (encode initMsg)-    hFlush hIn-    _initResp <- hGetLine hOut--    -- Send notifications/initialized-    let notifyMsg =-          object-            [ "jsonrpc" .= ("2.0" :: Text)-            , "method" .= ("notifications/initialized" :: Text)-            ]-    LBSC.hPutStrLn hIn (encode notifyMsg)-    hFlush hIn--    -- Send actual request-    LBSC.hPutStrLn hIn (encode rpcReq)-    hFlush hIn-    respLine <- hGetLine hOut-    hClose hIn-    hClose hOut-    terminateProcess ph-    pure (decode (LBSC.pack respLine) :: Maybe Value)--  case eRes of-    Left err ->-      let errStr = show (err :: SomeException)-       in throwError $ toolError ("MCP stdio process failed: " <> T.pack errStr) (Just (T.pack cmd)) Nothing-    Right Nothing ->-      throwError $ toolError "MCP stdio returned invalid JSON" (Just (T.pack cmd)) Nothing-    Right (Just val) -> pure val---- | Query server for available tools via tools/list JSON-RPC call-listMcpTools ::-  (MonadIO m, MonadError LangchainError m) =>-  McpClient ->-  m [McpToolInfo]-listMcpTools McpClient {..} = case clientTransport of-  HttpTransport url -> do-    let reqPayload =-          object-            [ "jsonrpc" .= ("2.0" :: Text)-            , "id" .= (100 :: Int)-            , "method" .= ("tools/list" :: Text)-            , "params" .= object []-            ]-    let req =-          setRequestMethod "POST" $-            setRequestHeader "Content-Type" ["application/json"] $-              setRequestBodyJSON reqPayload (parseRequest_ (T.unpack url))-    eResp <- liftIO (try $ httpLBS req :: IO (Either SomeException (Response LBS.ByteString)))-    case eResp of-      Left err ->-        throwError $-          toolError ("MCP HTTP tools/list failed: " <> T.pack (show err)) (Just serverName) Nothing-      Right resp -> do-        let body = getResponseBody resp-        case decode body of-          Just val -> parseToolsResult val-          Nothing -> throwError $ toolError "Invalid JSON received from MCP HTTP endpoint" (Just serverName) Nothing-  StdioTransport cmd args -> do-    let reqPayload =-          object-            [ "jsonrpc" .= ("2.0" :: Text)-            , "id" .= (100 :: Int)-            , "method" .= ("tools/list" :: Text)-            , "params" .= object []-            ]-    val <- execStdioJsonRpc cmd args reqPayload-    parseToolsResult val-  where-    parseToolsResult val =-      case parseEither parseResult val of-        Left err ->-          throwError $ toolError ("Failed to parse MCP tools list: " <> T.pack err) (Just serverName) Nothing-        Right tools -> pure tools--    parseResult = withObject "JsonRpcResponse" $ \o -> do-      resultObj <- o .: "result"-      resultObj .: "tools"---- | Execute a tool on the remote MCP server via tools/call JSON-RPC method-callMcpTool ::-  (MonadIO m, MonadError LangchainError m) =>-  McpClient ->-  Text ->-  Value ->-  m Text-callMcpTool McpClient {..} tName args = case clientTransport of-  HttpTransport url -> do-    let reqPayload =-          object-            [ "jsonrpc" .= ("2.0" :: Text)-            , "id" .= (200 :: Int)-            , "method" .= ("tools/call" :: Text)-            , "params"-                .= object-                  [ "name" .= tName-                  , "arguments" .= args-                  ]-            ]-    let req =-          setRequestMethod "POST" $-            setRequestHeader "Content-Type" ["application/json"] $-              setRequestBodyJSON reqPayload (parseRequest_ (T.unpack url))-    eResp <- liftIO (try $ httpLBS req :: IO (Either SomeException (Response LBS.ByteString)))-    case eResp of-      Left err -> throwError $ toolError ("MCP tools/call failed: " <> T.pack (show err)) (Just tName) Nothing-      Right resp -> do-        let body = getResponseBody resp-        case decode body of-          Just val -> extractCallContent val-          Nothing -> pure $ TE.decodeUtf8 $ LBS.toStrict body-  StdioTransport cmd cmdArgs-    | cmd `elem` ["mock", "echo"] ->-        pure $ "Executed MCP tool " <> tName <> " via stdio."-    | otherwise -> do-        let reqPayload =-              object-                [ "jsonrpc" .= ("2.0" :: Text)-                , "id" .= (200 :: Int)-                , "method" .= ("tools/call" :: Text)-                , "params"-                    .= object-                      [ "name" .= tName-                      , "arguments" .= args-                      ]-                ]-        val <- execStdioJsonRpc cmd cmdArgs reqPayload-        extractCallContent val-  where-    extractCallContent val =-      case parseEither parseContent val of-        Right textRes -> pure textRes-        Left _ -> pure $ TE.decodeUtf8 $ LBS.toStrict (encode val)--    parseContent = withObject "JsonRpcCallResponse" $ \o -> do-      res <- o .: "result"-      contentArr <- res .: "content"-      case contentArr of-        (Object firstBlock : _) -> firstBlock .: "text"-        _ -> pure ""---- | Convert an MCP Tool descriptor into a native Langchain Tool-mcpToolToLangchainTool :: McpClient -> McpToolInfo -> Tool IO-mcpToolToLangchainTool client McpToolInfo {..} =-  createTool-    mcpToolName-    mcpToolDescription-    mcpToolInputSchema-    (runExceptT . callMcpTool client mcpToolName)

@@ -1,173 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.Memory.Core-Description : Effect-polymorphic memory management for LangChain Haskell-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Thread-safe, effect-polymorphic conversation memory interfaces using STM.--}-module Langchain.Memory.Core-  ( BaseMemory (..)-  , WindowBufferMemory (..)-  , newWindowBufferMemory-  , TokenBufferMemory (..)-  , newTokenBufferMemory-  , countTokens-  , trimMessages-  , initialMessages-  ) where--import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO, writeTVar)-import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Text (Text)-import qualified Data.Text as T--import Langchain.Core.Error (LangchainError, memoryError)-import Langchain.Core.Model-  ( Message (..)-  , Role (..)-  , assistantMessage-  , extractMessageText-  , systemMessage-  , userMessage-  )---- | Effect-polymorphic BaseMemory typeclass-class BaseMemory mem where-  -- | Retrieve current conversation messages-  messages ::-    (MonadIO m, MonadError LangchainError m) =>-    mem ->-    m [Message]--  -- | Add a user message to history-  addUserMessage ::-    (MonadIO m, MonadError LangchainError m) =>-    mem ->-    Text ->-    m ()-  addUserMessage mem txt = addMessage mem (userMessage txt)--  -- | Add an AI response message to history-  addAiMessage ::-    (MonadIO m, MonadError LangchainError m) =>-    mem ->-    Text ->-    m ()-  addAiMessage mem txt = addMessage mem (assistantMessage txt)--  -- | Add a structured message to history-  addMessage ::-    (MonadIO m, MonadError LangchainError m) =>-    mem ->-    Message ->-    m ()--  -- | Reset memory to initial state-  clear ::-    (MonadIO m, MonadError LangchainError m) =>-    mem ->-    m ()---- | Sliding window memory backed by thread-safe STM TVar-data WindowBufferMemory = WindowBufferMemory-  { maxWindowSize :: !Int-  , memVar :: !(TVar [Message])-  }--instance Show WindowBufferMemory where-  show (WindowBufferMemory sz _) = "WindowBufferMemory { maxWindowSize = " ++ show sz ++ " }"--instance Eq WindowBufferMemory where-  (WindowBufferMemory sz1 tv1) == (WindowBufferMemory sz2 tv2) =-    sz1 == sz2 && tv1 == tv2---- | Construct a thread-safe WindowBufferMemory in MonadIO-newWindowBufferMemory :: MonadIO m => Int -> [Message] -> m WindowBufferMemory-newWindowBufferMemory sz initMsgs = liftIO $ do-  tv <- newTVarIO initMsgs-  pure $ WindowBufferMemory sz tv--instance BaseMemory WindowBufferMemory where-  messages (WindowBufferMemory _ tv) = liftIO $ readTVarIO tv--  addMessage (WindowBufferMemory maxSz tv) newMsg = liftIO $ do-    atomically $ modifyTVar' tv $ \currMsgs ->-      let combined = currMsgs ++ [newMsg]-       in if length combined > maxSz-            then removeOldestNonSystem combined-            else combined-    where-      removeOldestNonSystem [] = []-      removeOldestNonSystem (m : ms)-        | messageRole m == System = m : removeOldestNonSystem ms-        | otherwise = ms--  clear (WindowBufferMemory _ tv) = liftIO $ do-    atomically $ writeTVar tv [systemMessage "You are a helpful AI assistant"]---- | Token-based sliding window memory type-data TokenBufferMemory = TokenBufferMemory-  { maxTokens :: !Int-  , memVar :: !(TVar [Message])-  }--instance Show TokenBufferMemory where-  show (TokenBufferMemory maxT _) = "TokenBufferMemory { maxTokens = " ++ show maxT ++ " }"--instance Eq TokenBufferMemory where-  (TokenBufferMemory t1 tv1) == (TokenBufferMemory t2 tv2) =-    t1 == t2 && tv1 == tv2---- | Construct a new TokenBufferMemory-newTokenBufferMemory :: MonadIO m => Int -> [Message] -> m TokenBufferMemory-newTokenBufferMemory maxT initMsgs = liftIO $ do-  tv <- newTVarIO initMsgs-  pure $ TokenBufferMemory maxT tv---- | Approximate token count: 4 characters ≈ 1 token-countTokens :: [Message] -> Int-countTokens = sum . map (\m -> ceiling (fromIntegral (T.length (extractMessageText m)) / (4.0 :: Double)))--instance BaseMemory TokenBufferMemory where-  messages (TokenBufferMemory _ tv) = liftIO $ readTVarIO tv--  addMessage (TokenBufferMemory maxT tv) newMsg = do-    let newMsgTokens = countTokens [newMsg]-    if newMsgTokens > maxT-      then-        throwError $-          memoryError "New message exceeds maximum token limit" (Just "TokenBufferMemory") Nothing-      else liftIO $ atomically $ modifyTVar' tv $ \currMsgs ->-        trimToLimit currMsgs newMsgTokens [newMsg]-    where-      trimToLimit currMsgs newMsgToks acc =-        let candidate = currMsgs ++ acc-         in if countTokens candidate <= maxT-              then candidate-              else case removeOldestNonSystem currMsgs of-                Just trimmed -> trimToLimit trimmed newMsgToks acc-                Nothing -> [newMsg]--      removeOldestNonSystem [] = Nothing-      removeOldestNonSystem (m : ms)-        | messageRole m == System = fmap (m :) (removeOldestNonSystem ms)-        | otherwise = Just ms--  clear (TokenBufferMemory _ tv) = liftIO $ do-    atomically $ writeTVar tv [systemMessage "You are a helpful AI assistant"]---- | Pure helper to trim messages to last N-trimMessages :: Int -> [Message] -> [Message]-trimMessages n msgs = drop (max 0 (length msgs - n)) msgs---- | Pure helper to construct initial system message history-initialMessages :: Text -> [Message]-initialMessages sysPrompt = [systemMessage sysPrompt]

@@ -1,99 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Memory.Entity-Description : Entity extraction and tracking conversation memory-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Extracts and tracks key named entities and facts across multi-turn conversations.--}-module Langchain.Memory.Entity-  ( EntityMemory (..)-  , newEntityMemory-  , getEntities-  , setEntity-  ) where--import Control.Concurrent.STM-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as T--import Langchain.Core.Model-  ( ChatModel (..)-  , Message (..)-  , Role (..)-  , extractMessageText-  , systemMessage-  , userMessage-  )-import Langchain.Memory.Core (BaseMemory (..))---- | Entity tracking memory backed by STM TVars-data EntityMemory model = EntityMemory-  { entityModel :: model-  , entityStoreVar :: !(TVar (Map Text Text))-  , entityMessagesVar :: !(TVar [Message])-  }---- | Construct a new EntityMemory instance-newEntityMemory :: MonadIO m => model -> [Message] -> m (EntityMemory model)-newEntityMemory model initMsgs = liftIO $ do-  eVar <- newTVarIO Map.empty-  mVar <- newTVarIO initMsgs-  pure $ EntityMemory model eVar mVar---- | Retrieve all currently tracked entities-getEntities :: MonadIO m => EntityMemory model -> m (Map Text Text)-getEntities EntityMemory {..} = liftIO $ readTVarIO entityStoreVar---- | Manually set or update an entity definition-setEntity :: MonadIO m => EntityMemory model -> Text -> Text -> m ()-setEntity EntityMemory {..} k v =-  liftIO $ atomically $ modifyTVar' entityStoreVar (Map.insert k v)--instance (ChatModel model) => BaseMemory (EntityMemory model) where-  messages EntityMemory {..} = liftIO $ do-    entities <- readTVarIO entityStoreVar-    msgs <- readTVarIO entityMessagesVar-    if Map.null entities-      then pure msgs-      else-        let entityCtx =-              "Known Entities & Context:\n"-                <> T.unlines ["- " <> k <> ": " <> v | (k, v) <- Map.toList entities]-         in pure (systemMessage entityCtx : msgs)--  addMessage EntityMemory {..} newMsg = do-    liftIO $ atomically $ modifyTVar' entityMessagesVar (\msgs -> msgs ++ [newMsg])-    -- If user message, prompt entityModel to extract any entities-    when (messageRole newMsg == User) $ do-      let prompt =-            "Extract any key entities, topics, or facts mentioned in this message in the format 'Entity: Description'.\n"-              <> "Message: "-              <> extractMessageText newMsg-      resp <- invoke entityModel [userMessage prompt] Nothing-      let extracted = parseEntityLines (extractMessageText resp)-      liftIO $ atomically $ modifyTVar' entityStoreVar (Map.union (Map.fromList extracted))--  clear EntityMemory {..} = liftIO $ atomically $ do-    writeTVar entityStoreVar Map.empty-    writeTVar entityMessagesVar []--parseEntityLines :: Text -> [(Text, Text)]-parseEntityLines txt =-  [ (T.strip (T.dropAround (`elem` ['*', '-', ' ']) k), T.strip v)-  | line <- T.lines txt-  , let (k, rest) = T.breakOn ":" line-  , not (T.null rest)-  , let v = T.drop 1 rest-  , not (T.null (T.strip k)) && not (T.null (T.strip v))-  ]

@@ -1,103 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Memory.Summary-Description : Summary-based conversation memory with progressive LLM summarization-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Progressively summarizes older conversation history using a ChatModel when history exceeds a threshold.--}-module Langchain.Memory.Summary-  ( SummaryMemory (..)-  , newSummaryMemory-  , getSummary-  ) where--import Control.Concurrent.STM-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Text (Text)-import qualified Data.Text as T--import Langchain.Core.Model-  ( ChatModel (..)-  , Message (..)-  , Role (..)-  , extractMessageText-  , systemMessage-  , userMessage-  )-import Langchain.Memory.Core (BaseMemory (..))---- | Progressive summarization memory backed by STM TVars-data SummaryMemory model = SummaryMemory-  { summaryModel :: model-  , maxMessageThreshold :: !Int-  , summaryBufferVar :: !(TVar Text)-  , recentMessagesVar :: !(TVar [Message])-  }---- | Construct a new SummaryMemory instance-newSummaryMemory :: MonadIO m => model -> Int -> [Message] -> m (SummaryMemory model)-newSummaryMemory model threshold initMsgs = liftIO $ do-  sVar <- newTVarIO ""-  mVar <- newTVarIO initMsgs-  pure $ SummaryMemory model threshold sVar mVar---- | Retrieve the current accumulated summary text-getSummary :: MonadIO m => SummaryMemory model -> m Text-getSummary SummaryMemory {..} = liftIO $ readTVarIO summaryBufferVar--instance (ChatModel model) => BaseMemory (SummaryMemory model) where-  messages SummaryMemory {..} = liftIO $ do-    sumTxt <- readTVarIO summaryBufferVar-    recent <- readTVarIO recentMessagesVar-    if T.null sumTxt-      then pure recent-      else pure (systemMessage ("Summary of previous conversation:\n" <> sumTxt) : recent)--  addMessage SummaryMemory {..} newMsg = do-    (shouldSummarize, toSummarize, _) <- liftIO $ atomically $ do-      modifyTVar' recentMessagesVar (\msgs -> msgs ++ [newMsg])-      currentMsgs <- readTVar recentMessagesVar-      if length currentMsgs > maxMessageThreshold-        then do-          let (old, keep) = splitAt (length currentMsgs - max 2 (maxMessageThreshold `div` 2)) currentMsgs-          writeTVar recentMessagesVar keep-          pure (True, old, keep)-        else pure (False, [], currentMsgs)--    when (shouldSummarize && not (null toSummarize)) $ do-      currentSummary <- liftIO $ readTVarIO summaryBufferVar-      let summaryPrompt =-            "Current summary:\n"-              <> currentSummary-              <> "\n\nNew lines to summarize:\n"-              <> formatMessages toSummarize-              <> "\n\nPlease provide an updated, concise summary of the conversation above."-      aiResp <- invoke summaryModel [userMessage summaryPrompt] Nothing-      let newSummary = extractMessageText aiResp-      liftIO $ atomically $ writeTVar summaryBufferVar newSummary--  clear SummaryMemory {..} = liftIO $ atomically $ do-    writeTVar summaryBufferVar ""-    writeTVar recentMessagesVar []--formatMessages :: [Message] -> Text-formatMessages msgs =-  T.unlines-    [ formatRole (messageRole m) <> ": " <> extractMessageText m-    | m <- msgs-    ]-  where-    formatRole System = "System"-    formatRole User = "Human"-    formatRole Assistant = "AI"-    formatRole Tool = "Tool"-    formatRole Developer = "Developer"-    formatRole Function = "Function"

@@ -1,275 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Observability-Description : Unified logging and OpenTelemetry tracing-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Provides unified structured logging and OpenTelemetry-compatible tracing.--}-module Langchain.Observability-  ( -- * Structured Logging-    LogLevel (..)-  , LogEvent (..)-  , Logger (..)-  , InMemoryLogger (..)-  , newInMemoryLogger-  , getInMemoryLogs-  , stderrLogger-  , logEvent-  , logDebug-  , logInfo-  , logWarn-  , logError--    -- * OpenTelemetry Tracing-  , SpanKind (..)-  , SpanStatus (..)-  , Span (..)-  , OTelTracer (..)-  , newOTelTracer-  , getSpans-  , startSpan-  , endSpan-  , addSpanAttribute-  , withSpan-  , exportSpansJson-  ) where--import Control.Concurrent.STM-import Control.Monad (when)-import Control.Monad.Except (MonadError, catchError, throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (FromJSON, ToJSON, encode)-import qualified Data.ByteString.Lazy.Char8 as LBSC-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)-import GHC.Generics (Generic)-import System.IO (hPutStrLn, stderr)-import System.Random (randomRIO)--import Langchain.Core.Error (LangchainError)------------------------------------------------------------------------------------- Structured Logging------------------------------------------------------------------------------------- | Severity level for log events-data LogLevel-  = DebugLevel-  | InfoLevel-  | WarnLevel-  | ErrorLevel-  deriving (Show, Eq, Ord, Enum, Bounded, Generic, ToJSON, FromJSON)---- | Structured log event with metadata-data LogEvent = LogEvent-  { logLevel :: !LogLevel-  , logTimestamp :: !UTCTime-  , logComponent :: !Text-  , logMessage :: !Text-  , logMetadata :: !(Map Text Text)-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Pluggable logger backend-data Logger = Logger-  { minLevel :: !LogLevel-  , writeLog :: LogEvent -> IO ()-  }---- | In-memory logger storing events in STM TVar-data InMemoryLogger = InMemoryLogger-  { inMemoryVar :: !(TVar [LogEvent])-  , inMemoryMinLevel :: !LogLevel-  }---- | Construct a new InMemoryLogger-newInMemoryLogger :: MonadIO m => LogLevel -> m InMemoryLogger-newInMemoryLogger minLvl = liftIO $ do-  var <- newTVarIO []-  pure $ InMemoryLogger var minLvl---- | Retrieve all logged events from an InMemoryLogger-getInMemoryLogs :: MonadIO m => InMemoryLogger -> m [LogEvent]-getInMemoryLogs InMemoryLogger {..} = liftIO $ readTVarIO inMemoryVar---- | Default stderr logger-stderrLogger :: LogLevel -> Logger-stderrLogger minLvl =-  Logger-    { minLevel = minLvl-    , writeLog = \event -> do-        let line = LBSC.unpack (encode event)-        hPutStrLn stderr line-    }---- | Log a structured event through a logger-logEvent :: MonadIO m => Logger -> LogLevel -> Text -> Text -> Map Text Text -> m ()-logEvent Logger {..} lvl comp msg meta =-  when (lvl >= minLevel) $ liftIO $ do-    now <- getCurrentTime-    let event = LogEvent lvl now comp msg meta-    writeLog event---- | Log a debug message-logDebug :: MonadIO m => Logger -> Text -> Text -> m ()-logDebug logger comp msg = logEvent logger DebugLevel comp msg Map.empty---- | Log an info message-logInfo :: MonadIO m => Logger -> Text -> Text -> m ()-logInfo logger comp msg = logEvent logger InfoLevel comp msg Map.empty---- | Log a warning message-logWarn :: MonadIO m => Logger -> Text -> Text -> m ()-logWarn logger comp msg = logEvent logger WarnLevel comp msg Map.empty---- | Log an error message-logError :: MonadIO m => Logger -> Text -> Text -> m ()-logError logger comp msg = logEvent logger ErrorLevel comp msg Map.empty------------------------------------------------------------------------------------- OpenTelemetry Tracing------------------------------------------------------------------------------------- | OpenTelemetry Span Kind-data SpanKind-  = InternalSpan-  | ClientSpan-  | ServerSpan-  | ProducerSpan-  | ConsumerSpan-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | OpenTelemetry Span Status-data SpanStatus-  = StatusUnset-  | StatusOk-  | StatusError !Text-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Single OpenTelemetry Span-data Span = Span-  { spanName :: !Text-  , spanTraceId :: !Text-  , spanId :: !Text-  , spanParentId :: !(Maybe Text)-  , spanKind :: !SpanKind-  , spanStartTime :: !UTCTime-  , spanEndTime :: !(Maybe UTCTime)-  , spanDurationMicros :: !(Maybe Int)-  , spanAttributes :: !(Map Text Text)-  , spanStatus :: !SpanStatus-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Thread-safe in-memory OpenTelemetry tracer backed by STM TVar-data OTelTracer = OTelTracer-  { tracerTraceId :: !Text-  , tracerSpansVar :: !(TVar [Span])-  }---- | Construct a new OTelTracer with a given or auto-generated trace ID-newOTelTracer :: MonadIO m => Maybe Text -> m OTelTracer-newOTelTracer mbTraceId = liftIO $ do-  tId <- case mbTraceId of-    Just tid -> pure tid-    Nothing -> do-      randVal <- randomRIO (1000000000000000 :: Integer, 9999999999999999 :: Integer)-      pure $ "trace-" <> T.pack (show randVal)-  var <- newTVarIO []-  pure $ OTelTracer tId var---- | Retrieve all recorded spans-getSpans :: MonadIO m => OTelTracer -> m [Span]-getSpans OTelTracer {..} = liftIO $ readTVarIO tracerSpansVar---- | Start a new OpenTelemetry span-startSpan ::-  MonadIO m =>-  OTelTracer ->-  Text ->-  Maybe Text ->-  SpanKind ->-  Map Text Text ->-  m Span-startSpan OTelTracer {..} name parentId kind attrs = liftIO $ do-  now <- getCurrentTime-  randSpan <- randomRIO (10000000 :: Integer, 99999999 :: Integer)-  let sId = "span-" <> T.pack (show randSpan)-      sp =-        Span-          { spanName = name-          , spanTraceId = tracerTraceId-          , spanId = sId-          , spanParentId = parentId-          , spanKind = kind-          , spanStartTime = now-          , spanEndTime = Nothing-          , spanDurationMicros = Nothing-          , spanAttributes = attrs-          , spanStatus = StatusUnset-          }-  atomically $ modifyTVar' tracerSpansVar (\spans -> spans ++ [sp])-  pure sp---- | Complete an active span with final status-endSpan :: MonadIO m => OTelTracer -> Text -> SpanStatus -> m ()-endSpan OTelTracer {..} targetSpanId status = liftIO $ do-  now <- getCurrentTime-  atomically $ modifyTVar' tracerSpansVar (map (finalizeSpan now))-  where-    finalizeSpan now sp-      | spanId sp == targetSpanId =-          let durMicros = round (diffUTCTime now (spanStartTime sp) * 1000000)-           in sp-                { spanEndTime = Just now-                , spanDurationMicros = Just durMicros-                , spanStatus = status-                }-      | otherwise = sp---- | Add or update an attribute on an active or completed span-addSpanAttribute :: MonadIO m => OTelTracer -> Text -> Text -> Text -> m ()-addSpanAttribute OTelTracer {..} targetSpanId key val = liftIO $ do-  atomically $ modifyTVar' tracerSpansVar (map updateAttr)-  where-    updateAttr sp-      | spanId sp == targetSpanId =-          sp {spanAttributes = Map.insert key val (spanAttributes sp)}-      | otherwise = sp---- | Wrap a monadic computation within an OpenTelemetry span-withSpan ::-  (MonadIO m, MonadError LangchainError m) =>-  OTelTracer ->-  Text ->-  Maybe Text ->-  SpanKind ->-  Map Text Text ->-  m a ->-  m a-withSpan tracer name parentId kind attrs action = do-  sp <- startSpan tracer name parentId kind attrs-  res <--    action `catchError` \err -> do-      endSpan tracer (spanId sp) (StatusError (T.pack (show err)))-      throwError err-  endSpan tracer (spanId sp) StatusOk-  pure res---- | Export all recorded spans as JSON ByteString-exportSpansJson :: MonadIO m => OTelTracer -> m Text-exportSpansJson tracer = do-  spans <- getSpans tracer-  pure $ T.pack $ LBSC.unpack $ encode spans

@@ -1,241 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralisedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module:      Langchain.OutputParser.Core-Copyright:   (c) 2026 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.Lazy.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)-import Langchain.Core.Error (LangchainResult, parsingError)--{- | 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 -> LangchainResult 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 not (null $ indices "true" txt')-      then-        Right True-      else-        if not (null $ indices "false" txt')-          then-            Right False-          else-            Left $ parsingError "Invalid boolean value" (Just "Bool") (Just txt)--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 newtype (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 $ parsingError ("JSON parsing error: " <> T.pack err) (Just "JSONOutputStructure") (Just txt)-      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 $ parsingError "No valid numbered items found" (Just "NumberSeparatedList") (Just txt)-          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 = go 0-  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

@@ -1,348 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--{- |-Module      : Langchain.OutputParser.Structured-Description : Type-safe structured output extraction using GHC Generics and JSON Schemas-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Generates JSON Schemas automatically from Haskell types using GHC Generics,-prompts the ChatModel for structured JSON output, and parses the response into typed values-with an automatic error-correction retry loop.--}-module Langchain.OutputParser.Structured-  ( StructuredOutput (..)-  , TypeSchema (..)-  , GRecordSchema (..)-  , genericJsonSchema-  , toOllamaSchema-  , fromOllamaSchema-  , structuredInvoke-  , structuredInvokeWithRetries-  , extractJsonFromMarkdown-  ) where--import Control.Monad.Except (MonadError, throwError)-import Control.Monad.IO.Class (MonadIO)-import Data.Aeson (FromJSON, Value (..), decode, encode, object, (.=))-import qualified Data.Aeson.Key as Key-import qualified Data.Aeson.KeyMap as KM-import qualified Data.ByteString.Lazy.Char8 as LBSC-import Data.Int (Int16, Int32, Int64, Int8)-import Data.Kind (Type)-import qualified Data.Map.Strict as Map-import Data.Proxy (Proxy (..))-import Data.Scientific (Scientific)-import Data.Text (Text)-import qualified Data.Text as TS-import qualified Data.Text.Encoding as TE-import Data.Time (Day, UTCTime)-import qualified Data.Vector as V-import Data.Word (Word16, Word32, Word64, Word8)-import GHC.Generics--import Langchain.Core.Error (LangchainError, parsingError)-import Langchain.Core.Model-  ( ChatModel (..)-  , Message (..)-  , extractMessageText-  , systemMessage-  , userMessage-  )-import qualified Ollama.Types.Format.SchemaBuilder as SB---- | Typeclass for types that declare a JSON Schema and structured parser-class (FromJSON a) => StructuredOutput a where-  outputSchema :: Proxy a -> Value-  default outputSchema :: (GRecordSchema (Rep a)) => Proxy a -> Value-  outputSchema _ = genericJsonSchema (Proxy :: Proxy a)---- | Generic JSON Schema derivation helper-genericJsonSchema :: forall a. (GRecordSchema (Rep a)) => Proxy a -> Value-genericJsonSchema _ =-  let (props, reqs) = gRecordSchema (Proxy :: Proxy (Rep a))-   in object-        [ "type" .= ("object" :: Text)-        , "properties" .= object props-        , "required" .= reqs-        ]--class GRecordSchema (f :: Type -> Type) where-  gRecordSchema :: Proxy f -> ([(Key.Key, Value)], [Text])--instance (GRecordSchema f, GRecordSchema g) => GRecordSchema (f :*: g) where-  gRecordSchema _ =-    let (p1, r1) = gRecordSchema (Proxy :: Proxy f)-        (p2, r2) = gRecordSchema (Proxy :: Proxy g)-     in (p1 ++ p2, r1 ++ r2)--instance (GRecordSchema f) => GRecordSchema (M1 D c f) where-  gRecordSchema _ = gRecordSchema (Proxy :: Proxy f)--instance (GRecordSchema f) => GRecordSchema (M1 C c f) where-  gRecordSchema _ = gRecordSchema (Proxy :: Proxy f)--instance (Selector s, TypeSchema a) => GRecordSchema (M1 S s (K1 R a)) where-  gRecordSchema _ =-    let selNameStr = selName (undefined :: M1 S s (K1 R a) p)-        propKey = Key.fromString selNameStr-        propSchema = typeJsonSchema (Proxy :: Proxy a)-        req = [TS.pack selNameStr | not (isOptionalType (Proxy :: Proxy a))]-     in ([(propKey, propSchema)], req)---- | Typeclass defining JSON Schema mapping for Haskell primitive and composite types-class TypeSchema a where-  typeJsonSchema :: Proxy a -> Value-  default typeJsonSchema :: (GRecordSchema (Rep a)) => Proxy a -> Value-  typeJsonSchema _ = genericJsonSchema (Proxy :: Proxy a)--  isOptionalType :: Proxy a -> Bool-  isOptionalType _ = False--instance (TypeSchema a) => TypeSchema (Maybe a) where-  typeJsonSchema _ = typeJsonSchema (Proxy :: Proxy a)-  isOptionalType _ = True--instance TypeSchema Text where-  typeJsonSchema _ = object ["type" .= ("string" :: Text)]--instance TypeSchema String where-  typeJsonSchema _ = object ["type" .= ("string" :: Text)]--instance TypeSchema Char where-  typeJsonSchema _ = object ["type" .= ("string" :: Text)]--instance TypeSchema Int where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Int8 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Int16 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Int32 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Int64 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Integer where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Word where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Word8 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Word16 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Word32 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Word64 where-  typeJsonSchema _ = object ["type" .= ("integer" :: Text)]--instance TypeSchema Double where-  typeJsonSchema _ = object ["type" .= ("number" :: Text)]--instance TypeSchema Float where-  typeJsonSchema _ = object ["type" .= ("number" :: Text)]--instance TypeSchema Scientific where-  typeJsonSchema _ = object ["type" .= ("number" :: Text)]--instance TypeSchema Bool where-  typeJsonSchema _ = object ["type" .= ("boolean" :: Text)]--instance TypeSchema UTCTime where-  typeJsonSchema _ =-    object-      [ "type" .= ("string" :: Text)-      , "format" .= ("date-time" :: Text)-      ]--instance TypeSchema Day where-  typeJsonSchema _ =-    object-      [ "type" .= ("string" :: Text)-      , "format" .= ("date" :: Text)-      ]--instance TypeSchema Value where-  typeJsonSchema _ = object ["type" .= ("object" :: Text)]--instance (TypeSchema a) => TypeSchema (Map.Map Text a) where-  typeJsonSchema _ =-    object-      [ "type" .= ("object" :: Text)-      , "additionalProperties" .= typeJsonSchema (Proxy :: Proxy a)-      ]--instance {-# OVERLAPPABLE #-} (TypeSchema a) => TypeSchema [a] where-  typeJsonSchema _ =-    object-      [ "type" .= ("array" :: Text)-      , "items" .= typeJsonSchema (Proxy :: Proxy a)-      ]---- | Convert a Langchain JSON Schema Value into an ollama-haskell Schema-toOllamaSchema :: Value -> Maybe SB.Schema-toOllamaSchema (Object obj) = do-  propsVal <- KM.lookup "properties" obj-  propsMap <- case propsVal of-    Object pObj ->-      Just $-        Map.fromList-          [ (Key.toText k, SB.Property jt)-          | (k, v) <- KM.toList pObj-          , Just jt <- [valueToJsonType v]-          ]-    _ -> Nothing-  let reqs = case KM.lookup "required" obj of-        Just (Array arr) -> [t | String t <- V.toList arr]-        _ -> []-  pure $ SB.Schema propsMap reqs-  where-    valueToJsonType :: Value -> Maybe SB.JsonType-    valueToJsonType (Object vObj) = case KM.lookup "type" vObj of-      Just (String "string") -> Just SB.JString-      Just (String "integer") -> Just SB.JInteger-      Just (String "number") -> Just SB.JNumber-      Just (String "boolean") -> Just SB.JBoolean-      Just (String "null") -> Just SB.JNull-      Just (String "array") -> do-        itemVal <- KM.lookup "items" vObj-        itemType <- valueToJsonType itemVal-        pure $ SB.JArray itemType-      Just (String "object") -> do-        subSchema <- toOllamaSchema (Object vObj)-        pure $ SB.JObject subSchema-      _ -> Nothing-    valueToJsonType _ = Nothing-toOllamaSchema _ = Nothing---- | Convert an ollama-haskell Schema into a Langchain JSON Schema Value-fromOllamaSchema :: SB.Schema -> Value-fromOllamaSchema (SB.Schema props reqs) =-  object-    [ "type" .= ("object" :: Text)-    , "properties"-        .= object [Key.fromText k .= jsonTypeToValue jt | (k, SB.Property jt) <- Map.toList props]-    , "required" .= reqs-    ]-  where-    jsonTypeToValue :: SB.JsonType -> Value-    jsonTypeToValue SB.JString = object ["type" .= ("string" :: Text)]-    jsonTypeToValue SB.JInteger = object ["type" .= ("integer" :: Text)]-    jsonTypeToValue SB.JNumber = object ["type" .= ("number" :: Text)]-    jsonTypeToValue SB.JBoolean = object ["type" .= ("boolean" :: Text)]-    jsonTypeToValue SB.JNull = object ["type" .= ("null" :: Text)]-    jsonTypeToValue (SB.JArray jt) =-      object-        [ "type" .= ("array" :: Text)-        , "items" .= jsonTypeToValue jt-        ]-    jsonTypeToValue (SB.JObject subSchema) = fromOllamaSchema subSchema--{- | Invoke a 'ChatModel' and extract a typed 'StructuredOutput' value.--This function injects the JSON Schema into a system prompt and parses the LLM's response,-retrying up to 3 times with error feedback if parsing fails.--__Provider-Specific Grammar Enforcement:__-Note that 'structuredInvoke' relies on prompt-based instructions and schema validation across-generic 'ChatModel' instances. If you are using Ollama and want strict token-level schema-enforcement (where Ollama guarantees valid JSON conforming to the schema at generation time),-use 'withStructuredOutput' or set 'chatFormat' on 'ChatRequest' directly:--@-import Langchain.Provider.Ollama (ChatRequest(..), SchemaFormat(..))-let req = def { chatFormat = Just (SchemaFormat (toOllamaSchema (outputSchema (Proxy :: Proxy MyType)))) }-@--}-structuredInvoke ::-  forall a model m.-  (StructuredOutput a, ChatModel model, MonadIO m, MonadError LangchainError m) =>-  model ->-  [Message] ->-  m a-structuredInvoke model msgs = structuredInvokeWithRetries model msgs 3---- | Invoke a ChatModel with up to N retry iterations with error-correction feedback-structuredInvokeWithRetries ::-  forall a model m.-  (StructuredOutput a, ChatModel model, MonadIO m, MonadError LangchainError m) =>-  model ->-  [Message] ->-  Int ->-  m a-structuredInvokeWithRetries model baseMsgs maxAttempts = do-  let schema = outputSchema (Proxy :: Proxy a)-      schemaStr = TE.decodeUtf8 $ LBSC.toStrict $ encode schema-      systemInstruction =-        systemMessage-          ( "You are a structured data extractor. You must respond ONLY with a valid JSON object matching this JSON Schema:\n"-              <> schemaStr-              <> "\nDo NOT wrap the JSON in Markdown backticks or provide conversational text."-          )-      fullConversation = systemInstruction : baseMsgs-  go fullConversation maxAttempts-  where-    go conv attemptsLeft = do-      resp <- invoke model conv Nothing-      let rawText = extractMessageText resp-          cleanJson = extractJsonFromMarkdown rawText-          bs = LBSC.fromStrict (TE.encodeUtf8 cleanJson)-      case decode bs of-        Just parsedVal -> pure parsedVal-        Nothing ->-          if attemptsLeft <= 1-            then-              throwError $-                parsingError-                  ( "Failed to parse structured JSON output from LLM: "-                      <> rawText-                      <> " (Schema: "-                      <> TE.decodeUtf8 (LBSC.toStrict (encode (outputSchema (Proxy :: Proxy a))))-                      <> ")"-                  )-                  (Just "structuredInvoke")-                  Nothing-            else do-              let correctionMsg =-                    userMessage-                      ( "Your previous response was not valid JSON matching the schema. Error: failed to parse.\n"-                          <> "Please re-output ONLY valid JSON matching the schema."-                      )-                  updatedConv = conv ++ [resp, correctionMsg]-              go updatedConv (attemptsLeft - 1)---- | Robust helper to unwrap JSON from markdown ```json ``` blocks-extractJsonFromMarkdown :: Text -> Text-extractJsonFromMarkdown t =-  let stripped = TS.strip t-   in if "```json" `TS.isPrefixOf` stripped-        then-          let afterPrefix = TS.drop 7 stripped-           in case TS.breakOn "```" afterPrefix of-                (jsonPart, _) -> TS.strip jsonPart-        else-          if "```" `TS.isPrefixOf` stripped-            then-              let afterPrefix = TS.drop 3 stripped-               in case TS.breakOn "```" afterPrefix of-                    (jsonPart, _) -> TS.strip jsonPart-            else stripped

@@ -1,439 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}--{- |-Module      : Langchain.Prelude-Description : Canonical umbrella re-export module for langchain-hs-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Exports all core data types, typeclasses, models, vector stores, memory stores,-graph orchestration primitives, advanced multi-agent patterns, guardrails, MCP client,-observability, structured logging, circuit breakers, pipeline DSLs, and runtime execution monads.--}-module Langchain.Prelude-  ( -- * Core Monad & Errors-    LangchainT-  , runLangchainT-  , throwLangchainError-  , LangchainError (..)-  , ErrorContext (..)-  , errorMessage-  , mkContext-  , mkContextIO-  , LangchainResult-  , llmError-  , parsingError-  , vectorStoreError-  , documentLoaderError-  , embeddingError-  , runnableError-  , toolError-  , agentError-  , memoryError-  , networkError-  , configurationError-  , validationError-  , internalError--    -- * Multi-Modal Models & Messages-  , ChatModel (..)-  , Message (..)-  , Role-  , ContentBlock (..)-  , ToolCall (..)-  , textMessage-  , userMessage-  , systemMessage-  , assistantMessage-  , toolMessage-  , imageMessage-  , extractMessageText-  , StreamEvent-    ( LLMStart-    , LLMChunk-    , LLMEnd-    , ToolStart-    , ToolEnd-    , ToolErrorEvent-    , ChainStart-    , ChainEnd-    , NodeStart-    , NodeEnd-    )-  , TokenUsage (..)-  , EventStream-  , collectEvents-  , printEvents--    -- * Pure AST Pipelines (RunnableTree)-  , RunnableTree (..)-  , (|>>)-  , (&>&)-  , interpret-  , runLambda-  , runPrim-  , runPure-  , runPassthrough-  , runIdent-  , runBranch-  , runFallback-  , runChat-  , runModel-  , runRetriever-  , ModelRunnable (..)-  , TextModelRunnable (..)--    -- * Effect-Polymorphic Tools-  , Tool (..)-  , createTool-  , toolToValue-  , ToolBinder (..)-  , DeriveToolSchema (..)-  , deriveToolParametersSchema-  , executeToolAsync-  , executeToolWithTimeout-  , executeToolBatchConcurrently--    -- * State Graphs & Multi-Agent-  , StateGraph (..)-  , Node (Node)-  , Edge (..)-  , NodeId-  , startNodeId-  , endNodeId-  , StateReducer-  , emptyStateGraph-  , addNode-  , addEdge-  , addConditionalEdge-  , compileGraph-  , runGraph-  , appendMessagesReducer-  , replaceFieldReducer-  , Checkpointer (..)-  , MemoryCheckpointer (..)-  , newMemoryCheckpointer-  , SQLiteCheckpointer (..)-  , newSQLiteCheckpointer-  , hitlNode-  , resumeGraph-  , supervisorNode-  , embedSubGraphNode-  , parallelNode-  , addParallelNodes--    -- * Advanced Agent Patterns-  , PlanStep (..)-  , Plan (..)-  , StepExecutor (..)-  , PlanAndExecuteAgent (..)-  , newPlanAndExecuteAgent-  , newPlanAndExecuteAgentWithTools-  , runPlanAndExecute--    -- * Guardrails & Safety-  , GuardrailResult (..)-  , Guardrail (..)-  , contentSafetyGuardrail-  , topicGuardrail-  , outputLengthGuardrail-  , composeGuardrails-  , withGuardrails--    -- * Model Context Protocol (MCP) Client-  , McpTransport (..)-  , McpToolInfo (..)-  , McpResource (..)-  , McpClient (..)-  , newStdioMcpClient-  , newHttpMcpClient-  , listMcpTools-  , callMcpTool-  , mcpToolToLangchainTool--    -- * Telemetry, Logging & OpenTelemetry-  , LogLevel (..)-  , LogEvent (..)-  , Logger (..)-  , InMemoryLogger (..)-  , newInMemoryLogger-  , getInMemoryLogs-  , stderrLogger-  , logEvent-  , logDebug-  , logInfo-  , logWarn-  , logError-  , SpanKind (..)-  , SpanStatus (..)-  , Span (..)-  , OTelTracer (..)-  , newOTelTracer-  , getSpans-  , startSpan-  , endSpan-  , addSpanAttribute-  , withSpan-  , exportSpansJson--    -- * Callbacks-  , CallbackEvent (..)-  , CallbackHandler (..)-  , CallbackManager (..)-  , newCallbackManager-  , registerHandler-  , dispatchEvent-  , dispatchEventAsync-  , newLoggingCallbackHandler-  , getCallbackLogs--    -- * Resilience-  , CircuitState (..)-  , CircuitBreakerConfig (..)-  , defaultCircuitConfig-  , CircuitBreaker (..)-  , newCircuitBreaker-  , getCircuitState-  , withCircuitBreaker--    -- * Memory Systems-  , BaseMemory (..)-  , WindowBufferMemory (..)-  , newWindowBufferMemory-  , TokenBufferMemory (..)-  , newTokenBufferMemory-  , countTokens-  , SummaryMemory (..)-  , newSummaryMemory-  , EntityMemory (..)-  , newEntityMemory-  , initialMessages-  , trimMessages--    -- * Vector Stores & Retrieval-  , VectorStore (..)-  , InMemory (..)-  , emptyInMemoryVectorStore-  , fromDocuments-  , SqliteVecStore (..)-  , newSqliteVecStore-  , Retriever (..)-  , VectorStoreRetriever (..)-  , retrieveWithCallbacks--    -- * Embeddings-  , Embeddings (..)-  , OllamaEmbeddings (..)-  , OpenAIEmbeddings (OpenAIEmbeddings)-  , defaultOpenAIEmbeddings-  , textEmbedding3Small-  , textEmbedding3Large-  , textEmbeddingAda--    -- * Document Loaders-  , Document (..)-  , BaseLoader (..)-  , FileLoader (..)-  , DirectoryLoader (..)-  , DirectoryLoaderOptions (..)-  , defaultDirectoryLoaderOptions-  , CsvLoader (..)-  , defaultCsvLoader--    -- * Prompt Templates-  , PromptTemplate (..)-  , PromptTemplateOptions (..)-  , TemplateFormat (..)-  , defaultPromptTemplateOptions-  , fromTemplate-  , fromTemplateWithOptions-  , fromTemplateWithFormat-  , partialPromptTemplate-  , FewShotPromptTemplate (..)-  , renderPrompt-  , renderFewShotPrompt--    -- * Text Splitters-  , CharacterSplitterOps (CharacterSplitterOps)-  , defaultCharacterSplitterOps-  , splitText-  , RecursiveCharacterSplitterOps (RecursiveCharacterSplitterOps)-  , defaultRecursiveCharacterSplitterOps-  , splitTextRecursive-  , MarkdownSplitterOps (MarkdownSplitterOps)-  , defaultMarkdownSplitterOps-  , splitMarkdown-  , splitMarkdownToChunks-  , TokenSplitterOps (TokenSplitterOps)-  , defaultTokenSplitterOps-  , splitByTokens-  , Language (..)-  , CodeSplitterOps (CodeSplitterOps)-  , splitCode--    -- * Caching & Resilience-  , CacheBackend (..)-  , InMemoryCache (..)-  , newInMemoryCache-  , SQLiteCache (..)-  , newSQLiteCache-  , CachedModel (..)-  , withCaching-  , RetryPolicy (RetryPolicy)-  , defaultRetryPolicy-  , withRetry-  , RateLimiter (..)-  , newRateLimiter-  , withRateLimit--    -- * Chains-  , RetrievalQA (RetrievalQA)-  , newRetrievalQA-  , runRetrievalQA-  , MapReduceChain (..)-  , newMapReduceChain-  , runMapReduceChain--    -- * Structured Output & Parsers-  , OutputParser (..)-  , CommaSeparatedList (..)-  , JSONOutputStructure (..)-  , NumberSeparatedList (..)-  , StructuredOutput (..)-  , TypeSchema (..)-  , toOllamaSchema-  , fromOllamaSchema-  , structuredInvoke-  , structuredInvokeWithRetries-  , withJsonFormat-  , withSchemaFormat-  , withStructuredOutput--    -- * Agents & Execution-  , ReActAgent (ReActAgent)-  , AgentStep (..)-  , createReActAgent-  , reactStep-  , runReActAgent--    -- * Standard Tools-  , shellTool--    -- * Hybrid Retrieval & BM25-  , BM25Index (..)-  , newBM25Index-  , newBM25IndexWithParams-  , addDocumentsBM25-  , bm25Search-  , bm25SearchWithScores-  , HybridRetriever (..)-  , newHybridRetriever-  , newHybridRetrieverWithWeights-  , searchHybrid-  , searchHybridWithScores-  , reciprocalRankFusion--    -- * Providers-  , Ollama (..)-  , OllamaClientConfig (..)-  , defaultConfig-  , newOllama-  , newOllamaWithClient-  , ModelOptions (..)-  , defaultOptions-  , withOptions-  , chatRequestFor-  , resolveChatRequest-  , withTools-  , toOllamaTool-  , toOllamaTools-  , OllamaWithTools (..)-  , bindTools-  , OpenAI-  , newOpenAI-  , Gemini-  , newGemini-  ) where--import Langchain.Agent.PlanAndExecute-import Langchain.Agent.ReAct-import Langchain.Cache.Core-import Langchain.Callback.Manager-import Langchain.Chain.MapReduce-import Langchain.Chain.RetrievalQA-import Langchain.Core.Error-import Langchain.Core.Model-import Langchain.Core.Monad-import Langchain.Core.Runnable hiding (invoke)-import Langchain.Core.Stream-import Langchain.Core.Tool-import Langchain.DocumentLoader.Core-import Langchain.DocumentLoader.Csv-import Langchain.DocumentLoader.DirectoryLoader-import Langchain.DocumentLoader.FileLoader-import Langchain.Embeddings.Core-import Langchain.Embeddings.Ollama (OllamaEmbeddings (..))-import Langchain.Embeddings.OpenAI-  ( OpenAIEmbeddings (OpenAIEmbeddings)-  , defaultOpenAIEmbeddings-  , textEmbedding3Large-  , textEmbedding3Small-  , textEmbeddingAda-  )-import Langchain.Graph.Checkpointer-import Langchain.Graph.HITL-import Langchain.Graph.MultiAgent-import Langchain.Graph.Parallel-import Langchain.Graph.StateGraph-import Langchain.Guardrail.Core-import Langchain.MCP.Client-import Langchain.Memory.Core-import Langchain.Memory.Entity-import Langchain.Memory.Summary-import Langchain.Observability-import Langchain.OutputParser.Core-import Langchain.OutputParser.Structured-import Langchain.PromptTemplate.FewShot-import Langchain.PromptTemplate.Prompt-import Langchain.Provider.Gemini (Gemini, newGemini)-import Langchain.Provider.Ollama-  ( ModelOptions (..)-  , Ollama (..)-  , OllamaClientConfig (..)-  , OllamaWithTools (..)-  , bindTools-  , chatRequestFor-  , defaultConfig-  , defaultOptions-  , newOllama-  , newOllamaWithClient-  , resolveChatRequest-  , toOllamaTool-  , toOllamaTools-  , withJsonFormat-  , withOptions-  , withSchemaFormat-  , withStructuredOutput-  , withTools-  )-import Langchain.Provider.OpenAI (OpenAI, newOpenAI)-import Langchain.Resilience.CircuitBreaker-import Langchain.Resilience.Retry-import Langchain.Retriever.BM25-import Langchain.Retriever.Core-import Langchain.Retriever.Hybrid-import Langchain.TextSplitter.Character-import Langchain.TextSplitter.Code-import Langchain.TextSplitter.Markdown-import Langchain.TextSplitter.RecursiveCharacter-import Langchain.TextSplitter.Token-import Langchain.Tool.Async-import Langchain.Tool.Binding-import Langchain.Tool.GenericSchema-import Langchain.Tool.Shell (shellTool)-import Langchain.VectorStore.Core-import Langchain.VectorStore.InMemory-import Langchain.VectorStore.SqliteVec

@@ -1,25 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--{- |-Module      : Langchain.PromptTemplate.Chat-Description : Chat prompt template primitives-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Minimal chat prompt primitives ported from LangChain Python chat prompts.--}-module Langchain.PromptTemplate.Chat-  ( BaseMessagePromptTemplate (..)-  , extractTemplateVariables-  ) where--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model.Types (Message)-import Langchain.PromptTemplate.Prompt (extractTemplateVariables)---- | Base class for message prompt templates.-class BaseMessagePromptTemplate template input where-  formatMessages :: template -> input -> Either LangchainError [Message]

@@ -1,451 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.PromptTemplate.Chat.ChatPromptTemplate-Description : ChatPromptTemplate prompt template-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--}-module Langchain.PromptTemplate.Chat.ChatPromptTemplate-  ( ChatPromptTemplate (..)-  , ChatPromptMessage-  , ContentPromptBlock (..)-  , ChatPromptInput (..)-  , ChatPromptValue (..)-  , PartialValue (..)-  , fromTemplate-  , fromTemplateWithOptions-  , fromMessages-  , message-  , templateMessage-  , templateMessageWithFormat-  , contentMessage-  , messagesPlaceholder-  , messagesPlaceholderWithOptions-  , append-  , extend-  , partial-  , invoke-  , formatPrompt-  , format-  , toMessages-  , toString-  ) where--import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.:?), (.=))-import Data.Aeson.Types (Parser)-import Data.Either (fromRight)-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map.Strict as Map-import Data.Maybe (isJust)-import Data.Text (Text)-import qualified Data.Text as T-import GHC.Generics (Generic)--import Langchain.Core.Error (LangchainError, validationError)-import Langchain.Core.Model.Types-  ( ContentBlock (..)-  , ImageContent (..)-  , ImageSource (..)-  , Message (..)-  , Role (..)-  , formatMessageString-  , textMessage-  , userMessage-  )-import Langchain.PromptTemplate.Chat (BaseMessagePromptTemplate (formatMessages))-import Langchain.PromptTemplate.Chat.MessagesPlaceholder-  ( MessagesPlaceholder (..)-  , messagesPlaceholderVariableName-  )-import qualified Langchain.PromptTemplate.Chat.MessagesPlaceholder as MessagesPlaceholder-import Langchain.PromptTemplate.Prompt (PromptTemplateOptions, TemplateFormat (..))-import qualified Langchain.PromptTemplate.Prompt as Prompt---- | A single chat message template inside a chat prompt.-data ChatPromptMessage-  = HumanMessagePrompt Prompt.PromptTemplate-  | SystemMessagePrompt Prompt.PromptTemplate-  | AIMessagePrompt Prompt.PromptTemplate-  | ChatMessagePrompt Role Prompt.PromptTemplate-  | ContentMessagePrompt Role [ContentPromptBlock]-  | MessagesPlaceholderPrompt MessagesPlaceholder (Maybe [Message])-  | StaticMessage Message-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | A templated block inside a multipart chat message.-data ContentPromptBlock-  = TextPromptBlock TemplateFormat Text-  | ImagePromptBlock TemplateFormat ImageContent-  deriving (Show, Eq, Generic)--instance ToJSON ContentPromptBlock where-  toJSON (TextPromptBlock templateFormat template) =-    object-      [ "type" .= ("text_prompt" :: Text)-      , "templateFormat" .= templateFormat-      , "template" .= template-      ]-  toJSON (ImagePromptBlock templateFormat imageContent) =-    object-      [ "type" .= ("image_prompt" :: Text)-      , "templateFormat" .= templateFormat-      , "imageContent" .= imageContentToJSON imageContent-      ]--instance FromJSON ContentPromptBlock where-  parseJSON = withObject "ContentPromptBlock" $ \value -> do-    blockType <- value .: "type"-    case (blockType :: Text) of-      "text_prompt" -> TextPromptBlock <$> value .: "templateFormat" <*> value .: "template"-      "image_prompt" ->-        ImagePromptBlock <$> value .: "templateFormat" <*> (value .: "imageContent" >>= parseImageContent)-      other -> fail $ "Unknown ContentPromptBlock type: " ++ show other--imageContentToJSON :: ImageContent -> Value-imageContentToJSON ImageContent {imageSource = source, imageDetail = detail, imageMetadata = metadata} =-  object-    [ "source" .= imageSourceToJSON source-    , "detail" .= detail-    , "metadata" .= metadata-    ]--imageSourceToJSON :: ImageSource -> Value-imageSourceToJSON (ImageBase64 mime sourceData) =-  object-    [ "type" .= ("base64" :: Text)-    , "mimeType" .= mime-    , "data" .= sourceData-    ]-imageSourceToJSON (ImageUrl url) =-  object-    [ "type" .= ("url" :: Text)-    , "url" .= url-    ]--parseImageContent :: Value -> Parser ImageContent-parseImageContent = withObject "ImageContent" $ \value ->-  ImageContent-    <$> (value .: "source" >>= parseImageSource)-    <*> value .:? "detail"-    <*> value .:? "metadata"--parseImageSource :: Value -> Parser ImageSource-parseImageSource = withObject "ImageSource" $ \value -> do-  sourceType <- value .: "type"-  case (sourceType :: Text) of-    "base64" -> ImageBase64 <$> value .:? "mimeType" <*> value .: "data"-    "url" -> ImageUrl <$> value .: "url"-    other -> fail $ "Unknown ImageSource type: " ++ show other---- | A chat prompt template made of ordered message templates.-data ChatPromptTemplate = ChatPromptTemplate-  { messages :: [ChatPromptMessage]-  , inputVariables :: [Text]-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | A rendered chat prompt as concrete messages.-newtype ChatPromptValue = ChatPromptValue-  { messages :: [Message]-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Inputs accepted by 'invoke' for chat prompts.-data ChatPromptInput-  = ChatPromptVariables (Map.Map Text Text)-  | ChatPromptMessageList [Message]-  | ChatPromptInputs (Map.Map Text Text) (Map.Map Text [Message])-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Partial values that can pre-bind text or message placeholders.-data PartialValue-  = PartialText Text-  | PartialMessages [Message]-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Create a single-message user chat prompt from raw text.-fromTemplate :: Text -> ChatPromptTemplate-fromTemplate template = fromTemplateWithOptions template Prompt.defaultPromptTemplateOptions---- | Create a single-message user chat prompt with partial variables.-fromTemplateWithOptions :: Text -> PromptTemplateOptions -> ChatPromptTemplate-fromTemplateWithOptions template options =-  let promptTemplate = Prompt.fromTemplateWithOptions template options-   in ChatPromptTemplate-        { messages = [ChatMessagePrompt User promptTemplate]-        , inputVariables = Prompt.inputVariables promptTemplate-        }---- | Create a chat prompt from an explicit list of message templates.-fromMessages :: [ChatPromptMessage] -> ChatPromptTemplate-fromMessages promptMessages =-  ChatPromptTemplate-    { messages = promptMessages-    , inputVariables = unique $ concatMap messageInputVariables promptMessages-    }---- | Wrap a concrete message as part of a chat prompt.-message :: Message -> ChatPromptMessage-message = StaticMessage---- | Create a templated message for a specific role.-templateMessage :: Role -> Text -> ChatPromptMessage-templateMessage role = ChatMessagePrompt role . Prompt.fromTemplate---- | Create a templated message for a specific role and template format.-templateMessageWithFormat :: Role -> TemplateFormat -> Text -> ChatPromptMessage-templateMessageWithFormat role templateFormat template =-  ChatMessagePrompt role $-    Prompt.fromTemplateWithFormat template templateFormat Map.empty---- | Create a multipart content message for a specific role.-contentMessage :: Role -> [ContentPromptBlock] -> ChatPromptMessage-contentMessage = ContentMessagePrompt---- | Create a placeholder for an injected message list.-messagesPlaceholder :: Text -> ChatPromptMessage-messagesPlaceholder name = messagesPlaceholderWithOptions $ MessagesPlaceholder.messagesPlaceholderOptions name---- | Create a message-list placeholder with explicit options.-messagesPlaceholderWithOptions ::-  MessagesPlaceholder.MessagesPlaceholderOptions -> ChatPromptMessage-messagesPlaceholderWithOptions options =-  MessagesPlaceholderPrompt (MessagesPlaceholder.messagesPlaceholderWithOptions options) Nothing---- | Append one message template to the end of a chat prompt.-append :: ChatPromptTemplate -> ChatPromptMessage -> ChatPromptTemplate-append chatPromptTemplate promptMessage = extend chatPromptTemplate [promptMessage]---- | Append multiple message templates to the end of a chat prompt.-extend :: ChatPromptTemplate -> [ChatPromptMessage] -> ChatPromptTemplate-extend ChatPromptTemplate {messages = promptMessages} newMessages =-  fromMessages $ promptMessages <> newMessages---- | Apply partial text and message bindings to a chat prompt.-partial :: ChatPromptTemplate -> Map.Map Text PartialValue -> ChatPromptTemplate-partial ChatPromptTemplate {messages = promptMessages} partialVariables =-  fromMessages $ map (`partialMessage` partialVariables) promptMessages---- | Render a chat prompt to concrete messages.-formatPrompt :: ChatPromptTemplate -> Map.Map Text Text -> Either LangchainError ChatPromptValue-formatPrompt ChatPromptTemplate {messages = promptMessages} variables =-  formatPromptWithMessages promptMessages variables Map.empty---- | Render a chat prompt with either variables or message-list inputs.-invoke :: ChatPromptTemplate -> ChatPromptInput -> Either LangchainError ChatPromptValue-invoke chatPromptTemplate (ChatPromptVariables variables) = formatPrompt chatPromptTemplate variables-invoke ChatPromptTemplate {messages = [MessagesPlaceholderPrompt placeholder _]} (ChatPromptMessageList promptMessages) =-  ChatPromptValue-    <$> formatMessages-      placeholder-      (Map.singleton (messagesPlaceholderVariableName placeholder) promptMessages)-invoke ChatPromptTemplate {messages = promptMessages} (ChatPromptInputs variables messageVariables) =-  formatPromptWithMessages promptMessages variables messageVariables-invoke _ (ChatPromptMessageList _) =-  Left $-    validationError-      "List input is only supported for a single MessagesPlaceholder"-      (Just "ChatPromptTemplate")-      (Just "invoke")---- | Render a chat prompt to a single formatted text value.-format :: ChatPromptTemplate -> Map.Map Text Text -> Either LangchainError Text-format chatPromptTemplate variables = toString <$> formatPrompt chatPromptTemplate variables---- | Extract the concrete messages from a rendered chat prompt.-toMessages :: ChatPromptValue -> [Message]-toMessages (ChatPromptValue promptMessages) = promptMessages---- | Render a chat prompt as newline-separated message text.-toString :: ChatPromptValue -> Text-toString (ChatPromptValue promptMessages) =-  T.intercalate "\n" $ map formatMessageString promptMessages--messageInputVariables :: ChatPromptMessage -> [Text]-messageInputVariables (HumanMessagePrompt promptTemplate) = Prompt.inputVariables promptTemplate-messageInputVariables (SystemMessagePrompt promptTemplate) = Prompt.inputVariables promptTemplate-messageInputVariables (AIMessagePrompt promptTemplate) = Prompt.inputVariables promptTemplate-messageInputVariables (ChatMessagePrompt _ promptTemplate) = Prompt.inputVariables promptTemplate-messageInputVariables (ContentMessagePrompt _ blocks) = unique $ concatMap contentBlockInputVariables blocks-messageInputVariables-  ( MessagesPlaceholderPrompt-      MessagesPlaceholder-        { variableName = variableName'-        , optional = optional'-        }-      storedMessages-    )-    | optional' || isJust storedMessages = []-    | otherwise = [variableName']-messageInputVariables (StaticMessage _) = []--partialMessage :: ChatPromptMessage -> Map.Map Text PartialValue -> ChatPromptMessage-partialMessage (HumanMessagePrompt promptTemplate) partialVariables =-  HumanMessagePrompt $-    Prompt.partialPromptTemplate promptTemplate (textPartialVariables partialVariables)-partialMessage (SystemMessagePrompt promptTemplate) partialVariables =-  SystemMessagePrompt $-    Prompt.partialPromptTemplate promptTemplate (textPartialVariables partialVariables)-partialMessage (AIMessagePrompt promptTemplate) partialVariables =-  AIMessagePrompt $-    Prompt.partialPromptTemplate promptTemplate (textPartialVariables partialVariables)-partialMessage (ChatMessagePrompt role promptTemplate) partialVariables =-  ChatMessagePrompt role $-    Prompt.partialPromptTemplate promptTemplate (textPartialVariables partialVariables)-partialMessage (ContentMessagePrompt role blocks) partialVariables =-  ContentMessagePrompt role $-    map (\block -> partialContentBlock block (textPartialVariables partialVariables)) blocks-partialMessage (MessagesPlaceholderPrompt placeholder storedMessages) partialVariables =-  MessagesPlaceholderPrompt placeholder $-    case Map.lookup (messagesPlaceholderVariableName placeholder) partialVariables of-      Just (PartialMessages promptMessages) -> Just promptMessages-      _ -> storedMessages-partialMessage (StaticMessage staticMessage) _ = StaticMessage staticMessage--textPartialVariables :: Map.Map Text PartialValue -> Map.Map Text Text-textPartialVariables = Map.mapMaybe toText-  where-    toText :: PartialValue -> Maybe Text-    toText (PartialText value) = Just value-    toText (PartialMessages _) = Nothing--formatPromptWithMessages ::-  [ChatPromptMessage] ->-  Map.Map Text Text ->-  Map.Map Text [Message] ->-  Either LangchainError ChatPromptValue-formatPromptWithMessages promptMessages variables messageVariables =-  ChatPromptValue . concat-    <$> traverse (\promptMessage -> formatMessage promptMessage variables messageVariables) promptMessages--formatMessage ::-  ChatPromptMessage -> Map.Map Text Text -> Map.Map Text [Message] -> Either LangchainError [Message]-formatMessage (HumanMessagePrompt promptTemplate) variables _ =-  (: []) . userMessage <$> Prompt.renderPrompt promptTemplate variables-formatMessage (SystemMessagePrompt promptTemplate) variables _ =-  (: []) . textMessage System <$> Prompt.renderPrompt promptTemplate variables-formatMessage (AIMessagePrompt promptTemplate) variables _ =-  (: []) . textMessage Assistant <$> Prompt.renderPrompt promptTemplate variables-formatMessage (ChatMessagePrompt role promptTemplate) variables _ =-  (: []) . textMessage role <$> Prompt.renderPrompt promptTemplate variables-formatMessage (ContentMessagePrompt role blocks) variables _ = do-  renderedBlocks <- concat <$> traverse (renderContentBlock variables) blocks-  case NonEmpty.nonEmpty renderedBlocks of-    Nothing -> Right []-    Just nonEmptyBlocks -> Right [Message role nonEmptyBlocks Nothing Nothing Nothing Map.empty]-formatMessage (MessagesPlaceholderPrompt placeholder storedMessages) _ messageVariables =-  formatMessages placeholder $-    case storedMessages of-      Nothing -> messageVariables-      Just promptMessages ->-        messageVariables-          `Map.union` Map.singleton (messagesPlaceholderVariableName placeholder) promptMessages-formatMessage (StaticMessage staticMessage) _ _ = Right [staticMessage]--contentBlockInputVariables :: ContentPromptBlock -> [Text]-contentBlockInputVariables (TextPromptBlock templateFormat template) =-  Prompt.extractTemplateVariablesWithFormat templateFormat template-contentBlockInputVariables (ImagePromptBlock templateFormat imageContent) =-  imageContentInputVariables templateFormat imageContent--partialContentBlock :: ContentPromptBlock -> Map.Map Text Text -> ContentPromptBlock-partialContentBlock (TextPromptBlock templateFormat template) partials =-  TextPromptBlock templateFormat $ renderPartial templateFormat partials template-partialContentBlock (ImagePromptBlock templateFormat imageContent) partials =-  ImagePromptBlock templateFormat $ partialImageContent templateFormat partials imageContent--renderContentBlock ::-  Map.Map Text Text -> ContentPromptBlock -> Either LangchainError [ContentBlock]-renderContentBlock variables (TextPromptBlock templateFormat template) = do-  rendered <- renderTemplate templateFormat variables template-  pure [TextBlock rendered | not (T.null rendered)]-renderContentBlock variables (ImagePromptBlock templateFormat imageContent) = do-  renderedImage <- renderImageContent templateFormat variables imageContent-  pure [ImageBlock renderedImage]--imageContentInputVariables :: TemplateFormat -> ImageContent -> [Text]-imageContentInputVariables templateFormat ImageContent {imageSource = source, imageDetail = detail, imageMetadata = metadata} =-  imageSourceInputVariables templateFormat source-    <> maybe [] (Prompt.extractTemplateVariablesWithFormat templateFormat) detail-    <> maybe [] (valueInputVariables templateFormat) metadata--imageSourceInputVariables :: TemplateFormat -> ImageSource -> [Text]-imageSourceInputVariables templateFormat (ImageBase64 _ imageTemplate) =-  Prompt.extractTemplateVariablesWithFormat templateFormat imageTemplate-imageSourceInputVariables templateFormat (ImageUrl url) =-  Prompt.extractTemplateVariablesWithFormat templateFormat url--partialImageContent :: TemplateFormat -> Map.Map Text Text -> ImageContent -> ImageContent-partialImageContent templateFormat partials ImageContent {imageSource = source, imageDetail = detail, imageMetadata = metadata} =-  ImageContent-    { imageSource = partialImageSource templateFormat partials source-    , imageDetail = renderPartial templateFormat partials <$> detail-    , imageMetadata = renderPartialValue templateFormat partials <$> metadata-    }--partialImageSource :: TemplateFormat -> Map.Map Text Text -> ImageSource -> ImageSource-partialImageSource templateFormat partials (ImageBase64 mime imageTemplate) =-  ImageBase64 mime $ renderPartial templateFormat partials imageTemplate-partialImageSource templateFormat partials (ImageUrl url) =-  ImageUrl $ renderPartial templateFormat partials url--renderImageContent ::-  TemplateFormat -> Map.Map Text Text -> ImageContent -> Either LangchainError ImageContent-renderImageContent templateFormat variables ImageContent {imageSource = source, imageDetail = detail, imageMetadata = metadata} = do-  renderedSource <- renderImageSource templateFormat variables source-  renderedDetail <- traverse (renderTemplate templateFormat variables) detail-  renderedMetadata <- traverse (renderValue templateFormat variables) metadata-  pure $ ImageContent renderedSource renderedDetail renderedMetadata--renderImageSource ::-  TemplateFormat -> Map.Map Text Text -> ImageSource -> Either LangchainError ImageSource-renderImageSource templateFormat variables (ImageBase64 mime imageTemplate) =-  ImageBase64 mime <$> renderTemplate templateFormat variables imageTemplate-renderImageSource templateFormat variables (ImageUrl url) =-  ImageUrl <$> renderTemplate templateFormat variables url--renderTemplate :: TemplateFormat -> Map.Map Text Text -> Text -> Either LangchainError Text-renderTemplate templateFormat variables template =-  Prompt.renderPrompt-    (Prompt.fromTemplateWithFormat template templateFormat Map.empty)-    variables--renderPartial :: TemplateFormat -> Map.Map Text Text -> Text -> Text-renderPartial templateFormat partials template =-  fromRight template $ renderTemplate templateFormat partials template--valueInputVariables :: TemplateFormat -> Value -> [Text]-valueInputVariables templateFormat (String value) =-  Prompt.extractTemplateVariablesWithFormat templateFormat value-valueInputVariables templateFormat (Array values) =-  concatMap (valueInputVariables templateFormat) values-valueInputVariables templateFormat (Object objectValue) =-  concatMap (valueInputVariables templateFormat) objectValue-valueInputVariables _ _ = []--renderValue :: TemplateFormat -> Map.Map Text Text -> Value -> Either LangchainError Value-renderValue templateFormat variables (String value) =-  String <$> renderTemplate templateFormat variables value-renderValue templateFormat variables (Array values) =-  Array <$> traverse (renderValue templateFormat variables) values-renderValue templateFormat variables (Object objectValue) =-  Object <$> traverse (renderValue templateFormat variables) objectValue-renderValue _ _ value = Right value--renderPartialValue :: TemplateFormat -> Map.Map Text Text -> Value -> Value-renderPartialValue templateFormat partials value =-  fromRight value $ renderValue templateFormat partials value--unique :: [Text] -> [Text]-unique = foldl addIfMissing []-  where-    addIfMissing :: [Text] -> Text -> [Text]-    addIfMissing variableNames name-      | name `elem` variableNames = variableNames-      | otherwise = variableNames <> [name]

@@ -1,98 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.PromptTemplate.Chat.MessagesPlaceholder-Description : MessagesPlaceholder prompt template-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--}-module Langchain.PromptTemplate.Chat.MessagesPlaceholder-  ( MessagesPlaceholder (..)-  , MessagesPlaceholderOptions (..)-  , messagesPlaceholder-  , messagesPlaceholderOptions-  , messagesPlaceholderWithOptions-  , messagesPlaceholderVariableName-  ) where--import Data.Aeson (FromJSON, ToJSON)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import GHC.Generics (Generic)--import Langchain.Core.Error (validationError)-import Langchain.Core.Model.Types (Message)-import Langchain.PromptTemplate.Chat (BaseMessagePromptTemplate (..))---- | Prompt template that expects one variable to contain an existing message list.-data MessagesPlaceholder = MessagesPlaceholder-  { variableName :: Text-  , optional :: Bool-  , nMessages :: Maybe Int-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)--data MessagesPlaceholderOptions = MessagesPlaceholderOptions-  { variableName :: Text-  , optional :: Bool-  , nMessages :: Maybe Int-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)--instance BaseMessagePromptTemplate MessagesPlaceholder (Map.Map Text [Message]) where-  formatMessages-    MessagesPlaceholder-      { variableName = variableName'-      , optional = optional'-      , nMessages = nMessages'-      }-    inputs = do-      values <--        case Map.lookup variableName' inputs of-          Just values' -> Right values'-          Nothing-            | optional' -> Right []-            | otherwise ->-                Left $-                  validationError-                    ("Missing variable: " <> variableName')-                    (Just variableName')-                    Nothing-      case nMessages' of-        Just limit-          | limit <= 0 ->-              Left $ validationError "n_messages must be positive" (Just variableName') Nothing-        _ -> pure $ maybe values (`takeLast` values) nMessages'---- | Create a required messages placeholder.-messagesPlaceholder :: Text -> MessagesPlaceholder-messagesPlaceholder name = messagesPlaceholderWithOptions $ messagesPlaceholderOptions name--messagesPlaceholderOptions :: Text -> MessagesPlaceholderOptions-messagesPlaceholderOptions name =-  MessagesPlaceholderOptions-    { variableName = name-    , optional = False-    , nMessages = Nothing-    }--messagesPlaceholderWithOptions :: MessagesPlaceholderOptions -> MessagesPlaceholder-messagesPlaceholderWithOptions MessagesPlaceholderOptions {variableName = name, optional = optional', nMessages = nMessages'} =-  MessagesPlaceholder-    { variableName = name-    , optional = optional'-    , nMessages = nMessages'-    }--messagesPlaceholderVariableName :: MessagesPlaceholder -> Text-messagesPlaceholderVariableName MessagesPlaceholder {variableName = name} = name--takeLast :: Int -> [a] -> [a]-takeLast n values = drop (max 0 (length values - n)) values

@@ -1,47 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.PromptTemplate.FewShot-Description : Few-shot prompt templates-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--}-module Langchain.PromptTemplate.FewShot-  ( FewShotPromptTemplate (..)-  , renderFewShotPrompt-  , renderFewShotPromptWithVars-  ) where--import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as T--import Langchain.Core.Error (LangchainError)-import Langchain.PromptTemplate.Prompt (fromTemplate, renderPrompt)---- | Represents a few-shot prompt template with examples-data FewShotPromptTemplate = FewShotPromptTemplate-  { fsPrefix :: Text-  , fsExamples :: [Map.Map Text Text]-  , fsExampleTemplate :: Text-  , fsExampleSeparator :: Text-  , fsSuffix :: Text-  }-  deriving (Show, Eq)---- | Render a few-shot prompt template-renderFewShotPrompt :: FewShotPromptTemplate -> Either LangchainError Text-renderFewShotPrompt FewShotPromptTemplate {..} = do-  formattedExamples <- traverse (renderPrompt (fromTemplate fsExampleTemplate)) fsExamples-  let examplesText = T.intercalate fsExampleSeparator formattedExamples-  pure $ fsPrefix <> examplesText <> fsSuffix---- | Render few-shot template with additional variables-renderFewShotPromptWithVars ::-  FewShotPromptTemplate -> Map.Map Text Text -> Either LangchainError Text-renderFewShotPromptWithVars template vars = do-  renderedBase <- renderFewShotPrompt template-  renderPrompt (fromTemplate renderedBase) vars

@@ -1,104 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module      : Langchain.PromptTemplate.Prompt-Description : String prompt templates-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Prompt templates backed by string interpolation.--}-module Langchain.PromptTemplate.Prompt-  ( PromptTemplate (..)-  , PromptTemplateOptions (..)-  , TemplateFormat (..)-  , defaultPromptTemplateOptions-  , fromTemplate-  , fromTemplateWithOptions-  , fromTemplateWithFormat-  , partialPromptTemplate-  , renderPrompt-  , renderTemplateWithFormat-  , renderFStringTemplate-  , extractTemplateVariables-  , extractTemplateVariablesWithFormat-  ) where--import Data.Aeson (FromJSON, ToJSON)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import GHC.Generics (Generic)--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Runnable (Runnable (..))-import Langchain.PromptTemplate.String-  ( TemplateFormat (..)-  , extractTemplateVariables-  , extractTemplateVariablesWithFormat-  , renderFStringTemplate-  , renderTemplateWithFormat-  )---- | Prompt template container with template string containing {var} placeholders.-data PromptTemplate = PromptTemplate-  { template :: Text-  , inputVariables :: [Text]-  , -- Matches Python partial_variables: pre-bound values reduce required inputs-    -- without changing the original template string.-    partialVariables :: Map.Map Text Text-  , templateFormat :: TemplateFormat-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Options for building a prompt template, currently only partial variables.-newtype PromptTemplateOptions = PromptTemplateOptions-  { partialVariables :: Map.Map Text Text-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Default prompt template options with no partial variables.-defaultPromptTemplateOptions :: PromptTemplateOptions-defaultPromptTemplateOptions = PromptTemplateOptions mempty---- | Build a string prompt template using the default FString format.-fromTemplate :: Text -> PromptTemplate-fromTemplate source = fromTemplateWithOptions source defaultPromptTemplateOptions---- | Build a string prompt template with pre-bound partial variables.-fromTemplateWithOptions :: Text -> PromptTemplateOptions -> PromptTemplate-fromTemplateWithOptions source (PromptTemplateOptions partials) =-  fromTemplateWithFormat source FString partials---- | Build a prompt template from raw text, format, and partial variables.-fromTemplateWithFormat :: Text -> TemplateFormat -> Map.Map Text Text -> PromptTemplate-fromTemplateWithFormat source format partials =-  PromptTemplate-    { template = source-    , inputVariables =-        filter (`Map.notMember` partials) (extractTemplateVariablesWithFormat format source)-    , partialVariables = partials-    , templateFormat = format-    }---- | Apply additional partial variables to an existing prompt template.-partialPromptTemplate :: PromptTemplate -> Map.Map Text Text -> PromptTemplate-partialPromptTemplate (PromptTemplate source _ existingPartials format) partials =-  fromTemplateWithFormat source format (partials `Map.union` existingPartials)---- | Render a prompt template with the given variable map.-renderPrompt :: PromptTemplate -> Map.Map Text Text -> Either LangchainError Text-renderPrompt (PromptTemplate source _ partials format) vars =-  renderTemplateWithFormat format (vars `Map.union` partials) source---- | 'PromptTemplate' implements 'Runnable' transforming variable 'Map' to rendered 'Text'.-instance Monad m => Runnable PromptTemplate m where-  type RunnableInput PromptTemplate = Map.Map Text Text-  type RunnableOutput PromptTemplate = Text-  invoke pt vars = pure (renderPrompt pt vars)

@@ -1,104 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.PromptTemplate.String-Description : String prompt template formatting helpers-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--String template parsing, variable extraction, and interpolation helpers.--}-module Langchain.PromptTemplate.String-  ( TemplateFormat (..)-  , renderTemplateWithFormat-  , renderFStringTemplate-  , extractTemplateVariables-  , extractTemplateVariablesWithFormat-  ) where--import Data.Aeson (FromJSON, ToJSON)-import Data.Char (isDigit)-import Data.Foldable (traverse_)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as T-import Data.Text.Format.Heavy.Build (formatEither)-import Data.Text.Format.Heavy.Instances ()-import Data.Text.Format.Heavy.Parse (FormatParseItem (..), parse, parseFormat)-import qualified Data.Text.Lazy as TL-import GHC.Generics (Generic)--import Langchain.Core.Error (LangchainError, validationError)--data TemplateFormat-  = FString-  deriving (Show, Eq, Generic, ToJSON, FromJSON)--renderTemplateWithFormat ::-  TemplateFormat -> Map.Map Text Text -> Text -> Either LangchainError Text-renderTemplateWithFormat FString = renderFStringTemplate--renderFStringTemplate :: Map.Map Text Text -> Text -> Either LangchainError Text-renderFStringTemplate vars source = do-  items <- parseFStringTemplate source-  traverse_ validateFStringItem items-  format <- mapParseError $ parseFormat (TL.fromStrict source)-  mapFormatError $ TL.toStrict <$> formatEither format (toFStringVars vars)-  where-    mapFormatError :: Either String a -> Either LangchainError a-    mapFormatError (Left err) = Left $ validationError (T.pack err) (Just "PromptTemplate") Nothing-    mapFormatError (Right result) = Right result--toFStringVars :: Map.Map Text Text -> Map.Map TL.Text Text-toFStringVars = Map.mapKeys TL.fromStrict--parseFStringTemplate :: Text -> Either LangchainError [FormatParseItem]-parseFStringTemplate source = mapParseError $ parse (TL.fromStrict source)--mapParseError :: (Show err) => Either err a -> Either LangchainError a-mapParseError (Left err) = Left $ validationError (T.pack $ show err) (Just "PromptTemplate") Nothing-mapParseError (Right result) = Right result--validateFStringItem :: FormatParseItem -> Either LangchainError ()-validateFStringItem (FormatString _) = Right ()-validateFStringItem (FormatReplacementField variableName formatSpec) = do-  validateFStringVariableName variableName-  traverse_ validateFStringFormatSpec formatSpec--validateFStringVariableName :: TL.Text -> Either LangchainError ()-validateFStringVariableName variableName-  | TL.all isDigit variableName =-      Left $-        validationError "Positional arguments are not supported" (Just $ TL.toStrict variableName) Nothing-  | TL.any (== '.') variableName =-      Left $ validationError "Attribute access is not supported" (Just $ TL.toStrict variableName) Nothing-  | TL.any (`elem` ['[', ']']) variableName =-      Left $ validationError "Index access is not supported" (Just $ TL.toStrict variableName) Nothing-  | otherwise = Right ()--validateFStringFormatSpec :: TL.Text -> Either LangchainError ()-validateFStringFormatSpec formatSpec-  | TL.any (`elem` ['{', '}']) formatSpec =-      Left $ validationError "Nested replacement fields are not allowed" (Just "PromptTemplate") Nothing-  | otherwise = Right ()--extractTemplateVariables :: Text -> [Text]-extractTemplateVariables = extractTemplateVariablesWithFormat FString--extractTemplateVariablesWithFormat :: TemplateFormat -> Text -> [Text]-extractTemplateVariablesWithFormat FString source =-  case parseFStringTemplate source of-    Left _ -> []-    Right parts -> unique [TL.toStrict variableName | FormatReplacementField variableName _ <- parts]--unique :: [Text] -> [Text]-unique = foldl addIfMissing []--addIfMissing :: [Text] -> Text -> [Text]-addIfMissing variableNames variableName-  | variableName `elem` variableNames = variableNames-  | otherwise = variableNames <> [variableName]

@@ -1,483 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{- |-Module      : Langchain.Provider.Gemini-Description : Google Gemini provider implementing ChatModel-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Gemini provider with multi-modal content parts support.--}-module Langchain.Provider.Gemini-  ( Gemini (..)-  , GeminiConfig (..)-  , defaultConfig-  , defaultGeminiConfig-  , newGemini-  , parseGeminiResponse-  ) where--import Control.Applicative ((<|>))-import Control.Concurrent.Async (AsyncCancelled (..))-import Control.Exception (SomeException, fromException, throwIO, try)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (liftIO)-import Data.Aeson-import qualified Data.Aeson.KeyMap as KeyMap-import Data.Aeson.Types (Parser, parseEither)-import Data.Conduit (ConduitT, await, runConduit, yield, (.|))-import qualified Data.Conduit.Combinators as C-import qualified Data.List as List-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe)-import qualified Data.Proxy as Proxy-import Data.Text (Text)-import qualified Data.Text as T-import GHC.Generics (Generic)-import Network.HTTP.Client (newManager)-import Network.HTTP.Client.TLS (tlsManagerSettings)-import Network.HTTP.Simple-import Servant.API (Capture, JSON, QueryParam, ReqBody, (:>))-import Servant.API.EventStream-  ( FromServerEvent (fromServerEvent)-  , PostServerSentEvents-  , jsonData-  )-import Servant.Client.Core.BaseUrl (parseBaseUrl)-import Servant.Client.Streaming (ClientM, client, mkClientEnv, withClientM)-import Servant.Conduit ()--import Langchain.Core.Error (LangchainError, llmError)-import Langchain.Core.Model-import Langchain.Core.Stream (StreamEvent (..), TokenUsage (..), callbackSource)-import qualified Langchain.Core.Tool as CoreTool-import Langchain.Tool.Binding (ToolBinder (..))---- | Gemini configuration-data GeminiConfig = GeminiConfig-  { configApiKey :: Text-  , configModel :: Text-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON)--defaultConfig :: Text -> GeminiConfig-defaultConfig key = GeminiConfig key "gemini-2.0-flash"--defaultGeminiConfig :: Text -> GeminiConfig-defaultGeminiConfig = defaultConfig---- | Gemini ChatModel provider-data Gemini-  = Gemini-  { apiKey :: Text-  , model :: Text-  , baseUrl :: Maybe Text-  }-  deriving (Eq, Show)---- | Create a new Gemini provider instance-newGemini :: Text -> Text -> Maybe Text -> Gemini-newGemini = Gemini--geminiApiKey :: Gemini -> Text-geminiApiKey = apiKey--geminiModel :: Gemini -> Text-geminiModel = model--geminiBaseUrl :: Gemini -> Text-geminiBaseUrl Gemini {baseUrl = Just baseUrl} = T.dropWhileEnd (== '/') baseUrl-geminiBaseUrl Gemini {} = "https://generativelanguage.googleapis.com"---- Convert ContentBlock to Gemini Part JSON-contentBlockToPart :: ContentBlock -> Value-contentBlockToPart (TextBlock t) =-  object ["text" .= t]-contentBlockToPart (ImageBlock ImageContent {imageSource = ImageBase64 (Just mime) b64}) =-  object-    [ "inline_data"-        .= object-          [ "mime_type" .= mime-          , "data" .= b64-          ]-    ]-contentBlockToPart (ImageBlock ImageContent {imageSource = ImageUrl url}) =-  object ["text" .= ("[Image URL: " <> url <> "]")]-contentBlockToPart (ImageBlock ImageContent {imageSource = ImageBase64 Nothing _}) =-  object ["text" .= ("[Image data block: base64]" :: Text)]-contentBlockToPart (AudioBlock mime b64) =-  object-    [ "inline_data"-        .= object-          [ "mime_type" .= mime-          , "data" .= b64-          ]-    ]-contentBlockToPart (DataBlock _) =-  object ["text" .= ("[Data block]" :: Text)]---- Convert a non-tool Message to Gemini Content JSON.-messageToGemini :: Message -> Value-messageToGemini msg =-  let role = messageRole msg-      geminiRole = case role of-        User -> "user"-        Assistant -> "model"-        System -> "user"-        Developer -> "user"-        Tool -> "user"-        Function -> "user"-      toolCallParts = case role of-        Assistant -> maybe [] (functionCallParts $ messageMetadata msg) (messageToolCalls msg)-        _ -> []-      contentBlocks = NonEmpty.toList (messageContents msg)-      contentParts = map contentBlockToPart contentBlocks-      parts-        | null toolCallParts = contentParts-        | otherwise = map contentBlockToPart (filter (not . emptyTextPart) contentBlocks) <> toolCallParts-   in object ["role" .= (geminiRole :: Text), "parts" .= parts]-  where-    functionCallParts metadata toolCalls =-      zipWith functionCallPart toolCalls (thoughtSignatures metadata <> repeat Nothing)--    functionCallPart (ToolCall {toolCallName = name, toolCallArguments = args, toolCallId = callId}) thoughtSignature =-      object $-        [ "functionCall"-            .= object-              ( [ "name" .= name-                , "args" .= args-                ]-                  <> (["id" .= callId | notNull callId])-              )-        ]-          <> maybe [] (pure . ("thoughtSignature" .=)) thoughtSignature--    notNull = not . T.null--    emptyTextPart (TextBlock text) = T.null text-    emptyTextPart _ = False--geminiThoughtSignaturesKey :: Text-geminiThoughtSignaturesKey = "langchain.gemini.thoughtSignatures"--thoughtSignatures :: Map.Map Text Value -> [Maybe Text]-thoughtSignatures metadata =-  case Map.lookup geminiThoughtSignaturesKey metadata of-    Just value -> case fromJSON value of-      Success signatures -> signatures-      Error _ -> []-    Nothing -> []--withThoughtSignatures :: [ToolCall] -> [Maybe Text] -> Message -> Message-withThoughtSignatures [] _ message = message {messageToolCalls = Nothing}-withThoughtSignatures toolCalls signatures message =-  message-    { messageToolCalls = Just toolCalls-    , messageMetadata =-        Map.insert geminiThoughtSignaturesKey (toJSON signatures) (messageMetadata message)-    }--functionResponsePart :: [ToolCall] -> Message -> Either Text Value-functionResponsePart priorToolCalls msg = do-  toolName <--    maybe-      (Left "Gemini function response is missing a function name")-      Right-      (messageName msg <|> (messageToolId msg >>= lookupToolName))-  let functionResponseFields =-        [ "name" .= toolName-        , "response" .= object ["result" .= extractMessageText msg]-        ]-          <> maybe [] (pure . ("id" .=)) (messageToolId msg)-  pure $ object ["functionResponse" .= object functionResponseFields]-  where-    lookupToolName toolId =-      toolCallName <$> List.find ((== toolId) . toolCallId) priorToolCalls--messagesToGemini :: [ToolCall] -> [Message] -> Either Text [Value]-messagesToGemini _ [] = Right []-messagesToGemini priorToolCalls (msg : remaining)-  | isFunctionResponse msg = do-      let (responseMessages, followingMessages) = span isFunctionResponse remaining-      parts <- traverse (functionResponsePart priorToolCalls) (msg : responseMessages)-      contents <- messagesToGemini priorToolCalls followingMessages-      pure $ object ["role" .= ("user" :: Text), "parts" .= parts] : contents-  | otherwise = do-      contents <- messagesToGemini priorToolCalls remaining-      pure $ messageToGemini msg : contents-  where-    isFunctionResponse message = messageRole message `elem` [Tool, Function]--geminiRequestPayload :: [Message] -> Maybe Value -> Either Text Value-geminiRequestPayload inputMsgs config = do-  let priorToolCalls = concatMap (fromMaybe [] . messageToolCalls) inputMsgs-  contents <- messagesToGemini priorToolCalls inputMsgs-  case config of-    Just (Object fields) -> pure $ Object $ KeyMap.insert "contents" (toJSON contents) fields-    Nothing -> pure $ object ["contents" .= contents]-    Just _ -> Left "Gemini config must be a JSON object"--instance ChatModel Gemini where-  type ModelConfig Gemini = Value--  invoke provider inputMsgs config = do-    payload <--      either (throwError . \err -> llmError err Nothing Nothing) pure $-        geminiRequestPayload inputMsgs config-    let url =-          geminiBaseUrl provider-            <> "/v1beta/models/"-            <> geminiModel provider-            <> ":generateContent?key="-            <> geminiApiKey provider-        initReq = parseRequest_ (T.unpack url)-        req =-          setRequestMethod "POST" $-            setRequestHeader "Content-Type" ["application/json"] $-              setRequestBodyJSON payload initReq--    eRes <- liftIO $ safeHttpRequest req-    case eRes of-      Left err -> throwError $ llmError err Nothing Nothing-      Right bodyVal -> case parseGeminiResponse bodyVal of-        Left parseErr -> throwError $ llmError (T.pack parseErr) Nothing Nothing-        Right respMsg -> pure respMsg--  stream provider inputMsgs config = do-    let model = geminiModel provider-        requestPayload = geminiRequestPayload inputMsgs-    yield $ LLMStart rId model inputMsgs--    payload <--      either (throwError . llmError') pure $ requestPayload config--    let events = geminiEvents payload-    (accumulated, toolCalls, thoughtSignatures', usage) <--      callbackSource events-        .| receiveChunks "" [] [] Nothing--    let message = withThoughtSignatures toolCalls thoughtSignatures' $ assistantMessage accumulated-    yield $ LLMEnd rId message usage-    where-      receiveChunks accumulated toolCalls thoughtSignatures' usage = do-        next <- await-        case next of-          Nothing -> pure (accumulated, toolCalls, thoughtSignatures', usage)-          Just (Left err) -> throwError $ llmError' err-          Just (Right (GeminiStreamEvent GeminiStreamChunk {streamCandidates, streamUsage})) -> do-            let parts = maybe [] streamParts $ candidate0 streamCandidates-                texts = [text | GeminiText text <- parts]-                calls = [(toolCall, signature) | GeminiFunctionCall toolCall signature <- parts]-                nextUsage = streamUsage <|> usage-            emitParts texts (map fst calls)-            receiveChunks-              (accumulated <> mconcat texts)-              (toolCalls <> map fst calls)-              (thoughtSignatures' <> map snd calls)-              nextUsage--      candidate0 = List.find ((== 0) . streamCandidateIndex)--      emitParts texts [] = mapM_ (`yieldChunk` Nothing) texts-      emitParts texts (toolCall : remaining) = do-        yieldChunk (mconcat texts) (Just toolCall)-        mapM_ (yieldChunk "" . Just) remaining--      yieldChunk text mbToolCall = yield $ LLMChunk rId text mbToolCall--      geminiEvents requestPayload emit = do-        result <- try $ do-          manager <- newManager tlsManagerSettings--          let baseUrl = parseBaseUrl (T.unpack $ geminiBaseUrl provider)-              model = geminiModel provider-              apiKey = geminiApiKey provider-              request =-                geminiStreamClient-                  (model <> ":streamGenerateContent")-                  (Just "sse")-                  (Just apiKey)-                  requestPayload--          clientEnv <- mkClientEnv manager <$> baseUrl-          withClientM request clientEnv $-            either-              emitError-              (\source -> runConduit $ source .| C.mapM_ (emit . Right))-        case result of-          Left err-            | Just AsyncCancelled <- fromException err -> throwIO err-            | otherwise -> emitError err-          Right () -> pure ()-        where-          emitError :: Show a => a -> IO ()-          emitError =-            emit . Left . redactKey (geminiApiKey provider) . T.pack . show--      rId = "gemini-stream-run"--llmError' :: Text -> LangchainError-llmError' err = llmError err Nothing Nothing--{- | Replace the literal API key with @[REDACTED]@ in error messages so it-  never appears in 'LangchainError' values or test output.--}-redactKey :: Text -> Text -> Text-redactKey key txt-  | T.null key = txt-  | otherwise = T.replace key "[REDACTED]" txt--data GeminiStreamChunk = GeminiStreamChunk-  { streamCandidates :: [GeminiStreamCandidate]-  , streamUsage :: Maybe TokenUsage-  }--instance FromJSON GeminiStreamChunk where-  parseJSON = withObject "GeminiStreamChunk" $ \obj ->-    GeminiStreamChunk-      <$> obj .:? "candidates" .!= []-      <*> (obj .:? "usageMetadata" >>= traverse parseGeminiUsage)--data GeminiStreamCandidate = GeminiStreamCandidate-  { streamCandidateIndex :: Int-  , streamParts :: [GeminiPart]-  }--instance FromJSON GeminiStreamCandidate where-  parseJSON = withObject "GeminiStreamCandidate" $ \obj -> do-    streamCandidateIndex <- obj .:? "index" .!= 0-    content <- obj .:? "content"-    streamParts <- case content of-      Nothing -> pure []-      Just contentValue -> withObject "GeminiStreamContent" parseParts contentValue-    pure GeminiStreamCandidate {streamCandidateIndex, streamParts}-    where-      parseParts contentObj = do-        parts <- contentObj .:? "parts" .!= []-        traverse parseGeminiPart parts--data GeminiPart-  = GeminiText Text-  | GeminiFunctionCall ToolCall (Maybe Text)--parseGeminiPart :: Value -> Parser GeminiPart-parseGeminiPart = withObject "GeminiPart" $ \obj -> do-  functionCall <- obj .:? "functionCall"-  case functionCall of-    Just value -> GeminiFunctionCall <$> parseGeminiFunctionCall value <*> pure (parseThoughtSignature obj)-    Nothing -> GeminiText <$> obj .:? "text" .!= ""--parseGeminiFunctionCall :: Value -> Parser ToolCall-parseGeminiFunctionCall = withObject "GeminiFunctionCall" $ \obj ->-  ToolCall-    <$> obj .:? "id" .!= ""-    <*> pure "function"-    <*> obj .: "name"-    <*> obj .:? "args" .!= object []--parseThoughtSignature :: Object -> Maybe Text-parseThoughtSignature obj =-  case KeyMap.lookup "thoughtSignature" obj of-    Just (String signature) -> Just signature-    _ -> Nothing--parseGeminiUsage :: Value -> Parser TokenUsage-parseGeminiUsage = withObject "GeminiUsageMetadata" $ \obj ->-  TokenUsage-    <$> obj .:? "promptTokenCount" .!= 0-    <*> obj .:? "candidatesTokenCount" .!= 0-    <*> obj .:? "totalTokenCount" .!= 0--newtype GeminiStreamEvent = GeminiStreamEvent GeminiStreamChunk--instance FromServerEvent GeminiStreamEvent where-  fromServerEvent event = GeminiStreamEvent <$> jsonData event--type GeminiStreamApi =-  "v1beta"-    :> "models"-    :> Capture "modelAction" Text-    :> QueryParam "alt" Text-    :> QueryParam "key" Text-    :> ReqBody '[JSON] Value-    :> PostServerSentEvents (ConduitT () GeminiStreamEvent IO ())--geminiStreamClient ::-  Text -> Maybe Text -> Maybe Text -> Value -> ClientM (ConduitT () GeminiStreamEvent IO ())-geminiStreamClient = client (Proxy.Proxy :: Proxy.Proxy GeminiStreamApi)---- Helper for HTTP requests-safeHttpRequest :: Request -> IO (Either Text Value)-safeHttpRequest req = do-  eRes <--    try (httpJSONEither req) :: IO (Either SomeException (Response (Either JSONException Value)))-  case eRes of-    Left ex -> pure $ Left (T.pack $ show ex)-    Right res -> case getResponseBody res of-      Left err -> pure $ Left (T.pack $ show err)-      Right val -> pure $ Right val---- Parse Gemini response JSON-parseGeminiResponse :: Value -> Either String Message-parseGeminiResponse = parseEither $ withObject "GeminiResponse" $ \o -> do-  -- Surface API-level errors (e.g. safety blocks, quota exhausted) verbatim-  case KeyMap.lookup "error" o of-    Just (Object errObj) -> do-      msg <- errObj .: "message" <|> pure "Unknown Gemini API error"-      fail (T.unpack msg)-    _ -> pure ()-  candidates <- o .: "candidates"-  case candidates of-    [] -> fail "Empty candidates array in Gemini response"-    (c : _) ->-      flip (withObject "Candidate") c $ \cand -> do-        -- "content" is absent when finishReason is SAFETY or MAX_TOKENS with no output-        mContentObj <- cand .:? "content"-        case mContentObj of-          Nothing -> pure $ assistantMessage ""-          Just contentObj -> do-            parts <- contentObj .: "parts"-            parsedParts <- traverse parseGeminiPart parts-            let texts = [text | GeminiText text <- parsedParts]-                toolCalls = [toolCall | GeminiFunctionCall toolCall _ <- parsedParts]-                signatures = [signature | GeminiFunctionCall _ signature <- parsedParts]-            pure $-              withThoughtSignatures toolCalls signatures $-                assistantMessage $-                  T.intercalate "\n" texts---- | Bind tools to a Gemini model by adding function declarations to the config.-instance ToolBinder Gemini m where-  bindToolsConfig tools config =-    case tools of-      [] -> config-      _ ->-        let generated =-              KeyMap.singleton-                "tools"-                ( toJSON-                    [ object ["functionDeclarations" .= map functionDeclaration tools]-                    ]-                )-         in Just $ case config of-              Nothing -> Object generated-              Just (Object existing) -> Object (KeyMap.union generated existing)-              Just other -> other-    where-      functionDeclaration tool =-        object-          [ "name" .= CoreTool.toolName tool-          , "description" .= CoreTool.toolDescription tool-          , "parameters" .= CoreTool.toolSchema tool-          ]

@@ -1,396 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module      : Langchain.Provider.Ollama-Description : Ollama provider implementing the effect-polymorphic ChatModel typeclass-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Ollama provider using 'ollama-haskell' 0.4.0.0. Supports native structured outputs-via JSON Schema grammar sampling, streaming, tool calling, and embeddings.--== Request & Precedence Semantics-Because Ollama's 'ModelConfig' is 'OllamaChat.ChatRequest', which contains both-'chatModel' and 'chatMessages', callers may supply messages and model names either-via the 'ChatModel' interface ('invoke' / 'stream' arguments) or within the 'ChatRequest'.--The provider resolves these with well-defined precedence rules:--1. __Messages Precedence__:-   * When @inputMsgs@ is non-empty (@not (null inputMsgs)@), it takes precedence over-     'ChatRequest.chatMessages'. This enables reusing request templates across multiple calls-     and ensures 'batch' processes each item's messages properly.-   * When @inputMsgs@ is empty (@null inputMsgs@), the provider falls back to-     'ChatRequest.chatMessages' if a 'ChatRequest' is provided.-   * If both are empty, defaults to an empty user message.--2. __Model Name Precedence__:-   * When a 'ChatRequest' is provided with a non-empty 'chatModel', it overrides-     the provider's default 'ollamaModelName'.-   * Otherwise, the provider's 'ollamaModelName' is used as the default.--}-module Langchain.Provider.Ollama-  ( Ollama (..)-  , newOllama-  , newOllamaWithClient-  , toOllamaRole-  , fromOllamaRole-  , toOllamaMessage-  , fromOllamaMessage-  , withJsonFormat-  , withSchemaFormat-  , withStructuredOutput-  , withOptions-  , chatRequestFor-  , resolveChatRequest-  , withTools-  , toOllamaTool-  , toOllamaTools-  , OllamaWithTools (..)-  , bindTools--    -- * Re-exports from ollama-haskell format, schema, options & client config-  , module Ollama.API.Chat-  , module Ollama.Client.Config-  , module Ollama.Types.Common-  , module Ollama.Types.Options-  , OFormat.Format (..)-  , OSB.Schema (..)-  , OSB.Property (..)-  , OSB.JsonType (..)-  , OSD.ToSchema (..)-  , OSD.ToJsonType (..)-  ) where--import Control.Monad (when)-import Control.Monad.Except (throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (Result (..), decode, fromJSON, toJSON)-import qualified Data.Aeson as Aeson-import qualified Data.ByteString.Lazy.Char8 as LBSC-import Data.Conduit (await, transPipe, yield, (.|))-import qualified Data.List.NonEmpty as NonEmpty-import Data.Maybe (fromMaybe, isJust, mapMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE--import Langchain.Core.Error (llmError)-import Langchain.Core.Model-import Langchain.Core.Stream (StreamEvent (..), TokenUsage (..))-import Langchain.Core.Tool (Tool, toolToValue)-import Langchain.Tool.Binding (ToolBinder (..))--import Ollama.API.Chat-import qualified Ollama.API.Chat as OllamaChat-import Ollama.Client (OllamaClient, newClient)-import Ollama.Client.Config-import Ollama.Types.Common (Base64Image (..), ModelName (..))-import qualified Ollama.Types.Format as OFormat-import qualified Ollama.Types.Format.SchemaBuilder as OSB-import qualified Ollama.Types.Format.SchemaDerive as OSD-import qualified Ollama.Types.Message as O-import Ollama.Types.Options (ModelOptions (..), defaultOptions)-import qualified Ollama.Types.Tool as OTool---- | Ollama provider data type wrapping OllamaClient and model name-data Ollama = Ollama-  { client :: OllamaClient-  , ollamaModelName :: Text-  }--instance Show Ollama where-  show (Ollama _ m) = "Ollama provider (" ++ show m ++ ")"---- | Create a new Ollama provider with model name and client config-newOllama :: MonadIO m => Text -> OllamaClientConfig -> m Ollama-newOllama model cfg = do-  c <- liftIO $ newClient cfg-  pure $ Ollama c model---- | Create an Ollama provider using an existing OllamaClient handle-newOllamaWithClient :: Text -> OllamaClient -> Ollama-newOllamaWithClient model c = Ollama c model---- | Helper to convert core Role to Ollama Role-toOllamaRole :: Role -> O.Role-toOllamaRole System = O.System-toOllamaRole User = O.User-toOllamaRole Assistant = O.Assistant-toOllamaRole Tool = O.Tool-toOllamaRole Developer = O.System-toOllamaRole Function = O.Tool---- | Helper to convert Ollama Role to core Role-fromOllamaRole :: O.Role -> Role-fromOllamaRole O.System = System-fromOllamaRole O.User = User-fromOllamaRole O.Assistant = Assistant-fromOllamaRole O.Tool = Tool---- | Convert core Message to Ollama Message-toOllamaMessage :: Message -> O.Message-toOllamaMessage msg =-  let r = toOllamaRole (messageRole msg)-      txt = extractMessageText msg-      imgs = case [ b64-                  | ImageBlock ImageContent {imageSource = ImageBase64 _ b64} <- NonEmpty.toList (messageContents msg)-                  ] of-        [] -> Nothing-        xs -> Just (map Base64Image xs)-      tools = case messageToolCalls msg of-        Nothing -> Nothing-        Just tcs ->-          Just-            [ OTool.ToolCall-                { OTool.tcFunction =-                    OTool.ToolCallFunction-                      { OTool.tcfName = toolCallName tc-                      , OTool.tcfArguments = parseArgs (toolCallArguments tc)-                      }-                }-            | tc <- tcs-            ]-      parseArgs v = case v of-        Aeson.Object _ -> case fromJSON v of-          Success m -> m-          _ -> mempty-        Aeson.String s -> fromMaybe mempty $ decode (LBSC.fromStrict (TE.encodeUtf8 s))-        _ -> case fromJSON v of-          Success m -> m-          _ -> mempty-   in O.Message r txt imgs tools (messageName msg) Nothing---- | Convert Ollama Message to core Message-fromOllamaMessage :: O.Message -> Message-fromOllamaMessage (O.Message r txt _imgs tools name _think) =-  let cRole = fromOllamaRole r-      cMsg = (textMessage cRole txt) {messageName = name}-      cTools = case tools of-        Nothing -> Nothing-        Just tcs ->-          Just-            [ ToolCall-                { toolCallId = ""-                , toolCallType = "function"-                , toolCallName = OTool.tcfName (OTool.tcFunction tc)-                , toolCallArguments = toJSON (OTool.tcfArguments (OTool.tcFunction tc))-                }-            | tc <- tcs-            ]-   in cMsg {messageToolCalls = cTools}--{- | Construct a 'ChatRequest' for an 'Ollama' instance with the given messages.--Sets 'chatModel' to the provider's 'ollamaModelName'. When passed to 'invoke'-or 'stream', any non-empty message argument passed directly to 'invoke' or-'stream' will take priority over the messages in this 'ChatRequest'.--}-chatRequestFor :: Ollama -> [Message] -> OllamaChat.ChatRequest-chatRequestFor model inputMsgs =-  let oMsgs = case inputMsgs of-        [] -> O.userMessage "" NonEmpty.:| []-        (m : ms) -> NonEmpty.map toOllamaMessage (m NonEmpty.:| ms)-   in OllamaChat.chatRequest (ModelName (ollamaModelName model)) oMsgs--{- | Resolve the effective 'ChatRequest', effective model name, and effective messages-given the provider instance, explicit message arguments, and optional 'ChatRequest'.--= Precedence Rules--* __Messages Precedence__:-  1. If @inputMsgs@ is non-empty (@not (null inputMsgs)@), it takes priority and-     is used as the request conversation. This enables reusing a configured-     'ChatRequest' (tools, formats, options) across invocations and guarantees-     that 'batch' processes each item's messages properly.-  2. If @inputMsgs@ is empty (@null inputMsgs@) and a 'ChatRequest' is provided,-     its 'chatMessages' field is preserved and used.-  3. If both are empty (or @inputMsgs@ is empty and 'mbReq' is 'Nothing'),-     it defaults to a single empty user message.--* __Model Name Precedence__:-  1. If a 'ChatRequest' is provided and its 'chatModel' is non-empty,-     it overrides the provider's default 'ollamaModelName'.-  2. Otherwise, the provider's 'ollamaModelName' is used as the default.--}-resolveChatRequest ::-  Ollama ->-  [Message] ->-  Maybe OllamaChat.ChatRequest ->-  (OllamaChat.ChatRequest, Text, [Message])-resolveChatRequest model inputMsgs mbReq =-  let providerModel = ollamaModelName model-      resolvedModelText = case mbReq of-        Just r ->-          let m = unModelName (OllamaChat.chatModel r)-           in if T.null m then providerModel else m-        Nothing -> providerModel-      resolvedModelName = ModelName resolvedModelText--      (resolvedOMsgs, resolvedCoreMsgs) = case inputMsgs of-        (m : ms) ->-          let oList = NonEmpty.map toOllamaMessage (m NonEmpty.:| ms)-           in (oList, inputMsgs)-        [] -> case mbReq of-          Just r ->-            let oList = OllamaChat.chatMessages r-                coreList = map fromOllamaMessage (NonEmpty.toList oList)-             in (oList, coreList)-          Nothing ->-            (O.userMessage "" NonEmpty.:| [], [])--      resolvedReq = case mbReq of-        Nothing ->-          OllamaChat.chatRequest resolvedModelName resolvedOMsgs-        Just r ->-          r-            { OllamaChat.chatModel = resolvedModelName-            , OllamaChat.chatMessages = resolvedOMsgs-            }-   in (resolvedReq, resolvedModelText, resolvedCoreMsgs)--instance ChatModel Ollama where-  type ModelConfig Ollama = OllamaChat.ChatRequest--  invoke model inputMsgs mbReq = do-    let (req, _modelName, _msgs) = resolveChatRequest model inputMsgs mbReq-    eRes <- liftIO $ OllamaChat.chat (client model) req-    case eRes of-      Left err -> throwError $ llmError (T.pack $ show err) Nothing Nothing-      Right resp -> case OllamaChat.crMessage resp of-        Nothing -> throwError $ llmError "No message in response" Nothing Nothing-        Just oMsg -> pure $ fromOllamaMessage oMsg--  stream model inputMsgs mbReq = do-    let runId_ = "ollama-run"-        (req, resolvedModel, resolvedMsgs) = resolveChatRequest model inputMsgs mbReq--    yield $ LLMStart runId_ resolvedModel resolvedMsgs-    transPipe liftIO (OllamaChat.chatStream (client model) req) .| processChunks runId_-    where-      processChunks rId = loop [] Nothing Nothing-        where-          loop accChunks mbLastUsage mbLastTools =-            await >>= \case-              Nothing -> do-                let fullText = T.concat (reverse accChunks)-                    finalMsg =-                      (assistantMessage fullText)-                        { messageToolCalls = mbLastTools-                        }-                yield $ LLMEnd rId finalMsg mbLastUsage-              Just resp -> do-                let mbMsg = OllamaChat.crMessage resp-                    chunkTxt = maybe "" O.messageContent mbMsg-                    mbTools = mbMsg >>= O.messageToolCalls-                    toolCalls = case mbTools of-                      Nothing -> Nothing-                      Just tcs ->-                        Just-                          [ ToolCall-                              { toolCallId = ""-                              , toolCallType = "function"-                              , toolCallName = OTool.tcfName (OTool.tcFunction tc)-                              , toolCallArguments = toJSON (OTool.tcfArguments (OTool.tcFunction tc))-                              }-                          | tc <- tcs-                          ]-                    toolDelta = case toolCalls of-                      Just (tc : _) -> Just tc-                      _ -> Nothing-                    newAccChunks = if T.null chunkTxt then accChunks else chunkTxt : accChunks-                    newTools = case toolCalls of-                      Just tcs -> Just $ maybe tcs (++ tcs) mbLastTools-                      Nothing -> mbLastTools-                    newUsage = case (OllamaChat.crPromptEvalCount resp, OllamaChat.crEvalCount resp) of-                      (Just p, Just c) -> Just $ TokenUsage p c (p + c)-                      _ -> mbLastUsage-                when (not (T.null chunkTxt) || isJust toolDelta) $-                  yield $-                    LLMChunk rId chunkTxt toolDelta-                loop newAccChunks newUsage newTools---- | Set model options on an Ollama ChatRequest-withOptions :: ModelOptions -> OllamaChat.ChatRequest -> OllamaChat.ChatRequest-withOptions opts req = req {OllamaChat.chatOptions = Just opts}---- | Attach Langchain tools to an Ollama ChatRequest-withTools :: [Tool m] -> OllamaChat.ChatRequest -> OllamaChat.ChatRequest-withTools ts req = req {OllamaChat.chatTools = Just (toOllamaTools ts)}---- | Convert a Langchain 'Tool' definition to an Ollama 'OTool.Tool'-toOllamaTool :: Tool m -> Maybe OTool.Tool-toOllamaTool t = case fromJSON (toolToValue t) of-  Success ot -> Just ot-  Aeson.Error _ -> Nothing---- | Convert a list of Langchain 'Tool' definitions to Ollama 'OTool.Tool's-toOllamaTools :: [Tool m] -> [OTool.Tool]-toOllamaTools = mapMaybe toOllamaTool---- | Attach generic JSON format constraint to Ollama ChatRequest-withJsonFormat :: OllamaChat.ChatRequest -> OllamaChat.ChatRequest-withJsonFormat req = req {OllamaChat.chatFormat = Just OFormat.JsonFormat}---- | Attach specific Schema format constraint to Ollama ChatRequest-withSchemaFormat :: OSB.Schema -> OllamaChat.ChatRequest -> OllamaChat.ChatRequest-withSchemaFormat schema req = req {OllamaChat.chatFormat = Just (OFormat.SchemaFormat schema)}---- | Attach automatic ToSchema derived format constraint to Ollama ChatRequest-withStructuredOutput ::-  forall a.-  (OSD.ToSchema a) =>-  OllamaChat.ChatRequest ->-  OllamaChat.ChatRequest-withStructuredOutput req =-  req {OllamaChat.chatFormat = Just (OFormat.SchemaFormat (OSD.toSchema @a))}---- | Ollama model with pre-bound tools-data OllamaWithTools m = OllamaWithTools-  { ollamaBaseModel :: !Ollama-  , ollamaBoundTools :: ![Tool m]-  }--instance Show (OllamaWithTools m) where-  show (OllamaWithTools m _) = "OllamaWithTools (" ++ show m ++ ")"---- | Bind tools to an Ollama model so any invocation automatically includes tool definitions-bindTools :: [Tool m] -> Ollama -> OllamaWithTools m-bindTools ts model = OllamaWithTools model ts--instance ChatModel (OllamaWithTools m) where-  type ModelConfig (OllamaWithTools m) = OllamaChat.ChatRequest-  invoke (OllamaWithTools model ts) msgs mbReq =-    let req = fromMaybe (chatRequestFor model msgs) mbReq-     in invoke model msgs (Just (withTools ts req))-  stream (OllamaWithTools model ts) msgs mbReq =-    let req = fromMaybe (chatRequestFor model msgs) mbReq-     in stream model msgs (Just (withTools ts req))---- | Bind tools to an Ollama model by creating/merging a ChatRequest with tool definitions-instance ToolBinder Ollama m where-  bindToolsConfig tools mbReq =-    case tools of-      [] -> mbReq-      _ ->-        let baseReq = fromMaybe (OllamaChat.chatRequest (ModelName "") (O.userMessage "" NonEmpty.:| [])) mbReq-         in Just $ withTools tools baseReq---- | OllamaWithTools already has tools bound, but merges additional tools if provided-instance ToolBinder (OllamaWithTools m) n where-  bindToolsConfig tools mbReq =-    case tools of-      [] -> mbReq-      _ ->-        let baseReq = fromMaybe (OllamaChat.chatRequest (ModelName "") (O.userMessage "" NonEmpty.:| [])) mbReq-         in Just $ withTools tools baseReq