langchain-hs 0.0.3.0 → 0.0.5.0

raw patch · 153 files changed

+13083/−9549 lines, 153 filesdep +QuickCheckdep +aeson-qqdep +format-heavydep −base64-bytestringdep −parsecdep −pdf-toolbox-documentdep ~aesondep ~asyncdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, aeson-qq, format-heavy, http-client, http-client-tls, langchain-hs-core, langchain-hs-graph, mtl, process, random, resourcet, scientific, servant, servant-client, servant-client-core, servant-conduit, servant-event-stream, sqlite-simple, stm, tasty-quickcheck, wai, warp

Dependencies removed: base64-bytestring, parsec, pdf-toolbox-document, tagsoup

Dependency ranges changed: aeson, async, base, bytestring, containers, directory, filepath, http-conduit, http-types, ollama-haskell, openai, transformers, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +35/−5
• README.md +248/−65
• langchain-hs.cabal +156/−76
• src/Langchain/Agent/Core.hs +0/−303
• src/Langchain/Agent/Executor.hs +0/−261
• src/Langchain/Agent/Middleware.hs +0/−133
• src/Langchain/Agent/PlanAndExecute.hs +198/−0
• src/Langchain/Agent/ReAct.hs +84/−146
• src/Langchain/Cache/Core.hs +255/−0
• src/Langchain/Callback.hs +0/−87
• src/Langchain/Callback/Manager.hs +100/−0
• src/Langchain/Chain/MapReduce.hs +99/−0
• src/Langchain/Chain/RetrievalQA.hs +47/−51
• src/Langchain/DocumentLoader/Core.hs +23/−113
• src/Langchain/DocumentLoader/Csv.hs +127/−0
• src/Langchain/DocumentLoader/DirectoryLoader.hs +26/−75
• src/Langchain/DocumentLoader/FileLoader.hs +37/−87
• src/Langchain/DocumentLoader/PdfLoader.hs +0/−125
• src/Langchain/Embeddings/Core.hs +23/−85
• src/Langchain/Embeddings/Gemini.hs +0/−67
• src/Langchain/Embeddings/Ollama.hs +45/−89
• src/Langchain/Embeddings/OpenAI.hs +67/−95
• src/Langchain/Error.hs +0/−609
• src/Langchain/Guardrail/Core.hs +143/−0
• src/Langchain/LLM/Core.hs +0/−321
• src/Langchain/LLM/Deepseek.hs +0/−67
• src/Langchain/LLM/Gemini.hs +0/−104
• src/Langchain/LLM/Huggingface.hs +0/−243
• src/Langchain/LLM/Internal/Huggingface.hs +0/−729
• src/Langchain/LLM/Ollama.hs +0/−258
• src/Langchain/LLM/OpenAI.hs +0/−113
• src/Langchain/LLM/OpenAICompatible.hs +0/−403
• src/Langchain/MCP/Client.hs +305/−0
• src/Langchain/Memory/Core.hs +128/−204
• src/Langchain/Memory/Entity.hs +99/−0
• src/Langchain/Memory/Summary.hs +103/−0
• src/Langchain/Memory/TokenBufferMemory.hs +0/−130
• src/Langchain/Observability.hs +275/−0
• src/Langchain/OutputParser/Core.hs +4/−3
• src/Langchain/OutputParser/Structured.hs +348/−0
• src/Langchain/Prelude.hs +439/−0
• src/Langchain/PromptTemplate.hs +0/−167
• src/Langchain/PromptTemplate/Chat.hs +25/−0
• src/Langchain/PromptTemplate/Chat/ChatPromptTemplate.hs +451/−0
• src/Langchain/PromptTemplate/Chat/MessagesPlaceholder.hs +98/−0
• src/Langchain/PromptTemplate/FewShot.hs +47/−0
• src/Langchain/PromptTemplate/Prompt.hs +104/−0
• src/Langchain/PromptTemplate/String.hs +104/−0
• src/Langchain/Provider/Gemini.hs +483/−0
• src/Langchain/Provider/Ollama.hs +396/−0
• src/Langchain/Provider/OpenAI.hs +608/−0
• src/Langchain/Resilience/CircuitBreaker.hs +119/−0
• src/Langchain/Resilience/Retry.hs +114/−0
• src/Langchain/Retriever/BM25.hs +151/−0
• src/Langchain/Retriever/Core.hs +40/−106
• src/Langchain/Retriever/Hybrid.hs +155/−0
• src/Langchain/Retriever/MultiQueryRetriever.hs +0/−288
• src/Langchain/Runnable/Chain.hs +0/−267
• src/Langchain/Runnable/ConversationChain.hs +0/−161
• src/Langchain/Runnable/Core.hs +0/−117
• src/Langchain/Runnable/Utils.hs +0/−247
• src/Langchain/TextSplitter/Code.hs +167/−0
• src/Langchain/TextSplitter/Markdown.hs +137/−0
• src/Langchain/TextSplitter/RecursiveCharacter.hs +96/−0
• src/Langchain/TextSplitter/Token.hs +90/−0
• src/Langchain/Tool/Async.hs +70/−0
• src/Langchain/Tool/Binding.hs +49/−0
• src/Langchain/Tool/Calculator.hs +51/−133
• src/Langchain/Tool/Core.hs +8/−88
• src/Langchain/Tool/DuckDuckGo.hs +0/−266
• src/Langchain/Tool/FileSystem.hs +107/−0
• src/Langchain/Tool/GenericSchema.hs +175/−0
• src/Langchain/Tool/Shell.hs +71/−0
• src/Langchain/Tool/Utils.hs +0/−99
• src/Langchain/Tool/WebScraper.hs +0/−92
• src/Langchain/Tool/WikipediaTool.hs +0/−300
• src/Langchain/Utils.hs +0/−27
• src/Langchain/VectorStore/Core.hs +40/−107
• src/Langchain/VectorStore/InMemory.hs +43/−141
• src/Langchain/VectorStore/SqliteVec.hs +147/−0
• test/Spec.hs +135/−31
• test/Test/Langchain/Agent/AdvancedAgentsSpec.hs +37/−0
• test/Test/Langchain/Agent/ReAct.hs +151/−191
• test/Test/Langchain/Cache/CacheSpec.hs +188/−0
• test/Test/Langchain/Callback/CallbackManagerSpec.hs +27/−0
• test/Test/Langchain/Chain/ChainsSpec.hs +27/−0
• test/Test/Langchain/Chain/RetrievalQASpec.hs +38/−0
• test/Test/Langchain/DocumentLoader/Core.hs +10/−11
• test/Test/Langchain/DocumentLoader/CsvSpec.hs +35/−0
• test/Test/Langchain/DocumentLoader/DirectoryLoader.hs +33/−87
• test/Test/Langchain/Embeddings/Core.hs +0/−29
• test/Test/Langchain/Error.hs +65/−0
• test/Test/Langchain/Graph/CompilationSpec.hs +74/−0
• test/Test/Langchain/Guardrail/GuardrailSpec.hs +39/−0
• test/Test/Langchain/Integration/FullRagE2ESpec.hs +65/−0
• test/Test/Langchain/Integration/OllamaChatSpec.hs +46/−0
• test/Test/Langchain/Integration/OllamaEmbeddingSpec.hs +40/−0
• test/Test/Langchain/Integration/OllamaStreamSpec.hs +49/−0
• test/Test/Langchain/Integration/OllamaToolSpec.hs +92/−0
• test/Test/Langchain/Integration/ReActAgentE2ESpec.hs +42/−0
• test/Test/Langchain/Integration/StateGraphE2ESpec.hs +79/−0
• test/Test/Langchain/Integration/StreamingCachingRetryE2ESpec.hs +49/−0
• test/Test/Langchain/LLM/Core.hs +0/−176
• test/Test/Langchain/LLM/Ollama.hs +0/−202
• test/Test/Langchain/MCP/McpSpec.hs +36/−0
• test/Test/Langchain/Memory/Core.hs +87/−164
• test/Test/Langchain/Memory/EntitySpec.hs +33/−0
• test/Test/Langchain/Memory/SummarySpec.hs +37/−0
• test/Test/Langchain/Memory/TokenBufferMemory.hs +52/−115
• test/Test/Langchain/ObservabilitySpec.hs +80/−0
• test/Test/Langchain/OutputParser/AdvancedParsersSpec.hs +88/−0
• test/Test/Langchain/OutputParser/Core.hs +1/−1
• test/Test/Langchain/PromptTemplate.hs +0/−94
• test/Test/Langchain/PromptTemplate/Chat/ChatPromptTemplateSpec.hs +661/−0
• test/Test/Langchain/PromptTemplate/Chat/MessagesPlaceholderSpec.hs +84/−0
• test/Test/Langchain/PromptTemplate/FewShotSpec.hs +62/−0
• test/Test/Langchain/PromptTemplate/PromptSpec.hs +59/−0
• test/Test/Langchain/Property/CheckpointerSpec.hs +56/−0
• test/Test/Langchain/Property/ErrorSpec.hs +48/−0
• test/Test/Langchain/Property/MessageSpec.hs +72/−0
• test/Test/Langchain/Property/PromptTemplateSpec.hs +74/−0
• test/Test/Langchain/Property/RunnableSpec.hs +80/−0
• test/Test/Langchain/Property/TextSplitterSpec.hs +50/−0
• test/Test/Langchain/Provider/FixturesSpec.hs +60/−0
• test/Test/Langchain/Provider/Gemini.hs +676/−0
• test/Test/Langchain/Provider/Mock.hs +65/−0
• test/Test/Langchain/Provider/Ollama.hs +165/−0
• test/Test/Langchain/Provider/OllamaConversionSpec.hs +75/−0
• test/Test/Langchain/Provider/OpenAI.hs +414/−0
• test/Test/Langchain/Provider/TestSseServer.hs +85/−0
• test/Test/Langchain/RegressionSpec.hs +74/−0
• test/Test/Langchain/Resilience/CircuitBreakerSpec.hs +40/−0
• test/Test/Langchain/Resilience/RetrySpec.hs +35/−0
• test/Test/Langchain/Retriever/BM25Spec.hs +69/−0
• test/Test/Langchain/Retriever/Core.hs +11/−69
• test/Test/Langchain/Retriever/HybridSpec.hs +40/−0
• test/Test/Langchain/Runnable/Chains.hs +0/−98
• test/Test/Langchain/Runnable/ConversationChains.hs +0/−117
• test/Test/Langchain/Runnable/Core.hs +0/−64
• test/Test/Langchain/Runnable/Utils.hs +0/−109
• test/Test/Langchain/TestHelpers.hs +225/−0
• test/Test/Langchain/TextSplitter/Character.hs +25/−69
• test/Test/Langchain/TextSplitter/CodeSpec.hs +32/−0
• test/Test/Langchain/TextSplitter/MarkdownSpec.hs +44/−0
• test/Test/Langchain/TextSplitter/RecursiveCharacterSpec.hs +161/−0
• test/Test/Langchain/TextSplitter/TokenSpec.hs +28/−0
• test/Test/Langchain/Tool/AdvancedToolsSpec.hs +55/−0
• test/Test/Langchain/Tool/Calculator.hs +22/−0
• test/Test/Langchain/Tool/Core.hs +0/−224
• test/Test/Langchain/Tool/FileSystem.hs +36/−0
• test/Test/Langchain/Tool/Shell.hs +27/−0
• test/Test/Langchain/VectorStore/Core.hs +23/−45
• test/Test/Langchain/VectorStore/SqliteVecSpec.hs +55/−0

@@ -1,12 +1,42 @@ # Changelog for `langchain-hs` -All notable changes to this project will be documented in this file.+## 0.0.5.0 - 2026-09-10 -The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),-and this project adheres to the-[Haskell Package Versioning Policy](https://pvp.haskell.org/).+### Major Architecture & Ecosystem Evolution -## Unreleased+- **3-Tier Monorepo Architecture**:+  - `langchain-hs-core` (0.0.5.0): Zero-dependency pure core with `RunnableTree`, `ChatModel`, `ContentBlock`, `Tool`, `StreamEvent`, and `LangchainT`.+  - `langchain-hs-graph` (0.0.5.0): Graph-based state machine engine with `StateGraph`, `StateReducer`, checkpointers, HITL, and multi-agent coordination.+  - `langchain-hs` (0.0.5.0): Production integrations for Ollama, OpenAI, Gemini, Vector Stores, MCP, and Observability.+- **Pure AST Pipelines (`RunnableTree`)**:+  - The core selling point: Every component implements the `Runnable` typeclass.+  - Compose pure GADT abstract syntax trees using `|>>` (sequential composition), `&>&` (parallel fan-out), and `>>>#` (fallback failover) without side effects before interpretation.+- **LangGraph in Haskell (`StateGraph`)**:+  - Cyclic state machines with pure state reducers (`StateReducer s`) satisfying monoid associativity laws.+  - Thread-safe STM in-memory checkpointer (`MemoryCheckpointer`) and persistent `SQLiteCheckpointer`.+  - First-class Human-in-the-Loop (`HITL`) node interruption, inspect/edit state, and resumption via `resumeGraph`.+  - Time-travel state replay and Graphviz DOT visualization export.+- **Model Context Protocol (MCP)**:+  - Native stdio and HTTP JSON-RPC 2.0 client implementation.+  - Dynamic tool inspection and bidirectional schema mapping to Haskell `Tool` definitions.+- **Decoupled Monad Transformer (`LangchainT env m a`)**:+  - Removed redundant global config structs in favor of parameterization over custom user environment `env`.+  - Complete `MonadReader`, `MonadError`, `MonadIO`, and `MonadTrans` instances.+  - OpenTelemetry distributed tracing spans (`withSpan`) and structured JSON telemetry.+  - Three-state Circuit Breaker, exponential backoff retries with randomized jitter, and in-memory caching.+- **Dependency & Performance Upgrades**:+  - Upgraded to `ollama-haskell` `0.4.1.0` with JSON schema grammar constraints.+  - Migrated to `MercuryTechnologies/openai` client.+  - Full PVP upper bounds across all packages for Hackage compliance.++### ⚠️ 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).+  - The `MonadReader env (LangchainT env m)` instance gives you `ask`/`asks` to read your environment from within the monad.+- **`ChatMessage` renamed to `Message`** throughout — update all pattern matches and constructor calls.+- **Agent modules restructured** — `Langchain.Agent` is now split into `Langchain.Agent.ReAct` and `Langchain.Agent.PlanAndExecute` with updated type signatures for tool-call support.+- **Removed `HtmlLoader`, `JsonLoader`, and `WebPageLoader` from `Langchain.DocumentLoader`** — Along with the `tagsoup` dependency. Users can write custom document loaders tailored to their schemas and formats.  ## 0.0.3.0 - 2025-11-16 

@@ -1,96 +1,279 @@-# 🦜️🔗LangChain Haskell+# 🦜️🔗 LangChain Haskell (`langchain-hs`) -⚡ Building applications with LLMs through composability in Haskell! ⚡+> **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.* -<div style="text-align: center;">-<img src="./docs/static/img/langchain_haskell.jpg" alt="logo image" height="300"/>-</div>+--- -## Introduction+[![Hackage](https://img.shields.io/badge/hackage-0.0.5.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) -LangChain Haskell is a robust port of the original [LangChain](https://github.com/langchain-ai/langchain) library, bringing its powerful natural language processing capabilities to the Haskell ecosystem. This library enables developers to build applications powered by large language models (LLMs) with ease and flexibility.+--- -### [Documentation](https://tusharad.github.io/langchain-hs/docs/)-### [Hackage API reference](https://hackage.haskell.org/package/langchain-hs)+## 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: -## Features+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. -- **LLM Integration**: Seamlessly interact with various language models, including OpenAI's GPT series and others.-- **Prompt Templates**: Create and manage dynamic prompts for different tasks.-- **Memory Management**: Implement conversational memory to maintain context across interactions.-- **Agents and Tools**: Develop agents that can utilize tools to perform complex tasks.-- **Document Loaders**: Load and process documents from various sources for use in your applications.-- **Text Splitter**: Components for splitting text into smaller chunks for processing.-- **Output Parser**: Components for parsing and processing the output of LLMs.-- **VectorStore and Retriever**: Mechanism for storing and retrieving document embeddings.-   * Includes support for Faiss, a library for efficient similarity search. This integration is available through the separate [`faiss-hs`](https://github.com/tusharad/faiss-hs) repository.-- **Embeddings**: Components for generating vector representations of text.+--- -## Current Supported Providers -  - Ollama-  - OpenAI-  - Huggingface-  - OpenAI compatible APIs (LMStudio, OpenRouter, Llama-cpp, Deepseek)-  - More to come...+### Monorepo Packages -## Installation+| 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. | -To use LangChain Haskell in your project, add it to your package dependencies. -If you're using Stack, include it in your `package.yaml`:+--- -```yaml-dependencies:-  - base < 5-  - langchain-hs+## 20 Core Components & Verified Targets++| # | 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) |++---++## Code Showcases++### 1. The Power of Runnables: Pure AST Composition++Compose complex multi-stage pipelines using typed operators without executing any `IO` until interpretation:++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main where++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++main :: IO ()+main = do+  output <- interpret pipeline "Explain Monads in Haskell"+  print output ```-Then, run the build command for your respective build tool to fetch and compile the dependency. -## Quickstart+--- -Here's a simple example demonstrating how to use LangChain Haskell to interact with an LLM:+### 2. Dual-Provider Chat Comparison: Ollama vs OpenAI +#### Ollama (Local & Offline) ```haskell {-# LANGUAGE OverloadedStrings #-}-module Main (main) where+import Control.Monad.Except (runExceptT)+import qualified Data.Text.IO as T+import Langchain.Prelude -import Langchain.LLM.Ollama-import Langchain.LLM.Core-import Langchain.PromptTemplate-import Langchain.Callback-import qualified Data.Map.Strict as Map-import qualified Data.Text as T+main :: IO ()+main = do+  -- Connect to local Ollama instance (DeepSeek, Llama 3, Gemma)+  model <- newOllama "gemma3" 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 simpleollama` +#### OpenAI / OpenRouter (Cloud)+```haskell+{-# LANGUAGE OverloadedStrings #-}+import Control.Monad.Except (runExceptT)+import qualified Data.Text.IO as T+import Langchain.Prelude+import OpenAI.Common (defaultModelName, getOpenRouterModel)+ main :: IO ()-main = do -  let ollamaLLM = Ollama "llama3.2" [stdOutCallback]-      prompt = PromptTemplate "Translate the following English text to French: {text}"-      input = Map.fromList [("text", "Hello, how are you?")]-      -  case renderPrompt prompt input of-    Left e -> putStrLn $ "Error: " ++ e-    Right renderedPrompt -> do-      eRes <- generate ollamaLLM renderedPrompt Nothing-      case eRes of-        Left err -> putStrLn $ "Error: " ++ err-        Right response -> putStrLn $ "Translation: " ++ (T.unpack response)+main = do+  -- Connect to OpenAI or OpenRouter using environment API key+  model <- getOpenRouterModel defaultModelName+  +  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` -## Projects using langchain-hs+--- -- [ai-chatbot-hs](https://github.com/tusharad/ai-chatbot-hs)+### 3. Stateful Graphs (`StateGraph`): Cyclic Multi-Agent Workflow -## Contributing+```haskell+{-# LANGUAGE OverloadedStrings #-}+import Langchain.Graph.StateGraph+import Langchain.Prelude -Contributions are welcome! If you'd like to contribute, please fork the repository and submit a pull request. -For major changes, please open an issue first to discuss what you'd like to change.+-- Pure state with a list-append reducer+data AgentState = AgentState { messages :: [Message], loopCount :: Int } -## License+-- 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 -This project is licensed under the MIT License. See the [LICENSE](LICENSE) file for details.+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+```+*Run:* `stack run stategraphollama` or `stack run stategraphopenai` -## Acknowledgements+--- -This project is inspired by and builds upon the original [LangChain](https://github.com/langchain-ai/langchain) library and its various ports in other programming languages. -Special thanks to the developers of those projects for their foundational work.+### 4. Model Context Protocol (MCP) Tools Integration++Connect Haskell agents to any external MCP server (e.g., Hackage doc search, SQLite, Filesystem, GitHub) over stdio:++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Langchain.Prelude++main :: IO ()+main = do+  -- Connect to any MCP server via stdio JSON-RPC 2.0+  client <- newStdioMcpClient "docker" ["run", "-i", "--rm", "mcp/hackage-doc"]+  +  -- Discover available tools from server+  mcpTools <- listMcpTools client+  let nativeTools = map mcpToolToLangchainTool mcpTools+  +  -- 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+```+*Run:* `stack run mcpollama` or `stack run mcpopenai`++---++## Installation++### 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+```++### Cabal+```bash+cabal install langchain-hs+```++---++## Development & Quality Commands++The repository enforces strict code quality and formatting via `make`:++```bash+# Build the entire monorepo and all 41 example executables+stack build++# Run unit and property-based test suites+stack test++# Run HLint across all source trees (zero hints policy)+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+```++---++## License++Distributed under the **MIT License**. See [LICENSE](LICENSE) for details.

@@ -1,29 +1,26 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1.+-- 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.3.0-synopsis:       Haskell implementation of Langchain-description:    Build LLM-powered applications in Haskell.-category:       Web, AI+version:        0.0.5.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.+category:       AI homepage:       https://github.com/tusharad/langchain-hs#readme bug-reports:    https://github.com/tusharad/langchain-hs/issues-author:         tushar+author:         Tushar Adhatrao maintainer:     tusharadhatrao@gmail.com-copyright:      2025 tushar+copyright:      2025-2026 Tushar Adhatrao license:        MIT license-file:   LICENSE build-type:     Simple tested-with:-    GHC == 9.10.1+    GHC == 9.12.4+  , GHC == 9.10.3   , GHC == 9.8.4-  , GHC == 9.6.6-  , GHC == 9.4.8-  , GHC == 9.2.8-  , GHC == 9.0.2 extra-source-files:     README.md     CHANGELOG.md@@ -34,49 +31,57 @@  library   exposed-modules:-      Langchain.Agent.Core-      Langchain.Agent.Executor-      Langchain.Agent.Middleware+      Langchain.Agent.PlanAndExecute       Langchain.Agent.ReAct-      Langchain.Callback+      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.DocumentLoader.PdfLoader       Langchain.Embeddings.Core-      Langchain.Embeddings.Gemini       Langchain.Embeddings.Ollama       Langchain.Embeddings.OpenAI-      Langchain.Error-      Langchain.LLM.Core-      Langchain.LLM.Deepseek-      Langchain.LLM.Gemini-      Langchain.LLM.Huggingface-      Langchain.LLM.Internal.Huggingface-      Langchain.LLM.Ollama-      Langchain.LLM.OpenAI-      Langchain.LLM.OpenAICompatible+      Langchain.Guardrail.Core+      Langchain.MCP.Client       Langchain.Memory.Core-      Langchain.Memory.TokenBufferMemory+      Langchain.Memory.Entity+      Langchain.Memory.Summary+      Langchain.Observability       Langchain.OutputParser.Core-      Langchain.PromptTemplate+      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.MultiQueryRetriever-      Langchain.Runnable.Chain-      Langchain.Runnable.ConversationChain-      Langchain.Runnable.Core-      Langchain.Runnable.Utils+      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.DuckDuckGo-      Langchain.Tool.Utils-      Langchain.Tool.WebScraper-      Langchain.Tool.WikipediaTool-      Langchain.Utils+      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:@@ -84,76 +89,151 @@   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 <3-    , base >=4.7 && <5-    , base64-bytestring ==1.2.*-    , bytestring >=0.10+    , 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 <2+    , 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-    , ollama-haskell >=0.2.1-    , openai >=2.2.1-    , parsec <4-    , pdf-toolbox-document ==0.1.4-    , tagsoup <0.15+    , 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-    , vector <0.14+    , transformers >=0.5 && <0.7+    , vector >=0.12 && <0.14   default-language: Haskell2010  test-suite langchain-hs-test   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      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.Embeddings.Core-      Test.Langchain.LLM.Core-      Test.Langchain.LLM.Ollama+      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+      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.Runnable.Chains-      Test.Langchain.Runnable.ConversationChains-      Test.Langchain.Runnable.Core-      Test.Langchain.Runnable.Utils+      Test.Langchain.Retriever.HybridSpec+      Test.Langchain.TestHelpers       Test.Langchain.TextSplitter.Character-      Test.Langchain.Tool.Core+      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.Shell       Test.Langchain.VectorStore.Core+      Test.Langchain.VectorStore.SqliteVecSpec       Paths_langchain_hs   hs-source-dirs:       test   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:-      aeson ==2.*-    , async <3-    , base >=4.7 && <5-    , base64-bytestring ==1.2.*-    , bytestring >=0.10+      QuickCheck+    , aeson+    , aeson-qq+    , async+    , base >=4.17 && <5+    , bytestring     , conduit >=1.2 && <1.4-    , containers >=0.6 && <0.9-    , directory >=1.3.6 && <1.4+    , containers+    , directory     , filepath-    , http-conduit ==2.*-    , http-types >=0.11 && <0.13+    , format-heavy ==0.1.*+    , http-client ==0.7.*+    , http-client-tls >=0.3 && <0.5+    , http-conduit+    , http-types     , langchain-hs-    , ollama-haskell >=0.2.1-    , openai >=2.2.1-    , parsec <4-    , pdf-toolbox-document ==0.1.4-    , tagsoup <0.15+    , 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.*     , tasty     , tasty-hunit+    , tasty-quickcheck     , temporary     , text     , time >=1.9 && <1.15-    , transformers-    , vector <0.14+    , transformers >=0.5 && <0.7+    , vector >=0.12 && <0.14+    , wai+    , warp   default-language: Haskell2010

@@ -1,303 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--{- |-Module      : Langchain.Agent.Core-Description : Core types and abstractions for LangChain agents-Copyright   : (c) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--This module provides the foundational types and typeclasses for building agents-in langchain-hs. An LLM Agent runs tools in a loop to achieve a goal.-An agent runs until a stop condition is met --when the model emits a final output or an iteration limit is reached.--}-module Langchain.Agent.Core-  ( -- * Agent Typeclass-    Agent (..)--    -- * Agent Actions and Results-  , AgentAction (..)-  , AgentFinish (..)-  , AgentStep (..)-  , PlanResult (..)--    -- * Agent State and Configuration-  , AgentState (..)-  , AgentConfig (..)-  , AgentCallbacks (..)-  , defaultAgentConfig-  , defaultAgentCallbacks--    -- * Tool support-  , ToolAcceptingToolCall (..)--    -- * Memory support-  , SomeMemory (..)-  ) where--import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson-import Data.Map.Strict (Map)-import Data.Text (Text)-import Data.Time (UTCTime)-import GHC.Generics (Generic)-import Langchain.Error (LangchainResult)-import Langchain.LLM.Core (ToolCall)-import Langchain.Memory.Core (BaseMemory)-import Langchain.Tool.Core---- | Represents an action (ToolCall) that an agent has decided to take.-data AgentAction = AgentAction-  { actionToolCall :: [ToolCall]-  -- ^ tool call-  , actionLog :: Text-  -- ^ LLM's response while suggesting the tool call-  , actionMetadata :: Map Text Text-  -- ^ Additional metadata about the action-  }-  deriving (Show, Eq)---- | Represents the final result when an agent completes its task.-data AgentFinish = AgentFinish-  { agentOutput :: Text-  -- ^ The final answer or result-  , finishMetadata :: Map Text Text-  -- ^ Additional information about the execution-  , finishLog :: Text-  -- ^ Final thoughts or reasoning-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON)---- | Represents one step in the agent's execution.-data AgentStep = AgentStep-  { stepAction :: AgentAction-  -- ^ The action that was executed-  , stepObservation :: Text-  -- ^ The result/observation from the executed tool call-  , stepTimestamp :: UTCTime-  -- ^ When this step occurred-  }-  deriving (Show, Eq)--{- |-A SomeMemory is a wrapper around any type that implements BaseMemory.--> data MyMemory = MyMemory { ... }-> instance BaseMemory MyMemory where ...->-> let memory = MyMemory { ... }-> let someMemory = SomeMemory memory->-> let msg = defaultMessage { role = System, content = "You are an AI assistant" }-> let someMemory2 = SomeMemory (WindowBufferMemory 5 (NE.fromList [msg]))--}-data SomeMemory where-  SomeMemory ::-    (BaseMemory m) =>-    m ->-    SomeMemory--instance Show SomeMemory where-  show (SomeMemory _) = "SomeMemory { <memory instance> }"--{- | Current state of the agent during execution.--Tracks:-- Memory instance for managing chat history-- Current input being processed-- Number of iterations so far--}-data AgentState = AgentState-  { agentMemory :: SomeMemory-  -- ^ Memory instance for managing chat history with the LLM-  , agentInput :: Text-  -- ^ Current user input/query-  , agentIterations :: Int-  -- ^ Number of iterations so far-  }--instance Show AgentState where-  show (AgentState mem inp iters) =-    "AgentState { agentMemory = "-      ++ show mem-      ++ ", agentInput = "-      ++ show inp-      ++ ", agentIterations = "-      ++ show iters-      ++ " }"--data AgentConfig = AgentConfig-  { maxIterations :: Int-  -- ^ Maximum number of agent steps (default: 15)-  , maxExecutionTime :: Maybe Int-  -- ^ Maximum execution time in seconds (Nothing = no limit)-  , verboseLogging :: Bool-  -- ^ Enable verbose logging (default: False)-  , stateMemory :: Maybe SomeMemory-  {- ^ Configure type of Chat memory you want use.-  ^ (default: windowBufferMessages with 100 window size)-  -}-  }-  deriving (Show)--{- | Callbacks for agent events.-Allows hooking into various points in the agent lifecycle.--}-data AgentCallbacks = AgentCallbacks-  { onAgentStart :: Text -> IO ()-  -- ^ Called when agent starts with the input-  , onAgentAction :: AgentAction -> IO ()-  -- ^ Called before executing an action-  , onAgentObservation :: Text -> IO ()-  -- ^ Called after receiving an observation / result of the tool call-  , onAgentFinish :: AgentFinish -> IO ()-  -- ^ Called when agent completes-  , onAgentStep :: AgentStep -> IO ()-  -- ^ Called after each complete step-  }--{- |-A ToolAcceptingToolCall is a special type of tool that-can be used by an agent to execute a tool call.--It is a wrapper around a tool type whose input is a ToolCall and output is a Text.-It is user's responsibility wrap your existing tool into this type.--Example:--> data AgeFinderTool = AgeFinderTool-> instance Tool AgeFinderTool where->   type Input AgeFinderTool = ToolCall->   type Output AgeFinderTool = Text->   toolName _ = "age_finder"->   toolDescription _ = "Finds the age of a person given their name."->   runTool _ (ToolCall _ _ ToolFunction {..}) = do->     if toolFunctionName == "age_finder"->       then do->         case HM.lookup "name" toolFunctionArguments of->           Nothing -> pure "Unknown"->           Just (String name_) -> pure $ getAge name_->           _ -> pure "Unknown"->       else pure "Unknown"->->   getAge name_ = case name_ of->     "Alice" -> "30"->     "Bob" -> "25"->     _ -> "Unknown"--}-data ToolAcceptingToolCall where-  ToolAcceptingToolCall ::-    ( Tool t-    , Input t ~ ToolCall-    , Output t ~ Text-    ) =>-    t -> ToolAcceptingToolCall--instance Eq ToolAcceptingToolCall where-  (ToolAcceptingToolCall t1) == (ToolAcceptingToolCall t2) = toolName t1 == toolName t2--instance Show ToolAcceptingToolCall where-  show (ToolAcceptingToolCall t) =-    "ToolAcceptingToolCall { name = " ++ show (toolName t) ++ " }"--data PlanResult = Continue AgentAction | Done AgentFinish-  deriving (Eq, Show)--{- | Core Agent typeclass.--An agent is a system that can plan and execute actions to accomplish a task.-Different agent types (ReAct, Plan-and-Execute, etc.) implement this interface.--}-class Agent a where-  {- | Plan the next action or finish.--  Given the current state, decide:-  - What tool call to make next (Left AgentAction), or-  - That the task is complete and return the final result (Right AgentFinish)-  -}-  plan ::-    a ->-    AgentState ->-    IO (LangchainResult PlanResult)--  -- | Get the tools available to this agent.-  getTools :: a -> [ToolAcceptingToolCall]--  -- | Execute a tool.-  executeTool :: a -> ToolCall -> IO (LangchainResult Text)--  {- | Prepare the agent for execution.-  Initialize any necessary state before starting.-  Default implementation does nothing.-  -}-  initialize :: a -> AgentState -> IO (LangchainResult AgentState)-  initialize _ state = pure $ Right state--  {- | Clean up after agent execution.-  Release resources, save state, etc.-  Default implementation does nothing.-  -}-  finalize :: a -> AgentState -> IO ()-  finalize _ _ = pure ()--  -- | MonadIO version of plan-  planM ::-    MonadIO m =>-    a ->-    AgentState ->-    m (LangchainResult PlanResult)-  planM agent state = liftIO $ plan agent state--  -- | MonadIO version of executeTool-  executeToolM :: MonadIO m => a -> ToolCall -> m (LangchainResult Text)-  executeToolM a i = liftIO $ executeTool a i--  -- | MonadIO version of initialize-  initializeM ::-    MonadIO m =>-    a ->-    AgentState ->-    m (LangchainResult AgentState)-  initializeM agent state = liftIO $ initialize agent state--  -- | MonadIO version of finalize-  finalizeM :: MonadIO m => a -> AgentState -> m ()-  finalizeM agent state = liftIO $ finalize agent state--{- | Default agent configuration.--Sensible defaults:-- 15 max iterations-- No time limit-- No verbose logging-- WindowBufferMemory with window size 100--}-defaultAgentConfig :: AgentConfig-defaultAgentConfig =-  AgentConfig-    { maxIterations = 15-    , maxExecutionTime = Nothing-    , verboseLogging = False-    , stateMemory = Nothing-    }--{- | Default agent callbacks (all no-ops).-Useful as a starting point for custom callbacks.--}-defaultAgentCallbacks :: AgentCallbacks-defaultAgentCallbacks =-  AgentCallbacks-    { onAgentStart = \_ -> pure ()-    , onAgentAction = \_ -> pure ()-    , onAgentObservation = \_ -> pure ()-    , onAgentFinish = \_ -> pure ()-    , onAgentStep = \_ -> pure ()-    }

@@ -1,261 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Agent.Executor-Description : Agent execution loop and orchestration-Copyright   : (c) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--This module provides the execution engine for agents. It orchestrates the-agent planning loop, tool execution, and result collection.--The executor handles:-- The main agent loop (plan -> execute -> observe)-- Error handling and recovery-- Iteration limits and timeouts-- Callbacks and logging-- State management--}-module Langchain.Agent.Executor-  ( -- * Main Execution Functions-    runAgentExecutor--    -- * Result Types-  , AgentExecutionResult (..)-  , ExecutionMetrics (..)--    -- * Utilities-  , createInitialState-  )-where--import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad.Trans.Except-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time (UTCTime, diffUTCTime, getCurrentTime)-import Langchain.Agent.Core-import Langchain.Agent.Middleware-import Langchain.Error-  ( LangchainResult-  , agentError-  )-import Langchain.LLM.Core-import Langchain.Memory.Core--data AgentExecutionResult = AgentExecutionResult-  { executionFinish :: AgentFinish-  -- ^ The final result of the agent execution-  , executionSteps :: [AgentStep]-  -- ^ All tool calls made and their results-  , executionMetrics :: ExecutionMetrics-  -- ^ Performance metrics-  }-  deriving (Show, Eq)--data ExecutionMetrics = ExecutionMetrics-  { metricsIterations :: Int-  -- ^ Number of agent iterations-  , metricsExecutionTime :: Double-  -- ^ Total time in seconds-  , metricsToolCalls :: Int-  -- ^ Number of tool calls made-  , metricsSuccess :: Bool-  -- ^ Whether execution completed successfully-  }-  deriving (Show, Eq)---- | Create the initial state of the agent with default memory.-createInitialState :: Maybe SomeMemory -> Text -> AgentState-createInitialState mbSomeMemory input =-  AgentState-    { agentMemory = fromMaybe (SomeMemory defaultMemory) mbSomeMemory-    , agentInput = input-    , agentIterations = 0-    }-  where-    defaultMemory =-      WindowBufferMemory-        { maxWindowSize = 100-        , windowBufferMessages = initialChatMessage "You are a helpful AI assistant."-        }--{--Returns False if:-- Max iterations reached-- Max execution time exceeded--}-shouldContinue :: AgentConfig -> AgentState -> Double -> Bool-shouldContinue AgentConfig {..} state elapsedSeconds =-  iterationsOk && timeOk-  where-    iterationsOk = agentIterations state < maxIterations-    timeOk = case maxExecutionTime of-      Nothing -> True-      Just maxTime -> elapsedSeconds < fromIntegral maxTime---- | Helper function to add an action to the state's memory-addActionToState :: AgentState -> AgentAction -> IO (LangchainResult AgentState)-addActionToState state action =-  case agentMemory state of-    SomeMemory mem -> do-      eMemWithAction <- addMessage mem (actionToMsg action)-      case eMemWithAction of-        Left err -> pure $ Left err-        Right memWithAction -> pure $ Right $ state {agentMemory = SomeMemory memWithAction}-  where-    actionToMsg act =-      defaultMessage-        { role = Assistant-        , content = actionLog act-        , messageData =-            defaultMessageData-              { toolCalls = Just (actionToolCall act)-              }-        }---- | Helper function to add observations to the state's memory-addObservationsToState :: AgentState -> [Text] -> IO (LangchainResult AgentState)-addObservationsToState state observations =-  case agentMemory state of-    SomeMemory mem -> do-      eMemsWithObs <- sequenceA <$> traverse (addMessage mem . toolResultToMsg) observations-      case eMemsWithObs of-        Left err -> pure $ Left err-        Right mems -> pure $ Right $ state {agentMemory = SomeMemory (last mems)}-  where-    toolResultToMsg res =-      defaultMessage-        { role = Tool-        , content = res-        }--executeAgentLoop ::-  Agent a =>-  a ->-  AgentConfig ->-  AgentCallbacks ->-  [AgentMiddleware a] ->-  AgentState ->-  UTCTime ->-  IO (LangchainResult AgentExecutionResult)-executeAgentLoop agent config callbacks middlewares initialState startTime =-  loop agent initialState []-  where-    loop agent0 state0 steps = runExceptT $ do-      currentTime <- liftIO getCurrentTime-      let elapsedSeconds = realToFrac $ diffUTCTime currentTime startTime-      -- Check termination conditions-      if not (shouldContinue config state0 elapsedSeconds)-        then do-          let err = agentError "Agent execution exceeded limits" Nothing Nothing-          ExceptT . pure $ Left err-        else do-          -- Plan next action-          when (verboseLogging config) $-            liftIO $-              putStrLn $-                "[Agent] Planning iteration " <> show (agentIterations state0)-          (state1, agent1) <--            ExceptT $-              applyMiddlewares beforeModelCall middlewares (state0, agent0)-          plan_ <- ExceptT $ plan agent1 state1-          (state2, agent2) <--            ExceptT $-              applyMiddlewares afterModelCall middlewares (state1, agent1)-          case plan_ of-            (Done finish) -> do-              -- Agent has finished-              let metrics =-                    ExecutionMetrics-                      { metricsIterations = agentIterations state2-                      , metricsExecutionTime = elapsedSeconds-                      , metricsToolCalls = length steps-                      , metricsSuccess = True-                      }-              return $ AgentExecutionResult finish steps metrics-            (Continue action) -> do-              -- add toolCalls in state memory-              state3 <- ExceptT $ addActionToState state2 action-              -- Execute action-              liftIO $ onAgentAction callbacks action-              (state4, agent4) <--                ExceptT $-                  applyMiddlewares beforeToolCall middlewares (state3, agent2)-              when (verboseLogging config) $-                liftIO $-                  putStrLn $-                    "[Agent] Executing: " <> show (actionToolCall action)-              observations <--                ExceptT $-                  sequenceA <$> traverse (executeTool agent4) (actionToolCall action)-              mapM_ (liftIO . onAgentObservation callbacks) observations-              when (verboseLogging config) $-                liftIO $-                  putStrLn $-                    "[Agent] Observation: " <> mconcat (T.unpack <$> observations)-              -- Record step-              timestamp <- liftIO getCurrentTime-              let newSteps = map (\obs -> AgentStep action obs timestamp) observations-              mapM_ (liftIO . onAgentStep callbacks) newSteps-              -- Update state memory with tool results and continue-              state5 <--                ExceptT $-                  addObservationsToState state4 observations-              (state6, agent6) <--                ExceptT $-                  applyMiddlewares afterToolCall middlewares (state5, agent4)-              let newState =-                    state6-                      { agentIterations = agentIterations state6 + 1-                      }-              ExceptT (loop agent6 newState (steps ++ newSteps))--{- |- Runs the agent executor.-- This function initializes the agent, runs the agent loop, and returns the final result.-- Arguments:- - agent: The agent to run- - config: The agent configuration- - callbacks: The agent callbacks- - input: The input to the agent-- Returns:- - The final result of the agent execution- - The execution metrics- - The execution steps--}-runAgentExecutor ::-  Agent a =>-  a ->-  AgentConfig ->-  AgentCallbacks ->-  [AgentMiddleware a] ->-  Text ->-  IO (LangchainResult AgentExecutionResult)-runAgentExecutor agent0 config callbacks middlewares input = do-  startTime <- getCurrentTime-  onAgentStart callbacks input-  runExceptT $ do-    let initialState = createInitialState (stateMemory config) input-    state0 <- ExceptT $ initialize agent0 initialState-    (state1, agent1) <--      ExceptT $-        applyMiddlewares beforeAgent middlewares (state0, agent0)-    result <--      ExceptT $-        executeAgentLoop agent1 config callbacks middlewares state1 startTime-    (state2, agent2) <--      ExceptT $-        applyMiddlewares afterAgent middlewares (state1, agent1)-    liftIO $ finalize agent2 state2-    liftIO $ onAgentFinish callbacks (executionFinish result)-    return result

@@ -1,133 +0,0 @@-{-# LANGUAGE RankNTypes #-}--{- |-Module      : Langchain.Agent.Middleware-Description : Built-in middlewares for LangChain agents-Copyright   : (c) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--This module provides a comprehensive set of built-in middlewares for agents,-similar to Python LangChain's middleware system. Middlewares allow you to hook-into various points in the agent execution lifecycle.--Available middlewares:-- defaultMiddleware: No-op middleware (base implementation)-- humanInLoopMiddleware: Pause for human approval before tool execution-- toolCallLimitMiddleware: Limit the number of tool calls--}-module Langchain.Agent.Middleware-  ( -- * Middleware Type-    AgentMiddleware (..)-  , applyMiddlewares--    -- * Built-in Middlewares-  , defaultMiddleware-  , humanInLoopMiddleware-  , toolCallLimitMiddleware-  ) where--import Control.Monad (foldM)-import Data.IORef (modifyIORef', newIORef, readIORef)-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T-import Langchain.Agent.Core-import Langchain.Error-  ( LangchainResult-  , agentError-  , fromString-  )-import Langchain.LLM.Core (Message (messageData), MessageData (toolCalls))-import Langchain.Memory.Core (BaseMemory (messages))---- | Middleware hooks around agent execution steps.-data Agent a => AgentMiddleware a = AgentMiddleware-  { beforeModelCall :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  , afterModelCall :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  , beforeToolCall :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  , afterToolCall :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  , beforeAgent :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  , afterAgent :: (AgentState, a) -> IO (LangchainResult (AgentState, a))-  }---- | Default middleware that does nothing (no-op).-defaultMiddleware :: Agent a => AgentMiddleware a-defaultMiddleware =-  AgentMiddleware-    { beforeModelCall = pure . Right-    , afterModelCall = pure . Right-    , beforeToolCall = pure . Right-    , afterToolCall = pure . Right-    , beforeAgent = pure . Right-    , afterAgent = pure . Right-    }---- | Sequentially apply a list of middlewares for a given phase.-applyMiddlewares ::-  (AgentMiddleware a -> (AgentState, a) -> IO (LangchainResult (AgentState, a))) ->-  [AgentMiddleware a] ->-  (AgentState, a) ->-  IO (LangchainResult (AgentState, a))-applyMiddlewares f mws st =-  foldM-    ( \acc mw -> case acc of-        Left err -> pure $ Left err-        Right s -> f mw s-    )-    (Right st)-    mws--{- | Human-in-the-loop middleware.-Pauses execution before each tool call and asks for human approval.-This is useful for sensitive operations or debugging.--Example:-> runAgentExecutor agent config callbacks [humanInLoopMiddleware] "input"--}-humanInLoopMiddleware :: Agent a => AgentMiddleware a-humanInLoopMiddleware =-  defaultMiddleware-    { beforeToolCall = \(st, a) -> do-        case agentMemory st of-          SomeMemory mem -> do-            eRes <- messages mem-            case eRes of-              Left err -> pure $ Left err-              Right msgs -> do-                let msg = NE.last msgs-                    toolCallLst = toolCalls $ messageData msg-                putStrLn $ "Approve this tool call? " ++ show toolCallLst-                putStrLn "(y/n): "-                resp <- getLine-                if resp == "y"-                  then pure $ Right (st, a)-                  else pure $ Left $ fromString "Tool call rejected by human"-    }--{- | Tool call limit middleware.-Limits the total number of tool calls during agent execution.-This helps prevent excessive tool usage and control costs.--Example:-> toolCallLimitMiddleware 20  -- Limit to 20 tool calls--}-toolCallLimitMiddleware :: Agent a => Int -> IO (AgentMiddleware a)-toolCallLimitMiddleware maxCalls = do-  counter <- newIORef 0-  pure $-    defaultMiddleware-      { beforeToolCall = \(st, a) -> do-          count <- readIORef counter-          if count >= maxCalls-            then-              pure $-                Left $-                  agentError-                    (T.pack $ "Tool call limit exceeded: " <> show maxCalls)-                    Nothing-                    (Just (T.pack "toolCallLimitMiddleware"))-            else do-              modifyIORef' counter (+ 1)-              pure $ Right (st, a)-      }

@@ -0,0 +1,198 @@+{-# 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,169 +1,107 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  {- | Module      : Langchain.Agent.ReAct-Description : ReAct (Reasoning + Acting) agent implementation-Copyright   : (c) 2025 Tushar Adhatrao+Description : Effect-polymorphic ReAct (Reasoning + Acting) Agent engine+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -This module implements the ReAct (Reasoning + Acting) agent pattern.-ReAct combines reasoning traces and task-specific actions in an interleaved manner.+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-  ( -- * Agent Creation-    ReActAgent (..)+  ( AgentStep (..)+  , ReActAgent (..)   , createReActAgent-  , createReActAgentWithPrompt--    -- * Prompt Templates-  , reActSystemPrompt+  , reactStep+  , runReActAgent   ) where -import Control.Monad.Trans.Except+import Control.Monad (forM)+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO) import Data.List (find)-import qualified Data.Map as Map-import Data.Text (Text)-import qualified Data.Text as T-import Langchain.Agent.Core-import qualified Langchain.Error as Error-import Langchain.LLM.Core-import Langchain.Memory.Core (BaseMemory (..))-import Langchain.Tool.Core -{- | ReAct agent.--Arguments:-- llm: The language model-- llmParams: The language model parameters-- systemPrompt: The system prompt-- maxThinkingSteps: The maximum number of thinking steps before forcing action-- tools: The tools available to the agent.--}-data ReActAgent llm = ReActAgent-  { reactLLM :: llm-  -- ^ The language model for reasoning-  , reactLLMParams :: Maybe (LLMParams llm)-  -- ^ the llm params for language model-  , reactSystemPrompt :: Text-  -- ^ System prompt template-  , reactMaxThinkingSteps :: Int-  -- ^ Maximum consecutive thinking steps before forcing action (default: 3)-  , reactTools :: [ToolAcceptingToolCall]-  }--{- | Create a ReAct agent.+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 (..)) -Arguments:-- llm: The language model-- llmParams: The language model parameters-- tools: The tools available to the agent+-- | Step result of ReAct reasoning iteration+data AgentStep+  = AgentAction Message [ToolCall]+  | AgentFinish Message+  deriving (Eq, Show) -Important:-- It is user's responsibility to wrap the tools into ToolAcceptingToolCall.-- It is user's responsibility to pass tool_calls as part of LLMParams.-- The tool_calls shall be same as the reactTools (ToolAcceptingToolCall) list.--}-createReActAgent ::-  -- | The language model-  llm ->-  -- | The language model parameters-  Maybe (LLMParams llm) ->-  -- | The tools available to the agent-  [ToolAcceptingToolCall] ->-  -- | The ReAct agent-  ReActAgent llm-createReActAgent llm mbLlmParams tools =-  ReActAgent-    { reactLLM = llm-    , reactLLMParams = mbLlmParams-    , reactSystemPrompt = reActSystemPrompt-    , reactMaxThinkingSteps = 3-    , reactTools = tools-    }+-- | Effect-polymorphic ReAct Agent configuration+data ReActAgent model m = ReActAgent+  { agentModel :: model+  , agentTools :: [Tool m]+  , agentMaxIterations :: Int+  } --- | Create a ReAct agent with a custom system prompt.-createReActAgentWithPrompt ::-  -- | The language model-  llm ->-  -- | The language model parameters-  Maybe (LLMParams llm) ->-  -- | The tools available to the agent-  [ToolAcceptingToolCall] ->-  -- | The custom system prompt-  Text ->-  -- | The ReAct agent-  ReActAgent llm-createReActAgentWithPrompt llm mbLlmParams tools prompt =+-- | Construct a ReAct Agent instance+createReActAgent :: model -> [Tool m] -> ReActAgent model m+createReActAgent model tools =   ReActAgent-    { reactLLM = llm-    , reactLLMParams = mbLlmParams-    , reactSystemPrompt = prompt-    , reactMaxThinkingSteps = 3-    , reactTools = tools+    { agentModel = model+    , agentTools = tools+    , agentMaxIterations = 10     } --- | Default system prompt for the ReAct agent.-reActSystemPrompt :: Text-reActSystemPrompt =-  "You are a helpful AI assistant that uses tools to answer user questions."--instance LLM llm => Agent (ReActAgent llm) where-  plan agent state = do-    let llm = reactLLM agent-        mbParams = reactLLMParams agent-    -- Get messages from memory - use case to handle existential type-    case agentMemory state of-      SomeMemory mem -> runExceptT $ do-        msgs <- ExceptT $ messages mem-        respMsg <- ExceptT $ chat llm msgs mbParams-        case toolCalls (messageData respMsg) of-          Nothing -> do-            -- No tool calls requested. Assume content as the final result-            pure $-              Done $-                AgentFinish-                  { agentOutput = content respMsg-                  , finishMetadata = Map.empty -- TODO: Add stuff from state-                  , finishLog = content respMsg-                  }-          Just toolCallList -> do-            pure $-              Continue-                AgentAction-                  { actionToolCall = toolCallList-                  , actionLog = content respMsg-                  , actionMetadata = Map.empty -- TODO: what to add here?-                  }--  getTools = reactTools--  executeTool agent toolCall = do-    let tools = getTools agent-    let inputFunctionName = toolFunctionName (toolCallFunction toolCall)-    case find (\(ToolAcceptingToolCall t) -> toolName t == inputFunctionName) tools of-      Nothing ->-        pure $-          Left $-            Error.fromString $-              "Cannot find tool with name: "-                <> T.unpack inputFunctionName-      Just (ToolAcceptingToolCall selectedTool) -> Right <$> runTool selectedTool toolCall+-- | 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 -  initialize agent state = do-    let sysPrompt = reactSystemPrompt agent-        userInput = agentInput state-        sysMsg = defaultMessage {role = System, content = sysPrompt}-        userMsg = defaultMessage {role = User, content = userInput}-    case agentMemory state of-      SomeMemory mem -> runExceptT $ do-        memWithSys <- ExceptT $ addMessage mem sysMsg-        memWithUser <- ExceptT $ addMessage memWithSys userMsg-        pure-          AgentState-            { agentMemory = SomeMemory memWithUser-            , agentInput = userInput-            , agentIterations = 0-            }+-- | 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)

@@ -0,0 +1,255 @@+{-# 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,87 +0,0 @@-{- |-Module:      Langchain.Callback-Copyright:   (c) 2025 Tushar Adhatrao-License:     MIT-Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability:   experimental--This module provides a callback system for Langchain's language model operations.-Callbacks allow users to perform actions at different stages of an LLM operation,-such as when it starts, completes, or encounters an error. This is useful for-logging, monitoring, or integrating with external systems.--The callback system is inspired by the Langchain Python library's callback-functionality: [Langchain Callbacks](https://python.langchain.com/docs/concepts/callbacks/).--== Examples--See the documentation for 'stdOutCallback' for a basic example, or check the-examples for 'generate', 'chat', and 'stream' in the 'Langchain.LLM.Ollama' module-for practical usage in LLM operations.--}-module Langchain.Callback-  ( -- * Event Types-    Event (..)--    -- * Callback Interface-  , Callback--    -- * Standard Implementations-  , stdOutCallback-  ) where--{- | Represents different events that can occur during a language model operation.-These events can be used to trigger callbacks at various stages.--}-data Event-  = -- | Indicates the start of an LLM operation, such as generating text or chatting.-    LLMStart-  | -- | Indicates the successful completion of an LLM operation.-    LLMEnd-  | -- | Indicates an error occurred during the LLM operation, with the error message.-    LLMError String-  deriving (Show, Eq)--{- | A callback is a function that takes an 'Event' and performs some IO action.-This allows users to react to different stages of LLM operations, such as logging-or updating a UI.--=== Examples--To create a custom callback that logs events to a file:--@-import System.IO-myCallback :: Callback-myCallback event = do-  handle <- openFile "llm_log.txt" AppendMode-  case event of-    LLMStart -> hPutStrLn handle "LLM operation started"-    LLMEnd -> hPutStrLn handle "LLM operation completed"-    LLMError err -> hPutStrLn handle $ "LLM error: " ++ err-  hClose handle-@--}-type Callback = Event -> IO ()--{- | A standard callback that prints event messages to the standard output.-This is useful for simple debugging or monitoring of LLM operations.--=== Examples--Using 'stdOutCallback' in an LLM operation:--@-let callbacks = [stdOutCallback]-result <- generate (Ollama "llama3.2:latest" callbacks) "What is 2+2?" Nothing--- Output will include:--- Model operation started--- Model completed with--- (depending on success or error)-@--}-stdOutCallback :: Callback-stdOutCallback event = case event of-  LLMStart -> putStrLn "Model operation started"-  LLMEnd -> putStrLn "Model completed with"-  LLMError err -> putStrLn $ "Error occurred: " ++ err

@@ -0,0 +1,100 @@+{-# 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

@@ -0,0 +1,99 @@+{-# 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,79 +1,75 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeFamilies #-}  {- | Module      : Langchain.Chain.RetrievalQA-Description : Chain for question-answering against an index.-Copyright   : (c) 2025 Tushar Adhatrao+Description : Effect-polymorphic RetrievalQA chain+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental -Haskell implementation of RetrievalQA.+RetrievalQA chain combining retriever search, context assembly, prompt rendering,+and ChatModel question answering. -} module Langchain.Chain.RetrievalQA   ( RetrievalQA (..)+  , newRetrievalQA   , defaultQAPrompt+  , runRetrievalQA   ) where -import qualified Data.List.NonEmpty as NE+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.LLM.Core-import Langchain.PromptTemplate (PromptTemplate (..), renderPrompt)-import Langchain.Retriever.Core (Retriever (_get_relevant_documents))-import Langchain.Runnable.Core (Runnable (..))+import Langchain.PromptTemplate.Prompt (PromptTemplate, fromTemplate, renderPrompt)+import Langchain.Retriever.Core (Retriever (..)) --- | QA Chain that combines retrieval and LLM response generation.-data RetrievalQA llm retriever = RetrievalQA-  { llm :: llm-  , llmParams :: Maybe (LLMParams llm)+-- | QA Chain configuration combining retrieval and LLM response generation.+data RetrievalQA model retriever = RetrievalQA+  { model :: model   , retriever :: retriever   , prompt :: PromptTemplate   } --- | Creates a default QA prompt with context and question placeholders.+-- | 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 =-  PromptTemplate-    ( "Use the given context to answer the question. "-        <> "If you don't know the answer, say you don't know. "-        <> "Use three sentence maximum and keep the answer concise. "-        <> "Context: {context}"+  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}"     ) --- | Make RetrievalQA an instance of Runnable to allow composition.-instance (LLM llm, Retriever retriever) => Runnable (RetrievalQA llm retriever) where-  type RunnableInput (RetrievalQA llm retriever) = Text-  type RunnableOutput (RetrievalQA llm retriever) = Message--  invoke RetrievalQA {..} question = do-    -- Retrieve relevant documents-    docResult <- _get_relevant_documents retriever question-    case docResult of-      Left err -> return $ Left err-      Right docs -> do-        let context = T.intercalate "\n\n" $ map (\(Document c _) -> TL.toStrict c) docs-        let vars = [("context", context)]--        -- Render prompt with context and question-        renderedPrompt <- case renderPrompt prompt (fromList vars) of-          Left e -> return $ Left e-          Right r -> return $ Right r--        case renderedPrompt of-          Left e -> return $ Left e-          Right finalPrompt -> do-            let chatConvo =-                  NE.fromList-                    [ Message System finalPrompt defaultMessageData-                    , Message User question defaultMessageData-                    ]-            -- Get LLM response-            llmResponse <- chat llm chatConvo llmParams-            case llmResponse of-              Left e -> return $ Left e-              Right answer -> return $ Right answer+-- | 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,147 +1,57 @@+{-# LANGUAGE FlexibleContexts #-}+ {- | Module      : Langchain.DocumentLoader.Core Description : Core document loading functionality for LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -Implementation of LangChain's document loading abstraction, providing:--- Document representation with content and metadata-- Typeclass for loading/splitting documents from various sources-- Integration with text splitting capabilities--For more information on document loader in the original Langchain library, see:-https://python.langchain.com/docs/concepts/document_loaders/--Example usage:--@--- Create a document-doc :: Document-doc = Document "Sample content" (fromList [("source", String "example.txt")])---- Hypothetical file loader instance-data FileLoader = FileLoader FilePath--instance BaseLoader FileLoader where-  load (FileLoader path) = do-    content <- readFile path-    return $ Right [Document content (fromList [("source", String (T.pack path))])]-@--Test case patterns:-->>> mempty :: Document-Document {pageContent = "", metadata = fromList []}-->>> doc1 = Document "Hello" (fromList [("a", Number 1)])->>> doc2 = Document " World" (fromList [("b", Bool True)])->>> doc1 <> doc2-Document {pageContent = "Hello World", metadata = fromList [("a", Number 1), ("b", Bool True)]}+Implementation of LangChain's document loading abstraction. -} module Langchain.DocumentLoader.Core-  ( -- * Document Representation-    Document (..)--    -- * Loading Interface+  ( Document (..)   , BaseLoader (..)   ) where -import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson+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.Error (LangchainResult) -{- | Document container with content and metadata.-Used for storing loaded data and associated metadata like source URLs or page numbers.--Example:+import Langchain.Core.Error (LangchainError) ->>> Document "Hello World" (fromList [("source", String "example.txt")])-Document {pageContent = "Hello World", metadata = fromList [("source",String "example.txt")]}--}+-- | Document container with content and metadata data Document = Document   { pageContent :: Text   -- ^ The text content of the document-  , metadata :: Map Text Value+  , metadata :: Map TS.Text Value   -- ^ Additional metadata (e.g., source, page number)   }   deriving (Show, Eq) -{- | Semigroup instance combines both content and metadata-->>> let doc1 = Document "A" (fromList [("x", Number 1)])->>> let doc2 = Document "B" (fromList [("y", Bool True)])->>> doc1 <> doc2-Document {pageContent = "AB", metadata = fromList [("x", Number 1), ("y", Bool True)]}--} instance Semigroup Document where   doc1 <> doc2 =     Document       (pageContent doc1 <> pageContent doc2)       (metadata doc1 <> metadata doc2) -{- | Monoid instance provides empty document:-->>> mempty :: Document-Document {pageContent = "", metadata = fromList []}--} instance Monoid Document where   mempty = Document mempty empty -{- | Typeclass for document loading implementations.-Implementations should define how to:--1. Load full documents with 'load'-2. Load and split content with 'loadAndSplit'--Example instance for text files:--@-instance BaseLoader FilePath where-  load path = do-    content <- readFile path-    return $ Right [Document content (fromList [("source", String (T.pack path))])]--  loadAndSplit path = do-    content <- readFile path-    return $ Right (splitText defaultCharacterSplitterOps content)-@--}+-- | Effect-polymorphic BaseLoader typeclass class BaseLoader loader where-  -- | Load all documents from the source.-  load :: loader -> IO (LangchainResult [Document])--  loadM :: MonadIO m => loader -> m (LangchainResult [Document])-  loadM loader = liftIO $ load loader--  -- | Load all the document and split them using recursiveCharacterSpliter-  loadAndSplit :: loader -> IO (LangchainResult [Text])--  loadAndSplitM :: MonadIO m => loader -> m (LangchainResult [Text])-  loadAndSplitM loader = liftIO $ loadAndSplit loader--{- $examples-Key test case demonstrations:--1. Metadata merging-   >>> let doc1 = Document "A" (fromList [("x", Number 1)])-   >>> let doc2 = Document "B" (fromList [("y", Bool True)])-   >>> metadata (doc1 <> doc2)-   fromList [("x", Number 1), ("y", Bool True)]--2. File loading error handling-   >>> load (FileLoader "non-existent.txt")-   Left "File not found: non-existent.txt"--3. Content splitting-   >>> loadAndSplit (FileLoader "test.txt")-   Right ["Paragraph 1", "Paragraph 2"]--}+  -- | Load all documents from the source+  load ::+    (MonadIO m, MonadError LangchainError m) =>+    loader ->+    m [Document] ---  TODO: Implement lazy versions of Document and load.--- Lazily load documents from the source.--- lazyLoad :: m -> IO (Either String [Document])+  -- | Load all documents and split their content+  loadAndSplit ::+    (MonadIO m, MonadError LangchainError m) =>+    loader ->+    m [Text]

@@ -0,0 +1,127 @@+{-# 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,36 +1,36 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  {- | Module      : Langchain.DocumentLoader.DirectoryLoader Description : Directory loading implementation for LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -DirectoryLoader document loader implements functionality for reading files from disk into Documents+DirectoryLoader document loader reads files from disk into Documents. -} module Langchain.DocumentLoader.DirectoryLoader-  ( -- * Directory loader-    DirectoryLoader (..)+  ( DirectoryLoader (..)   , DirectoryLoaderOptions (..)--    -- * Default functions   , defaultDirectoryLoaderOptions   ) where  import Control.Concurrent.Async (mapConcurrently)-import Control.Monad (filterM)+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.DocumentLoader.PdfLoader (PdfLoader (PdfLoader))-import Langchain.Error (LangchainError, llmError) import Langchain.TextSplitter.Character-import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)-import System.FilePath (takeExtension, takeFileName, (</>))  -- | Options for directory loading behavior data DirectoryLoaderOptions = DirectoryLoaderOptions@@ -50,18 +50,12 @@ defaultDirectoryLoaderOptions =   DirectoryLoaderOptions     { recursiveDepth = Nothing-    , extensions = [] -- Empty list means all files+    , extensions = []     , excludeHidden = True     , useMultithreading = False     } -{- | Directory loader configuration-Specifies the path to load documents from.--Example:-->>> DirectoryLoader "langchain-hs/src" defaultDirectoryLoaderOptions--}+-- | Directory loader configuration data DirectoryLoader = DirectoryLoader   { dirPath :: FilePath   , directoryLoaderOptions :: DirectoryLoaderOptions@@ -81,7 +75,6 @@ -- | Get all files in a directory, with controlled recursion getFilesInDirectory :: DirectoryLoaderOptions -> Int -> FilePath -> IO [FilePath] getFilesInDirectory opts currentDepth dir = do-  -- Check if we've reached max depth (if specified)   let canRecurse = case recursiveDepth opts of         Nothing -> True         Just maxD -> currentDepth < maxD@@ -89,22 +82,18 @@   entries <- listDirectory dir   let fullPaths = map (dir </>) entries -  -- Find all files in current directory   files <- filterM doesFileExist fullPaths   let filteredFiles = filter (shouldIncludeFile opts) files -  -- If we can recurse deeper and recursion is enabled, process subdirectories   subFiles <-     if canRecurse       then do         subdirs <- filterM doesDirectoryExist fullPaths-        -- Skip hidden directories if excludeHidden is set         let visibleSubdirs =               if excludeHidden opts                 then filter (\d -> not (null d) && listToMaybe d /= Just '.') subdirs                 else subdirs -        -- Process subdirectories (potentially in parallel)         if useMultithreading opts && not (null visibleSubdirs)           then             concat@@ -112,63 +101,25 @@                 (getFilesInDirectory opts (currentDepth + 1))                 visibleSubdirs           else concat <$> mapM (getFilesInDirectory opts (currentDepth + 1)) visibleSubdirs-      else return []--  return $ filteredFiles ++ subFiles+      else pure [] -loadFileToDocument :: FilePath -> IO (Either LangchainError [Document])-loadFileToDocument path = do-  exists <- doesFileExist path-  if not exists-    then-      return $-        Left-          ( llmError-              (T.pack $ "File does not exist: " ++ path)-              Nothing-              Nothing-          )-    else do-      -- if file is pdf then read it using PdfLoader else use fileLoader-      if takeExtension path == ".pdf"-        then-          load (PdfLoader path)-        else-          load (FileLoader path)+  pure $ filteredFiles ++ subFiles  instance BaseLoader DirectoryLoader where   load DirectoryLoader {..} = do-    exists <- doesDirectoryExist dirPath+    exists <- liftIO $ doesDirectoryExist dirPath     if exists       then do-        filePaths <- getFilesInDirectory directoryLoaderOptions 0 dirPath-        -- Process files (using multithreading if enabled)-        docs <--          if useMultithreading directoryLoaderOptions && not (null filePaths)-            then mapConcurrently loadFileToDocument filePaths-            else mapM loadFileToDocument filePaths-        -- Separate successes and failures-        let (errors, documents) = foldr separateResults ([], []) docs--        -- Return documents or combined error message-        case listToMaybe errors of-          Nothing -> return $ Right documents-          Just err -> return $ Left err+        filePaths <- liftIO $ getFilesInDirectory directoryLoaderOptions 0 dirPath+        fmap concat $ forM filePaths $ \path ->+          load (FileLoader path)       else-        return $-          Left $-            llmError (T.pack $ "Directory does not exist: " ++ dirPath) Nothing Nothing-    where-      separateResults (Left err) (errs, docs) = (err : errs, docs)-      separateResults (Right doc) (errs, docs) = (errs, doc <> docs)+        throwError $+          documentLoaderError+            (T.pack $ "Directory does not exist: " ++ dirPath)+            (Just "DirectoryLoader")+            (Just $ T.pack dirPath)    loadAndSplit dirLoader = do-    eRes <- load dirLoader-    case eRes of-      Left e -> pure $ Left e-      Right documents ->-        pure $-          Right $-            splitText-              defaultCharacterSplitterOps-              (pageContent $ mconcat documents)+    documents <- load dirLoader+    pure $ splitText defaultCharacterSplitterOps (pageContent $ mconcat documents)

@@ -1,126 +1,76 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}  {- | Module      : Langchain.DocumentLoader.FileLoader Description : File loading implementation for LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao+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-Integrates with the core document splitting functionality for processing text files.--Example usage:--@--- Load a document from file-loader = FileLoader "data.txt"-docs <- load loader--- Right [Document {pageContent = "File content", metadata = ...}]---- Load and split document content-chunks <- loadAndSplit loader--- Right ["First paragraph", "Second paragraph", ...]-@+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 Langchain.DocumentLoader.Core-import Langchain.Error (SomeException, llmError, try)-import Langchain.TextSplitter.Character import System.Directory (doesFileExist) -{- | File loader configuration-Specifies the file path to load documents from.--Example:+import Langchain.Core.Error (documentLoaderError)+import Langchain.DocumentLoader.Core+import Langchain.TextSplitter.Character ->>> FileLoader "docs/example.txt"-FileLoader "docs/example.txt"--}+-- | File loader configuration newtype FileLoader = FileLoader FilePath+  deriving (Eq, Show)  instance BaseLoader FileLoader where-  -- \| Load document with file source metadata-  ---  --  Example:--  --  >>> load (FileLoader "test.txt")-  --  Right [Document {pageContent = "Test content", metadata = fromList [("source", "test.txt")]}]-  --   load (FileLoader path) = do-    exists <- doesFileExist path+    exists <- liftIO $ doesFileExist path     if exists       then do-        eContent <- try $ readFile path+        eContent <- liftIO $ try (readFile path)         case eContent of           Left err ->-            return $-              Left $-                llmError-                  (T.pack $ "Error reading file: " ++ path ++ show (err :: SomeException))-                  Nothing-                  Nothing+            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)]-            return $ Right [Document (TL.pack content) meta]+            pure [Document (TL.pack content) meta]       else-        return $-          Left-            ( llmError-                (T.pack $ "File not found: " ++ path)-                Nothing-                Nothing-            )--  -- \| Load and split content using default character splitter-  ---  --  Example:+        throwError $+          documentLoaderError+            (T.pack $ "File not found: " ++ path)+            (Just "FileLoader")+            (Just $ T.pack path) -  --  >>> loadAndSplit (FileLoader "split.txt")-  --  Right ["Paragraph 1", "Paragraph 2", ...]-  --   loadAndSplit (FileLoader path) = do-    exists <- doesFileExist path+    exists <- liftIO $ doesFileExist path     if exists       then do-        eContent <- try $ readFile path+        eContent <- liftIO $ try (readFile path)         case eContent of           Left err ->-            return $-              Left $-                llmError-                  (T.pack $ "Error reading file: " ++ path ++ show (err :: SomeException))-                  Nothing-                  Nothing-          Right content -> return $ Right $ splitText defaultCharacterSplitterOps (TL.pack content)+            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-        return $-          Left-            ( llmError-                (T.pack $ "File not found: " ++ path)-                Nothing-                Nothing-            )--{- $examples-Test case patterns:-1. Successful load with metadata-   >>> withTestFile "Content" $ \path -> load (FileLoader path)-   Right [Document {pageContent = "Content", metadata = ...}]--2. Error handling for missing files-   >>> load (FileLoader "missing.txt")-   Left "File not found: missing.txt"--3. Content splitting with default parameters-   >>> withTestFile "A\n\nB\n\nC" $ \path -> loadAndSplit (FileLoader path)-   Right ["A", "B", "C"]--}+        throwError $+          documentLoaderError+            (T.pack $ "File not found: " ++ path)+            (Just "FileLoader")+            (Just $ T.pack path)

@@ -1,125 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.DocumentLoader.PdfLoader-Description : A PDF loader that extracts documents from PDF files.-Copyright   : (C) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--This module provides a loader for loading PDF files.--}-module Langchain.DocumentLoader.PdfLoader-  ( PdfLoader (..)-  ) where--import Data.Aeson-import Data.Map (fromList)-import qualified Data.Text.Lazy as TL-import Langchain.DocumentLoader.Core-import Langchain.Error (llmError)-import Langchain.TextSplitter.Character-import Langchain.Utils (showText)-import Pdf.Document hiding (Document)-import System.Directory (doesFileExist)---- TODO: Need some error handling for this function--{- |-An internal function-Reads a PDF file and extracts a list of 'Document's, one per page.--This function opens the PDF file at the specified 'FilePath' and uses-the Pdf.Document library to extract the text from each page. Each page's-content is wrapped in a 'Document' along with metadata indicating the page number.--Note: This function currently has minimal error handling. Improvements may be-required to properly handle various PDF parsing errors.--@param fPath The file path to the PDF file.-@return An IO action yielding a list of 'Document's extracted from the PDF.--}-readPdf :: FilePath -> IO [Document]-readPdf fPath = do-  withPdfFile fPath $ \pdf -> do-    doc <- document pdf-    catalog <- documentCatalog doc-    rootNode <- catalogPageNode catalog-    count <- pageNodeNKids rootNode-    textList <--      sequence-        [ pageExtractText-            =<< pageNodePageByNum rootNode i-        | i <- [0 .. count - 1]-        ]-    pure $-      zipWith-        ( \content pageNum ->-            Document-              { pageContent = content-              , metadata =-                  fromList-                    [ ("page number", Number $ fromIntegral pageNum)-                    ]-              }-        )-        (map TL.fromStrict textList)-        [1 .. count]--{- |-A loader for PDF files.--The 'PdfLoader' data type encapsulates a 'FilePath' pointing to a PDF document.-It implements the 'BaseLoader' interface to provide methods for loading and-splitting PDF content.--}-newtype PdfLoader = PdfLoader FilePath--instance BaseLoader PdfLoader where-  -- \|-  --  Loads all pages from the PDF file specified by the 'PdfLoader'.-  ---  --  This function first checks whether the file exists. If it does, it uses-  --  'readPdf' to extract the content of each page as a separate 'Document'. If-  --  the file is not found, an appropriate error message is returned.-  ---  --  @param loader A 'PdfLoader' containing the file path to the PDF.-  --  @return An IO action yielding either an error message or a list of 'Document's.-  ---  load (PdfLoader path) = do-    exists <- doesFileExist path-    if exists-      then do-        content <- readPdf path-        return $ Right content-      else-        return $-          Left $-            llmError (showText $ "File not found: " ++ path) Nothing Nothing--  -- \|-  --  Loads the raw content of the PDF file and splits it using a character splitter.-  ---  --  This method reads the entire pdf as text and applies-  --  'splitText' with default recursive character options to divide the text into chunks.-  --  This approach is useful when only a simple text split is required rather than structured-  --  page extraction.-  ---  --  @param loader A 'PdfLoader' containing the file path to the PDF.-  --  @return An IO action yielding either an error message or a list of text chunks.-  ---  loadAndSplit (PdfLoader path) = do-    exists <- doesFileExist path-    if exists-      then do-        documents <- readPdf path-        return $-          Right $-            splitText-              defaultCharacterSplitterOps-              (pageContent $ mconcat documents)-      else-        return $-          Left $-            llmError (showText $ "File not found: " ++ path) Nothing Nothing

@@ -1,100 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}+ {- | Module      : Langchain.Embeddings.Core-Description : Embedding model interface for LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao+Description : Effect-polymorphic embedding model interface+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -Haskell implementation of LangChain's embedding model abstraction, providing:--- Document vectorization for semantic search-- Query embedding for similarity comparisons-- Integration with document loading pipelines--Example usage:--@-  let oEmbed = defaultOpenAIEmbeddings { apiKey = "api-key" }-  let p = PdfLoader "/home/user/Documents/TS/langchain/SOP.pdf"-  eDocs <- load p-  case eDocs of-    Left err -> error err-    Right docs -> do-      eRes <- embedQuery oEmbed "Hello"-      print eRes-@+Effect-polymorphic Embeddings typeclass. -} module Langchain.Embeddings.Core-  ( -- * Embedding Interface-    Embeddings (..)+  ( Embeddings (..)   ) where -import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Except (MonadError)+import Control.Monad.IO.Class (MonadIO) import Data.Text (Text)-import Langchain.DocumentLoader.Core-import Langchain.Error (LangchainResult) -{- | Typeclass for embedding models following LangChain's pattern.-Converts text/documents into numerical vectors for machine learning tasks.--Implementations should handle:--- Text preprocessing-- API calls to embedding services-- Error handling for failed requests-- Consistent vector dimensionality--Example instance for a test model:--@-data TestEmbeddings = TestEmbeddings+import Langchain.Core.Error (LangchainError)+import Langchain.DocumentLoader.Core (Document) -instance Embeddings TestEmbeddings where-  embedDocuments _ _ = return $ Right [[0.1, 0.2, 0.3]]-  embedQuery _ _ = return $ Right [0.4, 0.5, 0.6]-@--}+-- | Effect-polymorphic Embeddings typeclass class Embeddings embed where-  {- | Convert documents to embedding vectors--  Example:--  >>> let doc = Document "Hello world" mempty-  >>> embedDocuments TestEmbeddings [doc]-  Right [[0.1, 0.2, 0.3]]-  -}-  embedDocuments :: embed -> [Document] -> IO (LangchainResult [[Float]])--  embedDocumentsM :: MonadIO m => embed -> [Document] -> m (LangchainResult [[Float]])-  embedDocumentsM embeddings docs = liftIO $ embedDocuments embeddings docs--  {- | Convert query text to embedding vector--  Example:--  >>> embedQuery TestEmbeddings "Search query"-  Right [0.4, 0.5, 0.6]-  -}-  embedQuery :: embed -> Text -> IO (LangchainResult [Float])--  embedQueryM :: MonadIO m => embed -> Text -> m (LangchainResult [Float])-  embedQueryM embeddings query = liftIO $ embedQuery embeddings query--{- $examples-Test case patterns:--1. Document embedding-   >>> let docs = [Document "Test content" mempty]-   >>> embedDocuments TestEmbeddings docs-   Right [[0.1, 0.2, 0.3]]--2. Query embedding-   >>> embedQuery TestEmbeddings "Test query"-   Right [0.4, 0.5, 0.6]+  -- | Convert documents to embedding vectors+  embedDocuments ::+    (MonadIO m, MonadError LangchainError m) =>+    embed ->+    [Document] ->+    m [[Float]] -3. Error handling-   >>> -- Simulate failed API call-   >>> embedQuery FaultyEmbeddings "Bad request"-   Left "API request failed"--}+  -- | Convert query text to embedding vector+  embedQuery ::+    (MonadIO m, MonadError LangchainError m) =>+    embed ->+    Text ->+    m [Float]

@@ -1,67 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Embeddings.Gemini-Description : Gemini integration for text embeddings in LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Gemini implementation of LangChain's embedding interface. Supports document and query-embedding generation through Gemini's OpenAI compatible API.-Checkout docs here: https://ai.google.dev/gemini-api/docs/openai#embeddings--}-module Langchain.Embeddings.Gemini-  ( -- * Types-    GeminiEmbeddings (..)-  , defaultGeminiEmbeddings-  , module Langchain.Embeddings.Core-  ) where--import Data.Text (Text, unpack)-import GHC.Generics-import Langchain.Embeddings.Core-import Langchain.Embeddings.OpenAI--data GeminiEmbeddings = GeminiEmbeddings-  { apiKey :: Text-  -- ^ Gemini API Key-  , baseUrl :: Maybe String-  -- ^ base url; default "https://generativelanguage.googleapis.com/v1beta/openai"-  , model :: Text-  -- ^ Model name for embeddings-  , dimensions :: Maybe Int-  -- ^ The number of dimensions the resulting output embeddings should have.-  , encodingFormat :: Maybe EncodingFormat-  {- ^ The format to return the embeddings in.-  ^ For now, only float is supported-  -}-  , embeddingsUser :: Maybe Text-  -- ^ A unique identifier representing your end-user, which can help monitor and detect abuse.-  , timeout :: Maybe Int-  -- ^ Override default responsetime out. unit = seconds.-  }-  deriving (Eq, Generic)--instance Show GeminiEmbeddings where-  show GeminiEmbeddings {..} = "GeminiEmbeddings " <> "model " <> unpack model---- | Default values GeminiEmbeddings, api-key is empty-defaultGeminiEmbeddings :: GeminiEmbeddings-defaultGeminiEmbeddings =-  GeminiEmbeddings-    { apiKey = ""-    , baseUrl = pure "https://generativelanguage.googleapis.com/v1beta/openai"-    , model = "gemini-embedding-001"-    , dimensions = Nothing-    , encodingFormat = Nothing-    , embeddingsUser = Nothing-    , timeout = Nothing-    }--instance Embeddings GeminiEmbeddings where-  embedDocuments GeminiEmbeddings {..} = embedDocuments OpenAIEmbeddings {..}-  embedQuery GeminiEmbeddings {..} = embedQuery OpenAIEmbeddings {..}

@@ -1,119 +1,75 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  {- | Module      : Langchain.Embeddings.Ollama Description : Ollama integration for text embeddings in LangChain Haskell-Copyright   : (c) 2025 Tushar Adhatrao+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -Ollama implementation of LangChain's embedding interface. Supports document and query-embedding generation through Ollama's API.--Example usage:--@--- Create Ollama embeddings configuration-ollamaEmb = OllamaEmbeddings-  { model = "nomic-embed-text:latest"-  , defaultTruncate = Just True-  , defaultKeepAlive = Just "5m"-  }---- Embed query text-queryVec <- embedQuery ollamaEmb "What is Haskell?"--- Right [0.12, 0.34, ...]---- Embed document collection-doc <- Document "Haskell is a functional programming language" mempty-docsVec <- embedDocuments ollamaEmb [doc]--- Right [[0.56, 0.78, ...]]-@+Ollama implementation of LangChain's embedding interface using ollama-haskell 0.3.0.0. -} module Langchain.Embeddings.Ollama   ( OllamaEmbeddings (..)-  , module Langchain.DocumentLoader.Core   ) where -import Data.Maybe-import Data.Ollama.Embeddings-import qualified Data.Ollama.Embeddings as O+import Control.Monad.Except (throwError)+import Control.Monad.IO.Class (liftIO) import Data.Text (Text)-import qualified Data.Text.Lazy as T-import Langchain.DocumentLoader.Core+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 Langchain.Error (llmError)-import Langchain.Utils (showText) -{- | Ollama-specific embedding configuration-Contains parameters for controlling:--- Model selection-- Input truncation behavior-- Model caching via keep-alive--Example configuration:+import Ollama.API.Embed (EmbedRequest (..), EmbedResponse (..), embed)+import Ollama.Client (defaultClient)+import Ollama.Types.Common (ModelName (..))+import Ollama.Types.Options (ModelOptions) ->>> OllamaEmbeddings "nomic-embed" (Just False) (Just 3600) Nothing-OllamaEmbeddings {model = "nomic-embed", ...}--} data OllamaEmbeddings = OllamaEmbeddings   { model :: Text-  -- ^ The name of the Ollama model to use for embeddings   , defaultTruncate :: Maybe Bool-  -- ^ Optional flag to truncate input if supported by the API-  , defaultKeepAlive :: Maybe Int-  -- ^ Keep model loaded for specified duration in seconds (e.g., 300 for 5 minutes)-  , modelOptions :: Maybe O.ModelOptions-  -- ^ Optional model parameters (e.g., temperature) as specified in the Modelfile.+  , defaultKeepAlive :: Maybe Text+  , modelOptions :: Maybe ModelOptions   }   deriving (Show, Eq)  instance Embeddings OllamaEmbeddings where-  -- \| Document embedding implementation:-  --  Processes each document individually through Ollama's API.-  ---  --  Example:-  --  >>> let doc = Document "Test content" mempty-  --  >>> embedDocuments ollamaEmb [doc]-  --  Right [[0.1, 0.2, ...], ...]   embedDocuments (OllamaEmbeddings {..}) docs = do-    -- For each input text, make an individual API call-    eRes <--      embeddingOps-        model-        (map (T.toStrict . pageContent) docs)-        defaultTruncate-        defaultKeepAlive-        modelOptions-        Nothing-        Nothing+    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 -> return $ Left $ llmError (showText ollamaErr) Nothing Nothing-      Right r -> return $ Right $ respondedEmbeddings r+      Left ollamaErr -> throwError $ llmError (T.pack (show ollamaErr)) (Just "OllamaEmbeddings") Nothing+      Right resp -> pure $ map (map realToFrac) (erEmbeddings resp) -  -- \| Query embedding implementation:-  --  Generates vector representation for search queries.-  ---  --  Example:-  --  >>> embedQuery ollamaEmb "Explain monads"-  --  Right [0.3, 0.4, ...]-  --   embedQuery (OllamaEmbeddings {..}) query = do-    res <--      embeddingOps-        model-        [query]-        defaultTruncate-        defaultKeepAlive-        modelOptions-        Nothing-        Nothing-    case fmap respondedEmbeddings res of-      Left err -> pure $ Left (llmError (showText err) Nothing Nothing)-      Right lst ->-        case listToMaybe lst of-          Nothing -> pure $ Left (llmError "Embeddings are empty" Nothing Nothing)-          Just x -> pure $ Right x+    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,24 +1,21 @@ {-# 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 Tushar Adhatrao+Copyright   : (c) 2025-2026 Tushar Adhatrao License     : MIT Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com> Stability   : experimental -OpenAI implementation of LangChain's embedding interface. Supports document and query-embedding generation through OpenAI's API.-Checkout docs here: https://platform.openai.com/docs/guides/embeddings+OpenAI implementation of LangChain's embedding interface. -} module Langchain.Embeddings.OpenAI-  ( -- * Types-    OpenAIEmbeddings (..)--    -- * Helper model name functions+  ( OpenAIEmbeddings (..)   , defaultOpenAIEmbeddings   , textEmbedding3Small   , textEmbedding3Large@@ -26,20 +23,11 @@   , EncodingFormat (..)   ) where -{--  No need to expose these, but can be expose later for direct use-  -- * Request Types-  OpenAIEmbeddingsRequest (..)-, EmbeddingsInput (..)-, EncodingFormat (..)--  -- * ResponseTypes-, OpenAIEmbeddingsResponse (..)-, EmbeddingsObject (..)-, EmbeddingsUsage (..)--}-+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@@ -47,9 +35,10 @@ 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 Langchain.Error (llmError) import Network.HTTP.Conduit import Network.HTTP.Simple   ( getResponseBody@@ -57,7 +46,6 @@   , setRequestBodyJSON   , setRequestHeader   , setRequestMethod-  , setRequestSecure   ) import Network.HTTP.Types.Status (statusCode) @@ -72,7 +60,6 @@   { inputReq :: EmbeddingsInput   , modelReq :: Text   , dimensionsReq :: Maybe Int-  -- ^ Only supported in text-embedding-3 or later   , encodingFormatReq :: Maybe EncodingFormat   }   deriving (Show, Eq, Generic)@@ -87,12 +74,14 @@  instance ToJSON OpenAIEmbeddingsRequest where   toJSON OpenAIEmbeddingsRequest {..} =-    object+    object $       [ "input" .= inputReq       , "model" .= modelReq-      , "dimensions" .= dimensionsReq-      , "encoding_format" .= encodingFormatReq       ]+        ++ catMaybes+          [ ("dimensions" .=) <$> dimensionsReq+          , ("encoding_format" .=) <$> encodingFormatReq+          ]  -- Response data EmbeddingsUsage = EmbeddingsUsage@@ -117,47 +106,34 @@   deriving (Eq, Show, Generic)  instance FromJSON EmbeddingsUsage where-  parseJSON (Object v) =+  parseJSON = withObject "EmbeddingsUsage" $ \v ->     EmbeddingsUsage       <$> v .: "prompt_tokens"       <*> v .: "total_tokens"-  parseJSON _ = error "Parse error, expecting object"  instance FromJSON EmbeddingsObject where-  parseJSON (Object v) =+  parseJSON = withObject "EmbeddingsObject" $ \v ->     EmbeddingsObject       <$> v .: "embedding"       <*> v .:? "index"       <*> v .: "object"-  parseJSON _ = error "Parse error, expecting object"  instance FromJSON OpenAIEmbeddingsResponse where-  parseJSON (Object v) =+  parseJSON = withObject "OpenAIEmbeddingsResponse" $ \v ->     OpenAIEmbeddingsResponse       <$> v .: "object"       <*> v .: "data"       <*> v .: "model"       <*> v .:? "usage"-  parseJSON _ = error "Parse error, expecting object" --- | Embeddings type for OpenAI, can be used for embed documents with OpenAI.+-- | Embeddings type for OpenAI data OpenAIEmbeddings = OpenAIEmbeddings   { apiKey :: Text-  -- ^ OpenAI API Key   , baseUrl :: Maybe String-  -- ^ base url; default "https://api.openai.com/v1"   , model :: Text-  -- ^ Model name for embeddings   , dimensions :: Maybe Int-  {- ^ The number of dimensions the resulting output embeddings should have.-  ^ Only supported in text-embedding-3 or later-  -}   , encodingFormat :: Maybe EncodingFormat-  {- ^ The format to return the embeddings in.-  ^ For now, only float is supported-  -}   , timeout :: Maybe Int-  -- ^ Override default responsetime out. unit = seconds.   }   deriving (Eq, Generic) @@ -167,76 +143,72 @@ openAIEmbeddingsRequest ::   OpenAIEmbeddings -> [Text] -> IO (Either String OpenAIEmbeddingsResponse) openAIEmbeddingsRequest OpenAIEmbeddings {..} txts = do-  request_ <--    parseRequest $-      fromMaybe "https://api.openai.com/v1" baseUrl <> "/embeddings"-  manager <--    newManager-      tlsManagerSettings-        { managerResponseTimeout =-            responseTimeoutMicro (fromMaybe 60 timeout * 1000000)-        }-  let req =-        setRequestMethod "POST" $-          setRequestSecure True $-            setRequestHeader "Content-Type" ["application/json"] $-              setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] $-                setRequestBodyJSON-                  ( OpenAIEmbeddingsRequest-                      { inputReq = TextList txts-                      , modelReq = model-                      , dimensionsReq = dimensions-                      , encodingFormatReq = encodingFormat-                      }-                  )-                  request_+  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_ -  response <- httpLbs req manager-  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)+      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 <- openAIEmbeddingsRequest openAIEmbeddings (map (TL.toStrict . pageContent) docs)+    eRes <- liftIO $ openAIEmbeddingsRequest openAIEmbeddings (map (TL.toStrict . pageContent) docs)     case eRes of-      Left err -> pure $ Left (llmError (T.pack err) Nothing Nothing)-      Right (OpenAIEmbeddingsResponse {..}) -> do-        pure $ Right $ map embeddings dataList+      Left err -> throwError $ llmError (T.pack err) (Just "OpenAIEmbeddings") Nothing+      Right (OpenAIEmbeddingsResponse {..}) -> pure $ map embeddings dataList    embedQuery openAIEmbeddings query = do-    eRes <- openAIEmbeddingsRequest openAIEmbeddings [query]+    eRes <- liftIO $ openAIEmbeddingsRequest openAIEmbeddings [query]     case eRes of-      Left err -> pure $ Left (llmError (T.pack err) Nothing Nothing)-      Right (OpenAIEmbeddingsResponse {..}) -> do+      Left err -> throwError $ llmError (T.pack err) (Just "OpenAIEmbeddings") Nothing+      Right (OpenAIEmbeddingsResponse {..}) ->         case listToMaybe dataList of-          Nothing -> pure $ Left (llmError "Embeddings are empty" Nothing Nothing)-          Just x -> pure $ Right $ embeddings x---- Helper functions, model name functions+          Nothing -> throwError $ llmError "Embeddings are empty" (Just "OpenAIEmbeddings") Nothing+          Just x -> pure $ embeddings x --- | Small embedding model textEmbedding3Small :: Text textEmbedding3Small = "text-embedding-3-small" --- | Most capable embedding model textEmbedding3Large :: Text textEmbedding3Large = "text-embedding-3-large" --- | Older embedding model textEmbeddingAda :: Text textEmbeddingAda = "text-embedding-ada-002" --- | Default values OpenAIEmbeddings, api-key is empty defaultOpenAIEmbeddings :: OpenAIEmbeddings defaultOpenAIEmbeddings =   OpenAIEmbeddings

@@ -1,609 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--{- |-Module      : Langchain.Error-Description : Central error handling for langchain-hs-Copyright   : (c) 2025 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--This module provides a comprehensive error handling system for langchain-hs,-replacing the previous `Either String` pattern with a structured, type-safe-approach that follows industry best practices.--The error system includes:--* Structured error types with context and metadata-* Error severity levels and categories-* Utility functions for error construction and handling-* Integration with existing langchain-hs components-* Support for error chaining and context preservation--Example usage:--@-import Langchain.Error---- Creating errors-let err = llmError "Model timeout" (Just "gpt-4") Nothing---- Error handling with context-result <- someOperation-case result of-  Left err -> do-    logError err-    handleError err-  Right value -> processValue value---- Error chaining-chainError "Failed to process document" originalError-@--}-module Langchain.Error-  ( -- * Error Types-    LangchainError (..)-  , ErrorSeverity (..)-  , ErrorCategory (..)-  , ErrorContext (..)--    -- * Error Construction-  , llmError-  , llmErrorWithContext-  , agentError-  , agentErrorWithContext-  , memoryError-  , memoryErrorWithContext-  , toolError-  , toolErrorWithContext-  , vectorStoreError-  , vectorStoreErrorWithContext-  , documentLoaderError-  , documentLoaderErrorWithContext-  , embeddingError-  , embeddingErrorWithContext-  , runnableError-  , runnableErrorWithContext-  , parsingError-  , parsingErrorWithContext-  , networkError-  , networkErrorWithContext-  , configurationError-  , configurationErrorWithContext-  , validationError-  , validationErrorWithContext-  , internalError-  , internalErrorWithContext--    -- * Error Utilities-  , chainError-  , addContext-  , withErrorContext-  , mapError-  , fromString-  , toString-  , toText-  , logError-  , isRetryable-  , getSeverity-  , getCategory-  , fromStringError-  , fromException-  , liftStringError-  , simpleError-  , catchToLangchainError-  , withContext-  , withContextIO--    -- * Type Aliases-  , LangchainResult-  , LangchainIO--    -- * Re-exports for convenience-  , module Control.Exception-  ) where--import Control.Exception (Exception, SomeException, displayException, try)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (FromJSON, ToJSON)-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time (UTCTime, getCurrentTime)-import GHC.Generics (Generic)-import System.IO (hPutStrLn, stderr)---- | Severity levels for errors, following industry standards-data ErrorSeverity-  = -- | System-breaking errors that require immediate attention-    Critical-  | -- | Errors that prevent core functionality-    High-  | -- | Errors that degrade functionality but allow continuation-    Medium-  | -- | Minor errors or warnings-    Low-  | -- | Informational messages-    Info-  deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)---- | Categories of errors for better organization and handling-data ErrorCategory-  = -- | Language model related errors-    LLMError-  | -- | Agent execution errors-    AgentError-  | -- | Memory management errors-    MemoryError-  | -- | Tool execution errors-    ToolError-  | -- | Vector store operation errors-    VectorStoreError-  | -- | Document loading errors-    DocumentLoaderError-  | -- | Embedding generation errors-    EmbeddingError-  | -- | Runnable execution errors-    RunnableError-  | -- | Data parsing and validation errors-    ParsingError-  | -- | Network and HTTP errors-    NetworkError-  | -- | Configuration and setup errors-    ConfigurationError-  | -- | Input validation errors-    ValidationError-  | -- | Internal system errors-    InternalError-  deriving (Eq, Show, Generic, ToJSON, FromJSON)---- | Additional context information for errors-data ErrorContext = ErrorContext-  { contextComponent :: Maybe Text-  -- ^ Component where error occurred-  , contextOperation :: Maybe Text-  -- ^ Operation being performed-  , contextInput :: Maybe Text-  -- ^ Input that caused the error-  , contextMetadata :: [(Text, Text)]-  -- ^ Additional metadata-  , contextTimestamp :: UTCTime-  -- ^ When the error occurred-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON)---- | The central error type for langchain-hs-data LangchainError = LangchainError-  { errorMessage :: Text-  -- ^ Human-readable error message-  , errorSeverity :: ErrorSeverity-  -- ^ Severity level-  , errorCategory :: ErrorCategory-  -- ^ Error category-  , errorContext :: Maybe ErrorContext-  -- ^ Additional context-  , errorCause :: Maybe LangchainError-  -- ^ Chained/nested error-  , errorCode :: Maybe Text-  -- ^ Optional error code-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON)--instance Exception LangchainError where-  displayException LangchainError {..} =-    T.unpack $-      T.unlines $-        filter-          (not . T.null)-          [ "["-              <> T.pack (show errorSeverity)-              <> "] "-              <> T.pack (show errorCategory)-              <> ": "-              <> errorMessage-          , maybe "" ("Error Code: " <>) errorCode-          , maybe "" formatContext errorContext-          , maybe "" (\cause -> "Caused by: " <> T.pack (show cause)) errorCause-          ]-    where-      formatContext ErrorContext {..} =-        T.unlines $-          filter-            (not . T.null)-            [ maybe "" ("Component: " <>) contextComponent-            , maybe "" ("Operation: " <>) contextOperation-            , maybe "" ("Input: " <>) contextInput-            , if null contextMetadata then "" else "Metadata: " <> T.pack (show contextMetadata)-            , "Timestamp: " <> T.pack (show contextTimestamp)-            ]---- | Type alias for results that can fail with LangchainError-type LangchainResult a = Either LangchainError a---- | Type alias for IO operations that can fail with LangchainError-type LangchainIO a = IO (LangchainResult a)---- | Create an LLM-related error-llmError :: Text -> Maybe Text -> Maybe Text -> LangchainError-llmError msg _model _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = LLMError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create an LLM error with context-llmErrorWithContext ::-  Text ->-  Maybe Text ->-  Maybe Text ->-  ErrorContext ->-  LangchainError-llmErrorWithContext msg model operation ctx =-  (llmError msg model operation)-    { errorContext =-        Just ctx {contextComponent = model, contextOperation = operation}-    }---- | Create an agent-related error-agentError :: Text -> Maybe Text -> Maybe Text -> LangchainError-agentError msg _agentType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = AgentError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create an agent error with context-agentErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-agentErrorWithContext msg agentType operation ctx =-  (agentError msg agentType operation)-    { errorContext = Just ctx {contextComponent = agentType, contextOperation = operation}-    }---- | Create a memory-related error-memoryError :: Text -> Maybe Text -> Maybe Text -> LangchainError-memoryError msg _memoryType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = Medium-    , errorCategory = MemoryError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a memory error with context-memoryErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-memoryErrorWithContext msg memoryType operation ctx =-  (memoryError msg memoryType operation)-    { errorContext = Just ctx {contextComponent = memoryType, contextOperation = operation}-    }---- | Create a tool-related error-toolError :: Text -> Maybe Text -> Maybe Text -> LangchainError-toolError msg _toolName _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = ToolError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a tool error with context-toolErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-toolErrorWithContext msg toolName operation ctx =-  (toolError msg toolName operation)-    { errorContext = Just ctx {contextComponent = toolName, contextOperation = operation}-    }---- | Create a vector store error-vectorStoreError :: Text -> Maybe Text -> Maybe Text -> LangchainError-vectorStoreError msg _storeType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = VectorStoreError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a vector store error with context-vectorStoreErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-vectorStoreErrorWithContext msg storeType operation ctx =-  (vectorStoreError msg storeType operation)-    { errorContext = Just ctx {contextComponent = storeType, contextOperation = operation}-    }---- | Create a document loader error-documentLoaderError :: Text -> Maybe Text -> Maybe Text -> LangchainError-documentLoaderError msg _loaderType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = Medium-    , errorCategory = DocumentLoaderError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a document loader error with context-documentLoaderErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-documentLoaderErrorWithContext msg loaderType operation ctx =-  (documentLoaderError msg loaderType operation)-    { errorContext = Just ctx {contextComponent = loaderType, contextOperation = operation}-    }---- | Create an embedding error-embeddingError :: Text -> Maybe Text -> Maybe Text -> LangchainError-embeddingError msg _embeddingType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = EmbeddingError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create an embedding error with context-embeddingErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-embeddingErrorWithContext msg embeddingType operation ctx =-  (embeddingError msg embeddingType operation)-    { errorContext = Just ctx {contextComponent = embeddingType, contextOperation = operation}-    }---- | Create a runnable error-runnableError :: Text -> Maybe Text -> Maybe Text -> LangchainError-runnableError msg _runnableType _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = RunnableError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a runnable error with context-runnableErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-runnableErrorWithContext msg runnableType operation ctx =-  (runnableError msg runnableType operation)-    { errorContext = Just ctx {contextComponent = runnableType, contextOperation = operation}-    }---- | Create a parsing error-parsingError :: Text -> Maybe Text -> Maybe Text -> LangchainError-parsingError msg _parserType _input =-  LangchainError-    { errorMessage = msg <> fromMaybe "" _parserType-    , errorSeverity = Medium-    , errorCategory = ParsingError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = _input-    }---- | Create a parsing error with context-parsingErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-parsingErrorWithContext msg parserType input ctx =-  (parsingError msg parserType input)-    { errorContext = Just ctx {contextComponent = parserType, contextInput = input}-    }---- | Create a network error-networkError :: Text -> Maybe Text -> Maybe Text -> LangchainError-networkError msg _endpoint _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = High-    , errorCategory = NetworkError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a network error with context-networkErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-networkErrorWithContext msg endpoint operation ctx =-  (networkError msg endpoint operation)-    { errorContext = Just ctx {contextComponent = endpoint, contextOperation = operation}-    }---- | Create a configuration error-configurationError :: Text -> Maybe Text -> Maybe Text -> LangchainError-configurationError msg _configKey _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = Critical-    , errorCategory = ConfigurationError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a configuration error with context-configurationErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-configurationErrorWithContext msg configKey operation ctx =-  (configurationError msg configKey operation)-    { errorContext = Just ctx {contextComponent = configKey, contextOperation = operation}-    }---- | Create a validation error-validationError :: Text -> Maybe Text -> Maybe Text -> LangchainError-validationError msg _field _input =-  LangchainError-    { errorMessage = msg-    , errorSeverity = Medium-    , errorCategory = ValidationError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create a validation error with context-validationErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-validationErrorWithContext msg field input ctx =-  (validationError msg field input)-    { errorContext = Just ctx {contextComponent = field, contextInput = input}-    }---- | Create an internal error-internalError :: Text -> Maybe Text -> Maybe Text -> LangchainError-internalError msg _component _operation =-  LangchainError-    { errorMessage = msg-    , errorSeverity = Critical-    , errorCategory = InternalError-    , errorContext = Nothing-    , errorCause = Nothing-    , errorCode = Nothing-    }---- | Create an internal error with context-internalErrorWithContext :: Text -> Maybe Text -> Maybe Text -> ErrorContext -> LangchainError-internalErrorWithContext msg component operation ctx =-  (internalError msg component operation)-    { errorContext = Just ctx {contextComponent = component, contextOperation = operation}-    }---- | Chain an error with a new message, preserving the original as the cause-chainError :: Text -> LangchainError -> LangchainError-chainError msg originalError =-  LangchainError-    { errorMessage = msg-    , errorSeverity = errorSeverity originalError-    , errorCategory = errorCategory originalError-    , errorContext = errorContext originalError-    , errorCause = Just originalError-    , errorCode = errorCode originalError-    }---- | Add context to an existing error-addContext :: ErrorContext -> LangchainError -> LangchainError-addContext ctx err = err {errorContext = Just ctx}---- | Execute an action with error context, automatically adding context to any errors-withErrorContext :: MonadIO m => ErrorContext -> LangchainIO a -> m (LangchainResult a)-withErrorContext ctx action = liftIO $ do-  result <- action-  case result of-    Left err -> return $ Left $ addContext ctx err-    Right val -> return $ Right val---- | Map a function over the error in a result-mapError :: (LangchainError -> LangchainError) -> LangchainResult a -> LangchainResult a-mapError f (Left err) = Left (f err)-mapError _ (Right val) = Right val---- | Convert a String to LangchainError-fromString :: String -> LangchainError-fromString str = internalError (T.pack str) Nothing Nothing---- | Convert LangchainError to String-toString :: LangchainError -> String-toString = displayException---- | Convert LangchainError to Text-toText :: LangchainError -> Text-toText = T.pack . toString---- | Log an error to stderr (can be extended to use proper logging)-logError :: MonadIO m => LangchainError -> m ()-logError err = liftIO $ hPutStrLn stderr $ toString err---- | Check if an error is retryable based on its category and severity-isRetryable :: LangchainError -> Bool-isRetryable LangchainError {..} = case errorCategory of-  NetworkError -> errorSeverity <= High-  LLMError -> errorSeverity <= Medium-  VectorStoreError -> errorSeverity <= Medium-  EmbeddingError -> errorSeverity <= Medium-  ToolError -> errorSeverity <= Medium-  _ -> False---- | Get the severity of an error-getSeverity :: LangchainError -> ErrorSeverity-getSeverity = errorSeverity---- | Get the category of an error-getCategory :: LangchainError -> ErrorCategory-getCategory = errorCategory---- | Convert a String error to LangchainError (for backward compatibility)-fromStringError :: String -> LangchainError-fromStringError = fromString---- | Convert an IO exception to LangchainError-fromException :: SomeException -> LangchainError-fromException ex = internalError (T.pack $ displayException ex) Nothing Nothing---- | Lift an Either String to LangchainResult-liftStringError :: Either String a -> LangchainResult a-liftStringError (Left err) = Left (fromString err)-liftStringError (Right val) = Right val---- | Create a simple error with just a message (uses InternalError category)-simpleError :: Text -> LangchainError-simpleError msg = internalError msg Nothing Nothing---- | Catch IO exceptions and convert them to LangchainError-catchToLangchainError :: IO a -> IO (LangchainResult a)-catchToLangchainError action = do-  result <- try action-  case result of-    Left ex -> return $ Left $ fromException ex-    Right val -> return $ Right val---- | Run an action and add context to any errors-withContext :: Text -> Text -> LangchainResult a -> LangchainResult a-withContext component operation result = case result of-  Left err ->-    case errorContext err of-      Just ctx ->-        Left $-          err-            { errorContext =-                Just $-                  ErrorContext-                    { contextComponent = Just component-                    , contextOperation = Just operation-                    , contextInput = Nothing-                    , contextMetadata = []-                    , contextTimestamp = contextTimestamp ctx-                    }-            }-      Nothing -> Left err-  Right val -> Right val---- | Run an action and add context to any errors (IO version)-withContextIO :: MonadIO m => Text -> Text -> LangchainResult a -> m (LangchainResult a)-withContextIO component operation result = case result of-  Left err -> do-    now <- liftIO getCurrentTime-    return $-      Left $-        err-          { errorContext =-              Just $-                ErrorContext-                  { contextComponent = Just component-                  , contextOperation = Just operation-                  , contextInput = Nothing-                  , contextMetadata = []-                  , contextTimestamp = now-                  }-          }-  Right val -> return $ Right val

@@ -0,0 +1,143 @@+{-# 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,321 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module:      Langchain.LLM.Core-Copyright:   (c) 2025 Tushar Adhatrao-License:     MIT-Description: Core implementation of langchain LLMs-Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability:   experimental--This module provides the core types and typeclasses for the Langchain library in Haskell,-which is designed to facilitate interaction with language models (LLMs).--It defines a standardized interface that allows different LLM implementations-to be used interchangeably, promoting code reuse and modularity.--The main components include:--* The 'LLM' typeclass, which defines the interface for language models.--* Data types such as 'Message' for conversation messages,-  and 'StreamHandler' for handling streaming responses.--* Default values like 'defaultParams' and 'defaultMessageData' for convenience.--This module is intended to be used as the foundation for building applications that interact with LLMs,-providing a consistent API across different model implementations.--}-module Langchain.LLM.Core-  ( -- * LLM Typeclass-    LLM (..)--    -- * Parameters-  , Message (..)-  , Role (..)-  , ChatHistory-  , MessageData (..)-  , ToolCall (..)-  , ToolFunction (..)-  , StreamHandler (..)-  , MessageConvertible (..)--    -- * Default Values-  , defaultMessage-  , defaultMessageData-  ) where--import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson-import qualified Data.Aeson.KeyMap as KM-import Data.List.NonEmpty-import qualified Data.Map as HM-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import GHC.Generics-import Langchain.Error (LangchainResult)--{- | Callbacks for handling streaming responses from a language model.-This allows real-time processing of tokens as they are generated and an action-upon completion.--@-printHandler :: StreamHandler-printHandler = StreamHandler-  { onToken = putStrLn . ("Token: " ++)-  , onComplete = putStrLn "Streaming complete"-  }-@--}-data StreamHandler tokenType = StreamHandler-  { onToken :: tokenType -> IO ()-  -- ^ Action to perform for each token received-  , onComplete :: IO ()-  -- ^ Action to perform when streaming is complete-  }---- | Enumeration of possible roles in a conversation.-data Role-  = -- | System role, typically for instructions or context-    System-  | -- | User role, for user inputs-    User-  | -- | Assistant role, for model responses-    Assistant-  | -- | Tool role, for tool outputs or interactions-    Tool-  | -- | Developer role for developer messages. Specific to only some integrations-    Developer-  | -- | Function role for function call messages. Specific to only some integrations-    Function-  deriving-    ( Eq-    , Show-    , Generic-    , ToJSON-    , FromJSON-    )--{- | Represents a message in a conversation, including the sender's role, content,-and additional metadata.-https://python.langchain.com/docs/concepts/messages/--@-userMsg :: Message-userMsg = Message-  { role = User-  , content = "Explain functional programming"-  , messageData = defaultMessageData-  }-@--}-data Message = Message-  { role :: Role-  -- ^ The role of the message sender-  , content :: Text-  -- ^ The content of the message-  , messageData :: MessageData-  -- ^ Additional data associated with the message-  }-  deriving (Eq, Show)---- Function call details-data ToolFunction = ToolFunction-  { toolFunctionName :: Text-  , toolFunctionArguments :: HM.Map Text Value-  }-  deriving (Show, Eq)---- Main tool call structure-data ToolCall = ToolCall-  { toolCallId :: Text-  , toolCallType :: Text-  , toolCallFunction :: ToolFunction-  }-  deriving (Show, Eq)---- ToJSON instance for ToolFunction-instance ToJSON ToolFunction where-  toJSON (ToolFunction name args) =-    object-      [ "name" .= name-      , "arguments" .= args-      ]---- FromJSON instance for ToolFunction-instance FromJSON ToolFunction where-  parseJSON = withObject "ToolFunction" $ \obj -> do-    name <- obj .: "name"-    argsVal <- obj .: "arguments"-    args <- case argsVal of-      Object o -> pure $ KM.toMapText o-      String s -> case decodeStrict (encodeUtf8 s) of-        Just (Object o) -> pure $ KM.toMapText o-        _ -> fail "ToolFunction.arguments: expected object or JSON-encoded object string"-      _ -> fail "ToolFunction.arguments: expected object or string"-    return $ ToolFunction name args---- ToJSON instance for ToolCall-instance ToJSON ToolCall where-  toJSON (ToolCall callId callType func) =-    object-      [ "id" .= callId-      , "type" .= callType-      , "function" .= func-      ]---- FromJSON instance for ToolCall-instance FromJSON ToolCall where-  parseJSON = withObject "ToolCall" $ \obj -> do-    callId <- obj .: "id"-    callType <- obj .: "type"-    func <- obj .: "function"-    return $ ToolCall callId callType func--{- | Additional data for a message, such as a name or tool calls.-This type is designed for extensibility, allowing new fields to be added without-breaking changes. Use 'defaultMessageData' for typical usage.--}-data MessageData = MessageData-  { name :: Maybe Text-  -- ^ Optional name associated with the message-  , toolCalls :: Maybe [ToolCall]-  -- ^ Optional list of tool calls invoked by the message-  , messageImages :: Maybe [Text]-  -- ^ Base64 encoded image data list-  , thinking :: Maybe Text-  -- ^ Thinking-  }-  deriving (Eq, Show)---- | JSON serialization for MessageData.-instance ToJSON MessageData where-  toJSON MessageData {..} =-    object-      [ "name" .= name-      , "tool_calls" .= toolCalls-      , "images" .= messageImages-      , "thinking" .= thinking-      -- Add more fields as they are added-      ]---- | JSON deserialization for MessageData.-instance FromJSON MessageData where-  parseJSON = withObject "MessageData" $ \v ->-    MessageData-      <$> v .:? "name"-      <*> v .:? "tool_calls"-      <*> v .:? "images"-      <*> v .:? "thinking"---- | Type alias for NonEmpty Message-type ChatHistory = NonEmpty Message---- | Default message with User role and no content.-defaultMessage :: Message-defaultMessage =-  Message-    { role = User-    , content = ""-    , messageData = defaultMessageData-    }--{- | Default message data with all fields set to Nothing.-Use this for standard messages without additional metadata--}-defaultMessageData :: MessageData-defaultMessageData =-  MessageData-    { name = Nothing-    , toolCalls = Nothing-    , messageImages = Nothing-    , thinking = Nothing-    }---- | Typeclass that all ChatModels should interface with-class LLM llm where-  -- | Define the Parameter type for your LLM model.-  type LLMStreamTokenType llm--  type LLMParams llm--  {- | Invoke the language model with a single prompt.-       Suitable for simple queries; returns either an error or generated text.-  -}-  generate ::-    -- | The type of the language model instance.-    llm ->-    -- | The prompt to send to the model.-    Text ->-    -- | Optional configuration parameters.-    Maybe (LLMParams llm) ->-    IO (LangchainResult Text)--  {- | Chat with the language model using a sequence of messages.-  Suitable for multi-turn conversations; returns either an error or the response.-  -}-  chat ::-    -- | The type of the language model instance.-    llm ->-    -- | A non-empty list of messages to send to the model.-    ChatHistory ->-    -- | Optional configuration parameters.-    Maybe (LLMParams llm) ->-    -- | The result of the chat, either an error or the response text.-    IO (LangchainResult Message)--  {- | Stream responses from the language model for a sequence of messages.-  Uses callbacks to process tokens in real-time; returns either an error or unit.-  -}-  stream ::-    llm ->-    ChatHistory ->-    StreamHandler (LLMStreamTokenType llm) ->-    Maybe (LLMParams llm) ->-    IO (LangchainResult ())--  -- Default implementations--  -- | MonadIO version of generate-  generateM ::-    MonadIO m =>-    -- | The type of the language model instance.-    llm ->-    -- | The prompt to send to the model.-    Text ->-    -- | Optional configuration parameters.-    Maybe (LLMParams llm) ->-    m (LangchainResult Text)-  generateM llm prompt mbParams = liftIO $ generate llm prompt mbParams--  -- | MonadIO version of chat-  chatM ::-    MonadIO m =>-    -- | The type of the language model instance.-    llm ->-    -- | A non-empty list of messages to send to the model.-    ChatHistory ->-    -- | Optional configuration parameters.-    Maybe (LLMParams llm) ->-    -- | The result of the chat, either an error or the response text.-    m (LangchainResult Message)-  chatM llm chatHistory mbParams = liftIO $ chat llm chatHistory mbParams--  -- | MonadIO version of stream-  streamM ::-    MonadIO m =>-    llm ->-    ChatHistory ->-    StreamHandler (LLMStreamTokenType llm) ->-    Maybe (LLMParams llm) ->-    m (LangchainResult ())-  streamM llm chatHistory sHandler mbParams =-    liftIO $ stream llm chatHistory sHandler mbParams--class MessageConvertible a where-  to :: Message -> a-  from :: a -> Message