langchain-hs-core 0.0.5.0 → 0.0.6.0

raw patch · 89 files changed

+9319/−1237 lines, 89 filesdep +directorydep +filepathdep +format-heavydep −deepseqdep ~resourcetPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, filepath, format-heavy, process, random, scientific, sqlite-simple

Dependencies removed: deepseq

Dependency ranges changed: resourcet

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +35/−11
• langchain-hs-core.cabal +88/−17
• src/Langchain/Agent.hs +18/−0
• src/Langchain/Agent/PlanAndExecute.hs +215/−0
• src/Langchain/Agent/ReAct.hs +481/−0
• src/Langchain/Cache.hs +15/−0
• src/Langchain/Cache/Core.hs +203/−0
• src/Langchain/Callback.hs +15/−0
• src/Langchain/Callback/Manager.hs +100/−0
• src/Langchain/Chain.hs +15/−0
• src/Langchain/Chain/RetrievalQA.hs +75/−0
• src/Langchain/Core/Error.hs +0/−178
• src/Langchain/Core/Model.hs +0/−53
• src/Langchain/Core/Model/Types.hs +0/−199
• src/Langchain/Core/Monad.hs +0/−55
• src/Langchain/Core/Runnable.hs +0/−194
• src/Langchain/Core/Stream.hs +0/−169
• src/Langchain/Core/Tool.hs +0/−65
• src/Langchain/DocumentLoader.hs +17/−0
• src/Langchain/DocumentLoader/Core.hs +77/−0
• src/Langchain/DocumentLoader/DirectoryLoader.hs +120/−0
• src/Langchain/DocumentLoader/FileLoader.hs +55/−0
• src/Langchain/Embeddings.hs +38/−0
• src/Langchain/Embeddings/Core.hs +13/−0
• src/Langchain/Error.hs +190/−0
• src/Langchain/Guardrail.hs +16/−0
• src/Langchain/Guardrail/Core.hs +143/−0
• src/Langchain/Memory.hs +33/−0
• src/Langchain/Memory/Combined.hs +49/−0
• src/Langchain/Memory/Core.hs +455/−0
• src/Langchain/Memory/Entity.hs +103/−0
• src/Langchain/Memory/Session.hs +159/−0
• src/Langchain/Memory/Summary.hs +134/−0
• src/Langchain/Model.hs +53/−0
• src/Langchain/Model/Types.hs +200/−0
• src/Langchain/Monad.hs +55/−0
• src/Langchain/Observability.hs +275/−0
• src/Langchain/OutputParser.hs +18/−0
• src/Langchain/OutputParser/Core.hs +84/−0
• src/Langchain/OutputParser/Structured.hs +279/−0
• src/Langchain/Prelude.hs +382/−0
• src/Langchain/PromptTemplate.hs +17/−0
• src/Langchain/PromptTemplate/Prompt.hs +104/−0
• src/Langchain/PromptTemplate/String.hs +110/−0
• src/Langchain/Resilience.hs +18/−0
• src/Langchain/Resilience/CircuitBreaker.hs +119/−0
• src/Langchain/Resilience/Retry.hs +114/−0
• src/Langchain/Retriever.hs +20/−0
• src/Langchain/Retriever/BM25.hs +151/−0
• src/Langchain/Retriever/Core.hs +66/−0
• src/Langchain/Retriever/Hybrid.hs +155/−0
• src/Langchain/Runnable.hs +273/−0
• src/Langchain/Stream.hs +169/−0
• src/Langchain/TextSplitter/Character.hs +111/−0
• 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.hs +65/−0
• src/Langchain/Tool/Binding.hs +49/−0
• src/Langchain/Tool/Checkpoint.hs +308/−0
• src/Langchain/Tool/Core.hs +17/−0
• src/Langchain/Tool/FileSystem.hs +914/−0
• src/Langchain/Tool/GenericSchema.hs +175/−0
• src/Langchain/Tool/Process.hs +473/−0
• src/Langchain/Tool/Security.hs +304/−0
• src/Langchain/Tool/Shell.hs +87/−0
• src/Langchain/VectorStore.hs +15/−0
• src/Langchain/VectorStore/Core.hs +56/−0
• src/Langchain/VectorStore/InMemory.hs +99/−0
• test/Spec.hs +15/−5
• test/Test/Langchain/Callback.hs +27/−0
• test/Test/Langchain/Core/Model.hs +0/−60
• test/Test/Langchain/Core/Monad.hs +0/−30
• test/Test/Langchain/Core/Runnable.hs +0/−100
• test/Test/Langchain/Core/Stream.hs +0/−33
• test/Test/Langchain/Core/TestModel.hs +0/−29
• test/Test/Langchain/Core/Tool.hs +0/−39
• test/Test/Langchain/Model.hs +60/−0
• test/Test/Langchain/Monad.hs +30/−0
• test/Test/Langchain/Observability.hs +79/−0
• test/Test/Langchain/PromptTemplate.hs +68/−0
• test/Test/Langchain/Resilience.hs +65/−0
• test/Test/Langchain/Retriever.hs +82/−0
• test/Test/Langchain/Runnable.hs +100/−0
• test/Test/Langchain/Stream.hs +33/−0
• test/Test/Langchain/TestModel.hs +29/−0
• test/Test/Langchain/Tool.hs +39/−0

@@ -2,6 +2,11 @@  All notable changes to this package will be documented in this file. +## 0.0.6.0 - 2026-10-02++- Updated bounds for GHC 9.12 and modern Stackage LTS releases.+- Standalone stack configuration and verified test suite.+ ## 0.0.5.0 - 2026-09-10  - Initial standalone Hackage release of `langchain-hs-core`.

@@ -1,24 +1,48 @@ # `langchain-hs-core` -> Zero-dependency pure core of the `langchain-hs` ecosystem.+> The foundational, effect-polymorphic core framework of the `langchain-hs` AI ecosystem. -`langchain-hs-core` provides pure GADT abstract syntax trees, effect-polymorphic chat models, streaming protocols, tools, and decoupled monads without ANY HTTP or network dependencies.+`langchain-hs-core` provides pure GADT abstract syntax trees, effect-polymorphic chat models, streaming protocols, tools, agents, vector stores, retrievers, document loaders, memory, cache, output parsers, guardrails, resilience, observability, and the canonical `Langchain.Prelude` without concrete provider-specific dependencies. -## Key Primitives+## Key Primitives & Modules -- **`RunnableTree m a b`**: Pure GADT abstract syntax tree for pipeline composition via `|>>` (sequential), `&>&` (parallel), and `>>>#` (fallback).-- **`ChatModel m`**: Effect-polymorphic typeclass for LLMs.-- **`ContentBlock`**: Multi-modal message content (text, image, tool calls, tool results).-- **`Tool` & `FunctionDefinition`**: Strongly-typed tool execution and JSON parameter schemas.-- **`StreamEvent` & `LLMChunk`**: Conduit-based incremental token streaming.-- **`LangchainT env m a`**: Decoupled reader monad transformer parameterized over custom environment `env`.+- **Runnables & Pure ASTs (`Langchain.Runnable`)**: Pure GADT abstract syntax tree (`RunnableTree m i o`) for pipeline composition via `|>>` (sequential), `&>&` (parallel fan-out), `runLambda`, `runPrim`, and deferred evaluation via `interpret`.+- **Chat Models & Types (`Langchain.Model`, `Langchain.Model.Types`)**: Effect-polymorphic `ChatModel` typeclass, `Message`, `Role`, `ContentBlock` (multi-modal text, images, tool calls, tool results).+- **Streaming Protocols (`Langchain.Stream`)**: Conduit-based incremental token streaming via `StreamEvent` and `LLMChunk`.+- **Tools & Dynamic Calling (`Langchain.Tool`, `Langchain.Tool.Binding`)**: Effect-polymorphic `Tool m`, `createTool`, Generic Schemas, and built-in tools (`Calculator`, `FileSystem`, `Shell`). Provider-agnostic tool binding via `ToolBinder`.+- **Agents (`Langchain.Agent.ReAct`, `Langchain.Agent.PlanAndExecute`)**:+  - **ReAct Agent**: Full reasoning + acting agent loop with tool inspection, memory integration, callbacks, and step traces.+  - **Plan-and-Execute Agent**: Two-phase agent decomposing complex user goals into discrete execution plans.+- **Prompt Templates (`Langchain.PromptTemplate`)**: String prompt templates with `{var}` f-string interpolation and pre-bound partial variables.+- **Vector Stores (`Langchain.VectorStore`)**: Abstract `VectorStore` typeclass and thread-safe `InMemoryVectorStore`.+- **Retrievers (`Langchain.Retriever`)**: BM25 keyword search (`BM25Retriever`), vector similarity retriever, and Reciprocal Rank Fusion (`HybridRetriever`).+- **Document Loaders & Text Splitters (`Langchain.DocumentLoader`, `Langchain.TextSplitter`)**: `Document` metadata abstraction and splitters for character chunks, Markdown, programming code, and tokens.+- **Memory & Cache (`Langchain.Memory`, `Langchain.Cache`)**: `BaseMemory`, `ConversationBufferMemory`, `WindowBufferMemory`, and STM-backed in-memory `LLMCache`.+- **Output Parsers (`Langchain.OutputParser`)**: Strongly typed JSON Schema generation (`JsonOutputParser`) and structured parsing.+- **Guardrails & Safety (`Langchain.Guardrails`)**: Input and output content moderation, PII redaction, and semantic safety validations.+- **Resilience & Fault Tolerance (`Langchain.Resilience`)**: State-machine `CircuitBreaker`, exponential backoff `RetryConfig`, and fallback handlers.+- **Observability & Tracing (`Langchain.Observability`, `Langchain.Callback`)**: OpenTelemetry distributed tracing spans, structured JSON event logging, and lifecycle event callbacks.+- **Chains (`Langchain.Chain.RetrievalQA`)**: End-to-end question answering pipeline over indexed knowledge bases.+- **Langchain Monad (`Langchain.Monad`)**: Decoupled `LangchainT env m a` reader and error transformer.+- **Canonical Prelude (`Langchain.Prelude`)**: Batteries-included single-import entry point providing the full core framework API.  ## Installation +Add to your `cabal` or `package.yaml` dependencies:+ ```cabal-build-depends: langchain-hs-core >= 0.0.5 && < 0.0.6+build-depends:+    langchain-hs-core >= 0.0.6.0 && < 0.0.7.0 ``` +To connect concrete LLMs, combine with satellite provider packages:+- `langchain-hs-ollama`: Local & offline models (Llama 3, DeepSeek, Gemma).+- `langchain-hs-openai`: OpenAI, OpenRouter, and OpenAI-compatible cloud endpoints.+- `langchain-hs-gemini`: Google Gemini with multi-modal support.+- `langchain-hs-mcp`: Model Context Protocol tool client.++For cyclic state machines, checkpointers, and multi-agent coordination, add `langchain-hs-graph` (or use the umbrella `langchain-hs` package).+ ## License -MIT License. See [LICENSE](LICENSE).+Distributed under the **MIT License**. See [LICENSE](LICENSE) for details.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           langchain-hs-core-version:        0.0.5.0+version:        0.0.6.0 synopsis:       Core typeclasses and pure AST primitives for langchain-hs description:    Zero HTTP dependency core package containing ChatModel, RunnableTree, ContentBlock, Tool, and StreamEvent primitives. category:       Web, AI, Control@@ -31,13 +31,67 @@  library   exposed-modules:-      Langchain.Core.Error-      Langchain.Core.Model-      Langchain.Core.Model.Types-      Langchain.Core.Monad-      Langchain.Core.Stream-      Langchain.Core.Runnable-      Langchain.Core.Tool+      Langchain.Error+      Langchain.Model+      Langchain.Model.Types+      Langchain.Monad+      Langchain.Stream+      Langchain.Runnable+      Langchain.Tool+      Langchain.Tool.Binding+      Langchain.Tool.Checkpoint+      Langchain.Tool.Core+      Langchain.Tool.FileSystem+      Langchain.Tool.GenericSchema+      Langchain.Tool.Process+      Langchain.Tool.Security+      Langchain.Tool.Shell+      Langchain.Embeddings+      Langchain.Embeddings.Core+      Langchain.DocumentLoader+      Langchain.DocumentLoader.Core+      Langchain.DocumentLoader.DirectoryLoader+      Langchain.DocumentLoader.FileLoader+      Langchain.TextSplitter.Character+      Langchain.TextSplitter.Code+      Langchain.TextSplitter.Markdown+      Langchain.TextSplitter.RecursiveCharacter+      Langchain.TextSplitter.Token+      Langchain.VectorStore+      Langchain.VectorStore.Core+      Langchain.VectorStore.InMemory+      Langchain.PromptTemplate+      Langchain.PromptTemplate.Prompt+      Langchain.PromptTemplate.String+      Langchain.Observability+      Langchain.Callback+      Langchain.Callback.Manager+      Langchain.Retriever+      Langchain.Retriever.Core+      Langchain.Retriever.BM25+      Langchain.Retriever.Hybrid+      Langchain.Resilience+      Langchain.Resilience.CircuitBreaker+      Langchain.Resilience.Retry+      Langchain.Memory+      Langchain.Memory.Core+      Langchain.Memory.Summary+      Langchain.Memory.Session+      Langchain.Memory.Entity+      Langchain.Memory.Combined+      Langchain.Cache+      Langchain.Cache.Core+      Langchain.OutputParser+      Langchain.OutputParser.Core+      Langchain.OutputParser.Structured+      Langchain.Chain+      Langchain.Chain.RetrievalQA+      Langchain.Agent+      Langchain.Agent.ReAct+      Langchain.Agent.PlanAndExecute+      Langchain.Guardrail+      Langchain.Guardrail.Core+      Langchain.Prelude   other-modules:       Paths_langchain_hs_core   hs-source-dirs:@@ -62,9 +116,15 @@     , bytestring >=0.10 && <0.13     , conduit ==1.3.*     , containers >=0.6 && <0.9-    , deepseq >=1.4 && <1.6+    , directory ==1.3.*+    , filepath >=1.4 && <2+    , format-heavy ==0.1.*     , mtl >=2.2 && <2.4+    , process ==1.6.*+    , random >=1.2 && <1.4     , resourcet >=1.2 && <1.4+    , scientific ==0.3.*+    , sqlite-simple >=0.4.18 && <0.5     , stm ==2.5.*     , text >=1.2 && <3     , time >=1.9 && <1.15@@ -74,12 +134,17 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Test.Langchain.Core.Model-      Test.Langchain.Core.Monad-      Test.Langchain.Core.Runnable-      Test.Langchain.Core.Stream-      Test.Langchain.Core.TestModel-      Test.Langchain.Core.Tool+      Test.Langchain.Callback+      Test.Langchain.Model+      Test.Langchain.Monad+      Test.Langchain.Observability+      Test.Langchain.PromptTemplate+      Test.Langchain.Resilience+      Test.Langchain.Retriever+      Test.Langchain.Runnable+      Test.Langchain.Stream+      Test.Langchain.TestModel+      Test.Langchain.Tool       Paths_langchain_hs_core   hs-source-dirs:       test@@ -105,10 +170,16 @@     , bytestring >=0.10 && <0.13     , conduit ==1.3.*     , containers >=0.6 && <0.9-    , deepseq >=1.4 && <1.6+    , directory ==1.3.*+    , filepath >=1.4 && <2+    , format-heavy ==0.1.*     , langchain-hs-core     , mtl >=2.2 && <2.4-    , resourcet+    , process ==1.6.*+    , random >=1.2 && <1.4+    , resourcet >=1.2 && <1.4+    , scientific ==0.3.*+    , sqlite-simple >=0.4.18 && <0.5     , stm ==2.5.*     , tasty >=1.4     , tasty-hunit >=0.10

@@ -0,0 +1,18 @@+{- |+Module      : Langchain.Agent+Description : Autonomous agents+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Autonomous agent architectures including ReAct (Reasoning and Acting)+and Plan-and-Execute multi-step workflows.+-}+module Langchain.Agent+  ( module Langchain.Agent.ReAct+  , module Langchain.Agent.PlanAndExecute+  ) where++import Langchain.Agent.PlanAndExecute+import Langchain.Agent.ReAct

@@ -0,0 +1,215 @@+{-# 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, defaultReActAgent, runReActAgent)+import Langchain.Error (LangchainError, agentError)+import Langchain.Model+  ( ChatModel (..)+  , extractMessageText+  , userMessage+  )+import Langchain.OutputParser.Structured (StructuredOutput, TypeSchema, structuredInvoke)+import Langchain.Tool (Tool)+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 ::+    -- | Step executor instance (agent, model with tools, or custom runner)+    e ->+    -- | Step instruction prompt to execute+    Text ->+    -- | Textual result produced by executing the step+    m Text++instance+  {-# OVERLAPPING #-}+  (ToolBinder model n, MonadIO n, MonadError LangchainError n) =>+  StepExecutor (ReActAgent model n) n+  where+  executeStep agent prompt = do+    msg <- runReActAgent agent [userMessage prompt]+    pure $ extractMessageText msg++instance+  {-# OVERLAPPING #-}+  (ToolBinder model n, MonadIO n, MonadError LangchainError n) =>+  StepExecutor (model, [Tool n]) n+  where+  executeStep (model, tools) =+    executeStep (defaultReActAgent model tools)++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 ::+  -- | LLM model responsible for creating the execution plan+  planner ->+  -- | StepExecutor instance used to carry out each plan step+  executor ->+  -- | Optional custom prompt template for the planner+  Maybe Text ->+  -- | Configured PlanAndExecuteAgent instance+  PlanAndExecuteAgent planner executor+newPlanAndExecuteAgent = PlanAndExecuteAgent++-- | Construct a PlanAndExecuteAgent with tools using a ReActAgent as the step executor+newPlanAndExecuteAgentWithTools ::+  -- | LLM model responsible for creating the execution plan+  planner ->+  -- | LLM model for the ReAct step executor+  model ->+  -- | Available tools for the ReAct step executor+  [Tool m] ->+  -- | Optional custom prompt template for the planner+  Maybe Text ->+  -- | Configured PlanAndExecuteAgent with tool-enabled ReAct executor+  PlanAndExecuteAgent planner (ReActAgent model m)+newPlanAndExecuteAgentWithTools planner model tools =+  PlanAndExecuteAgent planner (defaultReActAgent 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) =>+  -- | Configured PlanAndExecuteAgent instance+  PlanAndExecuteAgent planner executor ->+  -- | High-level user goal to plan and solve+  Text ->+  -- | Final synthesized answer solving the user goal+  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)])

@@ -0,0 +1,481 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++{- |+Module      : Langchain.Agent.ReAct+Description : Effect-polymorphic ReAct (Reasoning + Acting) Agent+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++ReAct (Reasoning and Acting) agent loop that supports:++* __Effect-polymorphic tools__: Tools operate in the agent's monad @m@.+* __Memory integration__: Pluggable 'BaseMemory' via 'withMemory'.+* __Model-specific configs__: Merged with tool definitions via 'withModelConfig'.+* __Observability__: Lifecycle hooks via 'withCallbackManager'.+* __Error resilience__: Configurable 'ToolErrorStrategy'.+* __Iteration limits__: Prevents infinite loops via 'withMaxIterations'.+* __Early stop conditions__: User-defined stopping predicates via 'withStopCondition'.+* __Reasoning traces__: Inspection via 'runReActAgentWithTrace'.++=== Quick Start++@+let tools = [shellTool]+let agent = defaultReActAgent model tools+result <- runReActAgent agent [userMessage "What is 2+2?"]+@++=== With Memory and Tracing++@+mem <- newWindowBufferMemory 10 []+let agent =+      withMemory mem $+        withSystemPrompt "You are a helpful math tutor." $+          defaultReActAgent model tools+trace <- runReActAgentWithTrace agent [userMessage "What is the square root of 144?"]+@+-}+module Langchain.Agent.ReAct+  ( -- * Core Types+    AgentStep (..)+  , AgentTrace (..)+  , ReActAgent (..)+  , ToolErrorStrategy (..)++    -- * Construction+  , defaultReActAgent++    -- * Configuration (builder-style)+  , withMemory+  , withoutMemory+  , withSystemPrompt+  , withMaxIterations+  , withModelConfig+  , withCallbackManager+  , withStopCondition+  , withToolErrorStrategy++    -- * Execution+  , reactStep+  , runReActAgent+  , runReActAgentWithTrace+  ) where++import Control.Monad (forM, when)+import Control.Monad.Except (MonadError, catchError, throwError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.List (find)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock (diffUTCTime, getCurrentTime)++import Langchain.Callback.Manager (CallbackEvent (..), CallbackManager, dispatchEvent)+import Langchain.Error (LangchainError, agentError, errorMessage)+import Langchain.Memory.Core (BaseMemory (..), SomeMemory (..))+import Langchain.Model+import qualified Langchain.Model.Types as M+import Langchain.Tool+import Langchain.Tool.Binding (ToolBinder (..))++-- | How the agent handles tool execution failures.+data ToolErrorStrategy+  = -- | Feed the error message back to the LLM as a Tool observation so it can retry or recover.+    ContinueOnError+  | -- | Abort the entire agent loop immediately on any tool error.+    FailOnError+  deriving (Eq, Show)++-- | A single step in the ReAct reasoning chain.+data AgentStep+  = -- | The model decided to call one or more tools.+    AgentAction Message [ToolCall]+  | -- | The model produced a final answer (no tool calls).+    AgentFinish Message+  deriving (Eq, Show)++-- | Complete reasoning trace: intermediate steps + final answer.+data AgentTrace = AgentTrace+  { traceSteps :: [(AgentStep, [Message])]+  -- ^ Each pair is (the step, observation messages produced)+  , traceFinalAnswer :: Message+  -- ^ The final answer message+  }+  deriving (Eq, Show)++{- | ReAct Agent configuration.++Holds the LLM model, the effect-polymorphic tools @[Tool m]@, and optional+configuration for memory, callbacks, iterations, model config, and error strategy.+Use 'defaultReActAgent' to construct, then configure with the @with*@ builder functions.+-}+data ReActAgent model m = ReActAgent+  { agentModel :: model+  -- ^ The LLM model backing this agent+  , agentTools :: [Tool m]+  -- ^ Available tools the agent can invoke in monad @m@+  , agentMaxIterations :: Int+  -- ^ Maximum reasoning iterations before giving up (default: 100)+  , agentSystemPrompt :: Maybe Text+  -- ^ Optional system prompt prepended to every invocation+  , agentModelConfig :: Maybe (ModelConfig model)+  -- ^ Optional provider-specific model configuration (temperature, top_p, etc.)+  , agentMemory :: Maybe SomeMemory+  -- ^ Optional 'BaseMemory' for persistent conversation history+  , agentCallbackManager :: Maybe CallbackManager+  -- ^ Optional callback manager for observability hooks+  , agentStopCondition :: Maybe (Message -> Bool)+  -- ^ Optional early-stop predicate checked after each LLM response+  , agentToolErrorStrategy :: ToolErrorStrategy+  -- ^ How to handle tool execution errors (default: 'ContinueOnError')+  }++{- | Construct a ReAct agent with sensible defaults.++All optional fields start as 'Nothing' / defaults. Use the @with*@ functions to configure.+-}+defaultReActAgent ::+  -- | The LLM chat model backing this agent+  model ->+  -- | Available effect-polymorphic tools+  [Tool m] ->+  -- | Initialized ReActAgent with default settings+  ReActAgent model m+defaultReActAgent model tools =+  ReActAgent+    { agentModel = model+    , agentTools = tools+    , agentMaxIterations = 100+    , agentSystemPrompt = Nothing+    , agentModelConfig = Nothing+    , agentMemory = Nothing+    , agentCallbackManager = Nothing+    , agentStopCondition = Nothing+    , agentToolErrorStrategy = ContinueOnError+    }++{- | Attach a 'BaseMemory' instance for persistent conversation history.++When memory is set, 'runReActAgent' will:++1. Load existing messages from memory before the first LLM call.+2. Save the user query + final answer to memory after completion.+-}+withMemory ::+  (BaseMemory mem) =>+  -- | BaseMemory instance to store conversation messages+  mem ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with persistent memory+  ReActAgent model m+withMemory mem agent = agent {agentMemory = Just (SomeMemory mem)}++-- | Remove memory from the agent.+withoutMemory ::+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent with memory detached+  ReActAgent model m+withoutMemory agent = agent {agentMemory = Nothing}++-- | Set the system prompt that instructs the agent's persona and behavior.+withSystemPrompt ::+  -- | System instructions / persona text+  Text ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with system prompt+  ReActAgent model m+withSystemPrompt prompt agent = agent {agentSystemPrompt = Just prompt}++-- | Override the maximum number of reasoning iterations (default: 10).+withMaxIterations ::+  -- | Maximum reasoning loop iterations before aborting+  Int ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with iteration limit+  ReActAgent model m+withMaxIterations n agent = agent {agentMaxIterations = n}++{- | Attach a provider-specific model configuration (temperature, top_p, etc.).++This config is merged with the tool-binding config on every 'invoke' call,+giving you full control over LLM parameters without losing tool support.+-}+withModelConfig ::+  -- | Provider-specific model configuration (temperature, top_p, etc.)+  Maybe (ModelConfig model) ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with model options+  ReActAgent model m+withModelConfig cfg agent = agent {agentModelConfig = cfg}++{- | Attach a 'CallbackManager' for observability.++When set, the agent emits 'OnToolStart' / 'OnToolEnd' / 'OnError' events+for each tool invocation in the reasoning loop.+-}+withCallbackManager ::+  -- | Callback manager for observability event hooks+  CallbackManager ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with callback manager+  ReActAgent model m+withCallbackManager mgr agent = agent {agentCallbackManager = Just mgr}++{- | Set a custom stop condition checked after each LLM response.++If the predicate returns 'True' for the LLM's response message, the agent+immediately returns that message as the final answer, even if the LLM+included tool calls.+-}+withStopCondition ::+  -- | Predicate checked after each LLM response for early exit+  (Message -> Bool) ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with custom stopping condition+  ReActAgent model m+withStopCondition cond agent = agent {agentStopCondition = Just cond}++{- | Set the tool error handling strategy.++* 'ContinueOnError' (default): feed error text back to the LLM as a Tool observation.+* 'FailOnError': abort the entire agent loop on the first tool error.+-}+withToolErrorStrategy ::+  -- | Strategy on tool failure ('ContinueOnError' or 'FailOnError')+  ToolErrorStrategy ->+  -- | Current agent instance+  ReActAgent model m ->+  -- | Agent configured with error handling strategy+  ReActAgent model m+withToolErrorStrategy strategy agent = agent {agentToolErrorStrategy = strategy}++{- | Run a single step of ReAct reasoning.++Sends the current message history (with tools bound) to the LLM and+classifies the response as either 'AgentAction' (tool calls requested)+or 'AgentFinish' (final answer).+-}+reactStep ::+  forall model m.+  (ToolBinder model m, MonadIO m, MonadError LangchainError m) =>+  -- | The chat model to invoke+  model ->+  -- | Available tools to bind to the model+  [Tool m] ->+  -- | Current conversation message history+  [Message] ->+  -- | Optional provider-specific model configuration+  Maybe (ModelConfig model) ->+  -- | Step classification: 'AgentAction' or 'AgentFinish'+  m AgentStep+reactStep model tools history userCfg = do+  let toolCfg = bindToolsConfig @model tools userCfg+  responseMsg <- invoke model history toolCfg+  case messageToolCalls responseMsg of+    Just tcs@(_ : _) -> pure $ AgentAction responseMsg tcs+    _ -> pure $ AgentFinish responseMsg++{- | Execute the full ReAct reasoning loop, returning only the final answer.++For the full reasoning trace, use 'runReActAgentWithTrace'.++When the agent has a 'BaseMemory' attached:++1. Existing conversation history is loaded from memory.+2. The user's input messages are appended.+3. After the loop finishes, both the user input and final answer are saved to memory.+-}+runReActAgent ::+  forall model m.+  (ToolBinder model m, MonadIO m, MonadError LangchainError m) =>+  -- | Configured ReAct agent instance+  ReActAgent model m ->+  -- | Input user messages for this turn+  [Message] ->+  -- | The final assistant answer message+  m Message+runReActAgent agent userMsgs = traceFinalAnswer <$> runReActAgentWithTrace agent userMsgs++{- | Execute the full ReAct reasoning loop, returning both the final answer+and the complete intermediate reasoning trace.++Tool calls within a single step are executed in sequence within the @m@ monad,+and the observations are fed back to the LLM for the next reasoning step.++The trace includes every 'AgentStep' and the observation messages produced+at each iteration, which is invaluable for debugging and observability.+-}+runReActAgentWithTrace ::+  forall model m.+  (ToolBinder model m, MonadIO m, MonadError LangchainError m) =>+  -- | Configured ReAct agent instance+  ReActAgent model m ->+  -- | Input user messages for this turn+  [Message] ->+  -- | Full reasoning trace containing all intermediate steps and final answer+  m AgentTrace+runReActAgentWithTrace ReActAgent {..} userMsgs = do+  -- 1. Build initial history: system prompt + memory + user messages+  memoryMsgs <- case agentMemory of+    Nothing -> pure []+    Just (SomeMemory mem) -> messages mem++  -- When an explicit agent system prompt is provided, avoid duplicate system prompts+  -- by stripping any default system prompt that may already exist in memory.+  let memWithoutSystem = case agentSystemPrompt of+        Just _ -> filter (\m -> messageRole m /= System) memoryMsgs+        Nothing -> memoryMsgs+      sysPrefix = maybe [] (\p -> [systemMessage p]) agentSystemPrompt+      initialHistory = sysPrefix ++ memWithoutSystem ++ userMsgs++  when (null initialHistory) $+    throwError $+      agentError+        "Cannot invoke ReAct agent with empty message history (no user query, memory, or system prompt)"+        (Just "ReActAgent")+        (Just "runReActAgentWithTrace")++  -- 2. Run the reasoning loop+  trace <- go initialHistory agentMaxIterations []++  -- 3. Persist to memory if available+  case agentMemory of+    Nothing -> pure ()+    Just (SomeMemory mem) -> do+      -- Save each user message+      mapM_ (addMessage mem) userMsgs+      -- Save the final answer+      addMessage mem (traceFinalAnswer trace)++  pure trace+  where+    go :: [Message] -> Int -> [(AgentStep, [Message])] -> m AgentTrace+    go history maxIter accSteps+      | maxIter <= 0 = do+          let maxErr =+                "ReAct Agent exceeded maximum iterations ("+                  <> T.pack (show agentMaxIterations)+                  <> ")"+          case agentCallbackManager of+            Nothing -> pure ()+            Just mgr -> do+              now <- liftIO getCurrentTime+              dispatchEvent mgr (OnError "ReActAgent" maxErr now)+          throwError $+            agentError+              maxErr+              (Just "ReActAgent")+              (Just "runReActAgent")+      | otherwise = do+          -- Dispatch OnLLMStart callback before calling model+          llmStartTime <- liftIO getCurrentTime+          case agentCallbackManager of+            Nothing -> pure ()+            Just mgr ->+              dispatchEvent mgr (OnLLMStart "ReActAgent" (map extractMessageText history) llmStartTime)++          -- Invoke the model with error interception for observability+          eStep <-+            (Right <$> reactStep agentModel agentTools history agentModelConfig)+              `catchError` (pure . Left)+          llmEndTime <- liftIO getCurrentTime+          let llmLatency = round (realToFrac (diffUTCTime llmEndTime llmStartTime) * 1000000 :: Double) :: Int+          case eStep of+            Left err -> do+              case agentCallbackManager of+                Nothing -> pure ()+                Just mgr ->+                  dispatchEvent mgr (OnError "ReActAgent" (errorMessage err) llmEndTime)+              throwError err+            Right step -> case step of+              AgentFinish finalMsg -> do+                case agentCallbackManager of+                  Nothing -> pure ()+                  Just mgr ->+                    dispatchEvent mgr (OnLLMEnd "ReActAgent" (extractMessageText finalMsg) llmLatency llmEndTime)+                let allSteps = accSteps ++ [(step, [])]+                pure $ AgentTrace allSteps finalMsg+              AgentAction respMsg tcs -> do+                case agentCallbackManager of+                  Nothing -> pure ()+                  Just mgr ->+                    dispatchEvent mgr (OnLLMEnd "ReActAgent" (extractMessageText respMsg) llmLatency llmEndTime)++                -- Check custom stop condition+                case agentStopCondition of+                  Just cond | cond respMsg -> do+                    let allSteps = accSteps ++ [(step, [])]+                    pure $ AgentTrace allSteps respMsg+                  _ -> do+                    obsMsgs <- forM tcs executeTool+                    let newHistory = history ++ [respMsg] ++ obsMsgs+                        newSteps = accSteps ++ [(step, obsMsgs)]+                    go newHistory (maxIter - 1) newSteps++    executeTool :: ToolCall -> m Message+    executeTool tc = do+      let tName = toolCallName tc+      case agentCallbackManager of+        Nothing -> pure ()+        Just mgr -> do+          now <- liftIO getCurrentTime+          dispatchEvent mgr (OnToolStart tName (toolCallArguments tc) now)++      case find (\t -> toolName t == tName) agentTools of+        Nothing -> do+          let notFoundMsg = "Error: Tool not found: " <> tName+          case agentCallbackManager of+            Nothing -> pure ()+            Just mgr -> do+              now <- liftIO getCurrentTime+              dispatchEvent mgr (OnError tName notFoundMsg now)+          when (agentToolErrorStrategy == FailOnError) $+            throwError $+              agentError notFoundMsg (Just "ReActAgent") (Just $ "executeTool:" <> tName)+          pure $+            (textMessage M.Tool notFoundMsg)+              { M.messageName = Just tName+              , M.messageToolId = Just (toolCallId tc)+              }+        Just tool -> do+          startTime <- liftIO getCurrentTime+          eRes <- toolExecute tool (toolCallArguments tc)+          endTime <- liftIO getCurrentTime+          let durationMicros = round (realToFrac (diffUTCTime endTime startTime) * 1000000 :: Double) :: Int+          case eRes of+            Left err -> do+              let errTxt = "Error executing tool " <> tName <> ": " <> errorMessage err+              case agentCallbackManager of+                Nothing -> pure ()+                Just mgr -> dispatchEvent mgr (OnError tName errTxt endTime)+              when (agentToolErrorStrategy == FailOnError) $+                throwError $+                  agentError errTxt (Just "ReActAgent") (Just $ "executeTool:" <> tName)+              pure $+                (textMessage M.Tool errTxt)+                  { M.messageName = Just tName+                  , M.messageToolId = Just (toolCallId tc)+                  }+            Right outTxt -> do+              case agentCallbackManager of+                Nothing -> pure ()+                Just mgr -> dispatchEvent mgr (OnToolEnd tName outTxt durationMicros endTime)+              pure $+                (textMessage M.Tool outTxt)+                  { M.messageName = Just tName+                  , M.messageToolId = Just (toolCallId tc)+                  }

@@ -0,0 +1,15 @@+{- |+Module      : Langchain.Cache+Description : LLM response caching layer+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Transparent caching for ChatModel invocations with in-memory and SQLite backends.+-}+module Langchain.Cache+  ( module Langchain.Cache.Core+  ) where++import Langchain.Cache.Core

@@ -0,0 +1,203 @@+{-# 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.Text (Text)+import qualified Data.Text as TS+import qualified Data.Text.Encoding as TE+import Database.SQLite.Simple+import Langchain.Model+  ( ChatModel (..)+  , Message (..)+  )+import Langchain.Tool.Binding (ToolBinder (..))++-- | 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.++Instances for the built-in providers live in their respective sub-packages:++  * @langchain-hs-openai@: @CacheableChatModel OpenAI@+  * @langchain-hs-ollama@: @CacheableChatModel Ollama@+  * @langchain-hs-gemini@: @CacheableChatModel Gemini@+-}+class (ChatModel model) => CacheableChatModel model where+  -- | Return the JSON identity used to distinguish this model's cache entries.+  cacheModelIdentity :: model -> Maybe (ModelConfig model) -> Value++{- | Compute a canonical cache key from a model identity and complete input messages.++The key includes all fields of each t'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

@@ -0,0 +1,15 @@+{- |+Module      : Langchain.Callback+Description : Typed event-driven callback system+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Typed event-driven callback system with synchronous and asynchronous dispatch.+-}+module Langchain.Callback+  ( module Langchain.Callback.Manager+  ) where++import Langchain.Callback.Manager

@@ -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,15 @@+{- |+Module      : Langchain.Chain+Description : LLM chains+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Chains combining retrieval, prompt templates, and chat models.+-}+module Langchain.Chain+  ( module Langchain.Chain.RetrievalQA+  ) where++import Langchain.Chain.RetrievalQA

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

@@ -1,178 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.Core.Error-Description : Core structured error types and context metadata-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Structured error handling without String-based error dropping.--}-module Langchain.Core.Error-  ( LangchainError (..)-  , ErrorContext (..)-  , LangchainResult-  , errorMessage-  , mkContext-  , mkContextIO-  , llmError-  , agentError-  , memoryError-  , toolError-  , vectorStoreError-  , documentLoaderError-  , embeddingError-  , runnableError-  , parsingError-  , networkError-  , configurationError-  , validationError-  , internalError-  ) where--import Control.DeepSeq (NFData)-import Control.Exception (Exception (..))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (FromJSON, ToJSON)-import Data.Map (Map)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time (UTCTime, getCurrentTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import GHC.Generics (Generic)---- | Detailed context metadata attached to every error.-data ErrorContext = ErrorContext-  { component :: Text-  , operation :: Text-  , timestamp :: UTCTime-  , details :: Map Text Text-  }-  deriving (Show, Eq, Generic, ToJSON, FromJSON, NFData)---- | Pure context constructor.-mkContext :: Text -> Text -> Map Text Text -> ErrorContext-mkContext comp op = ErrorContext comp op (posixSecondsToUTCTime 0)---- | IO context constructor with real timestamp.-mkContextIO :: MonadIO m => Text -> Text -> Map Text Text -> m ErrorContext-mkContextIO comp op dt = do-  now <- liftIO getCurrentTime-  pure $ ErrorContext comp op now dt---- | Core framework error type.-data LangchainError-  = LLMError Text (Maybe ErrorContext)-  | AgentError Text (Maybe ErrorContext)-  | MemoryError Text (Maybe ErrorContext)-  | ToolError Text (Maybe ErrorContext)-  | VectorStoreError Text (Maybe ErrorContext)-  | DocumentLoaderError Text (Maybe ErrorContext)-  | EmbeddingError Text (Maybe ErrorContext)-  | RunnableError Text (Maybe ErrorContext)-  | ParsingError Text (Maybe ErrorContext)-  | NetworkError Text (Maybe ErrorContext)-  | ConfigurationError Text (Maybe ErrorContext)-  | ValidationError Text (Maybe ErrorContext)-  | InternalError Text (Maybe ErrorContext)-  deriving (Show, Eq, Generic, ToJSON, FromJSON, NFData)---- | Type alias for Either LangchainError a-type LangchainResult a = Either LangchainError a---- | Extract human-readable error message text from a LangchainError-errorMessage :: LangchainError -> Text-errorMessage (LLMError msg _) = msg-errorMessage (AgentError msg _) = msg-errorMessage (MemoryError msg _) = msg-errorMessage (ToolError msg _) = msg-errorMessage (VectorStoreError msg _) = msg-errorMessage (DocumentLoaderError msg _) = msg-errorMessage (EmbeddingError msg _) = msg-errorMessage (RunnableError msg _) = msg-errorMessage (ParsingError msg _) = msg-errorMessage (NetworkError msg _) = msg-errorMessage (ConfigurationError msg _) = msg-errorMessage (ValidationError msg _) = msg-errorMessage (InternalError msg _) = msg--instance Exception LangchainError where-  displayException err = case err of-    LLMError msg ctx -> formatError "LLMError" msg ctx-    AgentError msg ctx -> formatError "AgentError" msg ctx-    MemoryError msg ctx -> formatError "MemoryError" msg ctx-    ToolError msg ctx -> formatError "ToolError" msg ctx-    VectorStoreError msg ctx -> formatError "VectorStoreError" msg ctx-    DocumentLoaderError msg ctx -> formatError "DocumentLoaderError" msg ctx-    EmbeddingError msg ctx -> formatError "EmbeddingError" msg ctx-    RunnableError msg ctx -> formatError "RunnableError" msg ctx-    ParsingError msg ctx -> formatError "ParsingError" msg ctx-    NetworkError msg ctx -> formatError "NetworkError" msg ctx-    ConfigurationError msg ctx -> formatError "ConfigurationError" msg ctx-    ValidationError msg ctx -> formatError "ValidationError" msg ctx-    InternalError msg ctx -> formatError "InternalError" msg ctx-    where-      formatError errType msg Nothing = errType ++ ": " ++ T.unpack msg-      formatError errType msg (Just ctx) =-        errType-          ++ ": "-          ++ T.unpack msg-          ++ " [Component: "-          ++ T.unpack (component ctx)-          ++ ", Operation: "-          ++ T.unpack (operation ctx)-          ++ "]"---- | Helper constructors-mkErrorCtx ::-  (Text -> Maybe ErrorContext -> LangchainError) -> Text -> Maybe Text -> Maybe Text -> LangchainError-mkErrorCtx ctor msg mbComp mbOp =-  let mbCtx = case (mbComp, mbOp) of-        (Nothing, Nothing) -> Nothing-        (Just c, Just o) -> Just $ mkContext c o mempty-        (Just c, Nothing) -> Just $ mkContext c "unspecified" mempty-        (Nothing, Just o) -> Just $ mkContext "unspecified" o mempty-   in ctor msg mbCtx--llmError :: Text -> Maybe Text -> Maybe Text -> LangchainError-llmError = mkErrorCtx LLMError--agentError :: Text -> Maybe Text -> Maybe Text -> LangchainError-agentError = mkErrorCtx AgentError--memoryError :: Text -> Maybe Text -> Maybe Text -> LangchainError-memoryError = mkErrorCtx MemoryError--toolError :: Text -> Maybe Text -> Maybe Text -> LangchainError-toolError = mkErrorCtx ToolError--vectorStoreError :: Text -> Maybe Text -> Maybe Text -> LangchainError-vectorStoreError = mkErrorCtx VectorStoreError--documentLoaderError :: Text -> Maybe Text -> Maybe Text -> LangchainError-documentLoaderError = mkErrorCtx DocumentLoaderError--embeddingError :: Text -> Maybe Text -> Maybe Text -> LangchainError-embeddingError = mkErrorCtx EmbeddingError--runnableError :: Text -> Maybe Text -> Maybe Text -> LangchainError-runnableError = mkErrorCtx RunnableError--parsingError :: Text -> Maybe Text -> Maybe Text -> LangchainError-parsingError = mkErrorCtx ParsingError--networkError :: Text -> Maybe Text -> Maybe Text -> LangchainError-networkError = mkErrorCtx NetworkError--configurationError :: Text -> Maybe Text -> Maybe Text -> LangchainError-configurationError = mkErrorCtx ConfigurationError--validationError :: Text -> Maybe Text -> Maybe Text -> LangchainError-validationError = mkErrorCtx ValidationError--internalError :: Text -> Maybe Text -> Maybe Text -> LangchainError-internalError = mkErrorCtx InternalError

@@ -1,53 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module      : Langchain.Core.Model-Description : Central ChatModel typeclass for LLM providers-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Provides effect-polymorphic 'ChatModel' interface.--}-module Langchain.Core.Model-  ( ChatModel (..)-  , module Langchain.Core.Model.Types-  ) where--import Control.Monad.Except (MonadError)-import Control.Monad.IO.Class (MonadIO)-import Data.Kind (Type)--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model.Types-import Langchain.Core.Stream (ChatStream)---- | Effect-polymorphic ChatModel typeclass for LLM providers-class ChatModel model where-  type ModelConfig model :: Type--  -- | Single synchronous invocation-  invoke ::-    (MonadIO m, MonadError LangchainError m) =>-    model ->-    [Message] ->-    Maybe (ModelConfig model) ->-    m Message--  -- | Batch invocations (default: sequential)-  batch ::-    (MonadIO m, MonadError LangchainError m) =>-    model ->-    [[Message]] ->-    Maybe (ModelConfig model) ->-    m [Message]-  batch model msgs cfg = mapM (\m -> invoke model m cfg) msgs--  -- | Streaming invocation yielding structured StreamEvents via Conduit-  stream ::-    model ->-    [Message] ->-    Maybe (ModelConfig model) ->-    ChatStream

@@ -1,199 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wno-partial-fields #-}--{- |-Module      : Langchain.Core.Model.Types-Description : Multi-modal ContentBlock and Message data types-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Data types for multi-modal messages, content blocks, roles, and tool calls.--}-module Langchain.Core.Model.Types-  ( ContentBlock (..)-  , ImageContent (..)-  , ImageSource (..)-  , Role (..)-  , ToolCall (..)-  , Message (..)-  , textMessage-  , userMessage-  , systemMessage-  , assistantMessage-  , toolMessage-  , imageMessage-  , extractMessageText-  , roleLabel-  , formatMessageString-  ) where--import Control.DeepSeq (NFData)-import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.:?), (.=))-import Data.ByteString (ByteString)-import qualified Data.ByteString.Base64 as Base64-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NonEmpty-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.Encoding as TE-import GHC.Generics (Generic)---- | A single content block within a multi-modal message.-data ContentBlock-  = TextBlock {blockText :: Text}-  | ImageBlock ImageContent-  | AudioBlock {blockMimeType :: Text, blockBase64 :: Text}-  | DataBlock {blockBytes :: ByteString}-  deriving (Eq, Show, Generic, NFData)--data ImageContent = ImageContent-  { imageSource :: ImageSource-  , imageDetail :: Maybe Text-  , imageMetadata :: Maybe Value-  }-  deriving (Eq, Show, Generic, NFData)--data ImageSource-  = ImageBase64 {imageMimeType :: Maybe Text, imageData :: Text}-  | ImageUrl {imageUrl :: Text}-  deriving (Eq, Show, Generic, NFData)--instance ToJSON ContentBlock where-  toJSON (TextBlock t) = object ["type" .= ("text" :: Text), "text" .= t]-  toJSON (ImageBlock ImageContent {imageSource = ImageUrl url, imageDetail = detail}) =-    object-      [ "type" .= ("image_url" :: Text)-      , "image_url" .= object (maybe id ((:) . ("detail" .=)) detail ["url" .= url])-      ]-  toJSON (ImageBlock ImageContent {imageSource = ImageBase64 (Just mime) imageData, imageMetadata = metadata}) =-    object $-      ["type" .= ("image" :: Text), "mime_type" .= mime, "data" .= imageData]-        <> maybe [] (pure . ("metadata" .=)) metadata-  toJSON (ImageBlock ImageContent {imageSource = ImageBase64 _ imageData, imageMetadata = metadata}) =-    object $-      ["type" .= ("image" :: Text), "source_type" .= ("base64" :: Text), "data" .= imageData]-        <> maybe [] (pure . ("metadata" .=)) metadata-  toJSON (AudioBlock mime b64) = object ["type" .= ("audio" :: Text), "mime_type" .= mime, "data" .= b64]-  toJSON (DataBlock bs) = object ["type" .= ("data" :: Text), "data" .= TE.decodeUtf8 (Base64.encode bs)]--instance FromJSON ContentBlock where-  parseJSON = withObject "ContentBlock" $ \v -> do-    typ <- v .: "type"-    case (typ :: Text) of-      "text" -> TextBlock <$> v .: "text"-      "image" -> do-        mimeType <- v .:? "mime_type"-        case mimeType of-          Just mime -> do-            imageData <- v .: "data"-            metadata <- v .:? "metadata"-            pure $ ImageBlock $ ImageContent (ImageBase64 (Just mime) imageData) Nothing metadata-          Nothing -> do-            sourceType <- v .: "source_type"-            imageData <- v .: "data"-            metadata <- v .:? "metadata"-            let source =-                  case (sourceType :: Text) of-                    "url" -> ImageUrl imageData-                    _ -> ImageBase64 Nothing imageData-            pure $ ImageBlock $ ImageContent source Nothing metadata-      "image_url" -> do-        imageUrl <- v .: "image_url"-        url <- imageUrl .: "url"-        detail <- imageUrl .:? "detail"-        pure $ ImageBlock $ ImageContent (ImageUrl url) detail Nothing-      "audio" -> AudioBlock <$> v .: "mime_type" <*> v .: "data"-      "data" -> do-        b64Text <- v .: "data"-        case Base64.decode (TE.encodeUtf8 b64Text) of-          Left err -> fail $ "Invalid base64 data block: " ++ err-          Right bs -> pure $ DataBlock bs-      other -> fail $ "Unknown ContentBlock type: " ++ show other---- | Complete set of conversation roles supported across LLM providers.-data Role-  = System-  | User-  | Assistant-  | Tool-  | Developer-  | Function-  deriving (Eq, Ord, Show, Bounded, Enum, Generic, ToJSON, FromJSON, NFData)---- | Structured tool call from an LLM response.-data ToolCall = ToolCall-  { toolCallId :: Text-  , toolCallType :: Text-  -- ^ Always "function" for current providers-  , toolCallName :: Text-  , toolCallArguments :: Value-  -- ^ Parsed JSON Value arguments-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON, NFData)---- | Structured chat message supporting multi-modal content blocks.-data Message = Message-  { messageRole :: Role-  , messageContents :: NonEmpty ContentBlock-  , messageName :: Maybe Text-  , messageToolCalls :: Maybe [ToolCall]-  , messageToolId :: Maybe Text-  -- ^ Associated tool call ID for Tool role-  , messageMetadata :: Map Text Value-  -- ^ Opaque provider-specific metadata.-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON, NFData)---- | Create a message with a single text content block.-textMessage :: Role -> Text -> Message-textMessage r t = Message r (TextBlock t :| []) Nothing Nothing Nothing Map.empty---- | Create a User role text message.-userMessage :: Text -> Message-userMessage = textMessage User---- | Create a System role text message.-systemMessage :: Text -> Message-systemMessage = textMessage System---- | Create an Assistant role text message.-assistantMessage :: Text -> Message-assistantMessage = textMessage Assistant---- | Create a Tool role text message.-toolMessage :: Text -> Message-toolMessage = textMessage Tool---- | Create an Image content block message.-imageMessage :: Role -> Text -> Text -> Message-imageMessage r mime b64 =-  Message-    r-    (ImageBlock (ImageContent (ImageBase64 (Just mime) b64) Nothing Nothing) :| [])-    Nothing-    Nothing-    Nothing-    Map.empty---- | Extract all text content blocks concatenated into a single Text string.-extractMessageText :: Message -> Text-extractMessageText msg = T.intercalate "\n" [t | TextBlock t <- NonEmpty.toList (messageContents msg)]---- | Label used when rendering a chat message role as plain text.-roleLabel :: Role -> Text-roleLabel System = "System"-roleLabel User = "Human"-roleLabel Assistant = "AI"-roleLabel Tool = "Tool"-roleLabel Developer = "Developer"-roleLabel Function = "Function"---- | Render a message as a single plain-text line with its role label.-formatMessageString :: Message -> Text-formatMessageString chatMessage =-  roleLabel (messageRole chatMessage) <> ": " <> extractMessageText chatMessage

@@ -1,55 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--{- |-Module      : Langchain.Core.Monad-Description : Core LangchainT monad transformer-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Provides the canonical monad transformer stack 'LangchainT' and its execution-runner 'runLangchainT'.--'LangchainT' is parameterised over the reader environment @r@, so each-provider (or application) can supply its own config type rather than being-forced into a one-size-fits-all 'LangchainConfig'.  Use @r = ()@ when you do-not need a shared environment at all.--@--- With a custom config-type App a = LangchainT MyConfig IO a--runApp :: MyConfig -> App a -> IO (Either LangchainError a)-runApp = runLangchainT---- Without any config-runSimple :: LangchainT () IO a -> IO (Either LangchainError a)-runSimple = runLangchainT ()-@--}-module Langchain.Core.Monad-  ( LangchainT-  , runLangchainT-  , throwLangchainError-  ) where--import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)-import Control.Monad.Reader (ReaderT, runReaderT)--import Langchain.Core.Error (LangchainError)--{- | Standard framework monad transformer stack: ReaderT over ExceptT.--The type variable @r@ is the reader environment — pass your own provider-config, application context, or @()@ when none is needed.--}-type LangchainT r m = ReaderT r (ExceptT LangchainError m)---- | Execute a 'LangchainT' computation with a given environment.-runLangchainT :: r -> LangchainT r m a -> m (Either LangchainError a)-runLangchainT env action = runExceptT (runReaderT action env)---- | Throw a 'LangchainError' inside any 'MonadError' context.-throwLangchainError :: MonadError LangchainError m => LangchainError -> m a-throwLangchainError = throwError

@@ -1,194 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module      : Langchain.Core.Runnable-Description : Pure pipeline GADT (RunnableTree) and algebraic composition-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Pure, AST-based pipeline representation ('RunnableTree') where building pipelines performs-NO side effects. Execution is strictly deferred to 'interpret'.--}-module Langchain.Core.Runnable-  ( Runnable (..)-  , RunnableTree (..)-  , (|>>)-  , (&>&)-  , interpret-  , runLambda-  , runPrim-  , runPure-  , runPassthrough-  , runIdent-  , runBranch-  , runFallback-  , runChat-  , runModel-  , ModelRunnable (..)-  , TextModelRunnable (..)-  ) where--import Control.Concurrent.Async (concurrently)-import Control.Monad.Except (ExceptT, MonadError, catchError, runExceptT, throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (Value)-import Data.Kind (Type)-import Data.Text (Text)--import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model (ChatModel, extractMessageText, userMessage)-import qualified Langchain.Core.Model as M (invoke)-import Langchain.Core.Model.Types (Message)-import Langchain.Core.Tool (Tool (..))---- | Fundamental Runnable interface for components wrapped in 'Prim'.-class Runnable r m where-  type RunnableInput r :: Type-  type RunnableOutput r :: Type-  invoke :: r -> RunnableInput r -> m (Either LangchainError (RunnableOutput r))---- | Any Tool can be executed as a primitive Runnable taking JSON 'Value' to 'Text'.-instance Monad m => Runnable (Tool m) m where-  type RunnableInput (Tool m) = Value-  type RunnableOutput (Tool m) = Text-  invoke = toolExecute---- | Wrapper to treat any 'ChatModel' as a Runnable over '[Message]' -> 'Message'.-newtype ModelRunnable c = ModelRunnable c-  deriving (Eq, Show)--instance (ChatModel c, MonadIO m) => Runnable (ModelRunnable c) m where-  type RunnableInput (ModelRunnable c) = [Message]-  type RunnableOutput (ModelRunnable c) = Message-  invoke (ModelRunnable c) msgs = runExceptT (M.invoke c msgs Nothing)---- | Wrapper to treat any 'ChatModel' as a simple 'Text' -> 'Text' Runnable.-newtype TextModelRunnable c = TextModelRunnable c-  deriving (Eq, Show)--instance (ChatModel c, MonadIO m) => Runnable (TextModelRunnable c) m where-  type RunnableInput (TextModelRunnable c) = Text-  type RunnableOutput (TextModelRunnable c) = Text-  invoke (TextModelRunnable c) prompt = do-    res <- runExceptT $ M.invoke c [userMessage prompt] Nothing-    pure (extractMessageText <$> res)--{- | Pure GADT representing a composable pipeline AST.-'i' = input type, 'o' = output type, 'm' = monad context.--}-data RunnableTree m i o where-  -- | Identity: passes input through unchanged-  Id :: RunnableTree m a a-  -- | Lift a component implementing Runnable into the tree-  Prim ::-    (Runnable r m, RunnableInput r ~ i, RunnableOutput r ~ o) =>-    r ->-    RunnableTree m i o-  -- | Lift a monadic function into the tree-  Lambda :: (i -> m (Either LangchainError o)) -> RunnableTree m i o-  -- | Sequential composition AST node-  Seq :: RunnableTree m i mid -> RunnableTree m mid o -> RunnableTree m i o-  -- | Parallel composition AST node-  Par ::-    RunnableTree (ExceptT LangchainError IO) i o1 ->-    RunnableTree (ExceptT LangchainError IO) i o2 ->-    RunnableTree (ExceptT LangchainError IO) i (o1, o2)-  -- | Conditional branching AST node-  Branch ::-    (i -> m Bool) ->-    -- | True branch-    RunnableTree m i o ->-    -- | False branch-    RunnableTree m i o ->-    RunnableTree m i o-  -- | Fallback node: if primary fails, executes fallback-  Fallback :: RunnableTree m i o -> RunnableTree m i o -> RunnableTree m i o---- | Sequential composition operator — PURE AST builder.-(|>>) :: RunnableTree m a b -> RunnableTree m b c -> RunnableTree m a c-(|>>) = Seq--infixl 1 |>>---- | Parallel composition operator — PURE AST builder.-(&>&) ::-  RunnableTree (ExceptT LangchainError IO) a b ->-  RunnableTree (ExceptT LangchainError IO) a c ->-  RunnableTree (ExceptT LangchainError IO) a (b, c)-(&>&) = Par--infixl 2 &>&---- | Helper to create a lambda runnable node.-runLambda :: (i -> m (Either LangchainError o)) -> RunnableTree m i o-runLambda = Lambda---- | Helper to create a primitive runnable node.-runPrim ::-  (Runnable r m, RunnableInput r ~ i, RunnableOutput r ~ o) =>-  r ->-  RunnableTree m i o-runPrim = Prim---- | Helper to convert Either to MonadError-liftEither :: MonadError LangchainError m => Either LangchainError a -> m a-liftEither (Left err) = throwError err-liftEither (Right x) = pure x---- | Sole execution engine for 'RunnableTree' AST pipelines.-interpret ::-  (MonadIO m, MonadError LangchainError m) =>-  RunnableTree m i o ->-  i ->-  m o-interpret Id input = pure input-interpret (Prim r) input = invoke r input >>= liftEither-interpret (Lambda f) input = f input >>= liftEither-interpret (Seq t1 t2) input = interpret t1 input >>= interpret t2-interpret (Par t1 t2) input = do-  (r1, r2) <--    liftIO $-      concurrently-        (runExceptT $ interpret t1 input)-        (runExceptT $ interpret t2 input)-  o1 <- liftEither r1-  o2 <- liftEither r2-  pure (o1, o2)-interpret (Branch cond tTrue tFalse) input = do-  b <- cond input-  if b then interpret tTrue input else interpret tFalse input-interpret (Fallback t1 t2) input =-  catchError (interpret t1 input) (\_ -> interpret t2 input)---- | Lift a pure function into a 'RunnableTree' node.-runPure :: Monad m => (i -> o) -> RunnableTree m i o-runPure f = runLambda (pure . Right . f)---- | Identity node in a 'RunnableTree' (passes input through unchanged, like LangChain's 'RunnablePassthrough').-runPassthrough :: RunnableTree m a a-runPassthrough = Id---- | Alias for 'runPassthrough'.-runIdent :: RunnableTree m a a-runIdent = Id---- | Construct a conditional branch AST node.-runBranch :: (i -> m Bool) -> RunnableTree m i o -> RunnableTree m i o -> RunnableTree m i o-runBranch = Branch---- | Construct a self-healing fallback AST node (tries first, catches errors and runs second).-runFallback :: RunnableTree m i o -> RunnableTree m i o -> RunnableTree m i o-runFallback = Fallback---- | Lift any 'ChatModel' into a simple 'Text' -> 'Text' pipeline step.-runChat :: (ChatModel c, MonadIO m) => c -> RunnableTree m Text Text-runChat c = runPrim (TextModelRunnable c)---- | Lift any 'ChatModel' into a structured '[Message]' -> 'Message' pipeline step.-runModel :: (ChatModel c, MonadIO m) => c -> RunnableTree m [Message] Message-runModel c = runPrim (ModelRunnable c)

@@ -1,169 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# OPTIONS_GHC -Wno-partial-fields #-}--{- |-Module      : Langchain.Core.Stream-Description : Standardized StreamEvent protocol and utilities-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Structured streaming event protocol for tracking LLM, tool, chain, and graph lifecycle events.--}-module Langchain.Core.Stream-  ( TokenUsage (..)-  , StreamEvent (..)-  , StreamM-  , EventStream-  , ChatStream-  , StreamCallback-  , StreamSource-  , callbackSource-  , collectEvents-  , printEvents-  ) where--import Control.Concurrent.Async (async, cancel)-import Control.Concurrent.STM-  ( atomically-  , newEmptyTMVarIO-  , newTBQueueIO-  , orElse-  , putTMVar-  , readTBQueue-  , readTMVar-  , writeTBQueue-  )-import Control.Exception (finally)-import Control.Monad.Except (ExceptT, runExceptT)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Resource (ResourceT, runResourceT)-import Data.Aeson (FromJSON, ToJSON, Value)-import Data.Conduit (ConduitT, bracketP, runConduit, yield, (.|))-import qualified Data.Conduit.List as CL-import Data.Text (Text)-import GHC.Generics (Generic)-import Langchain.Core.Error (LangchainError)-import Langchain.Core.Model.Types (Message, ToolCall)---- | Token usage accounting for LLM execution.-data TokenUsage = TokenUsage-  { promptTokens :: Int-  , completionTokens :: Int-  , totalTokens :: Int-  }-  deriving (Eq, Show, Generic, ToJSON, FromJSON)--{- | All streaming events emitted across the framework execution lifecycle.-Every event carries a 'runId' for correlation.--}-data StreamEvent-  = -- | LLM lifecycle start-    LLMStart-      { runId :: Text-      , modelName :: Text-      , inputMessages :: [Message]-      }-  | -- | LLM incremental streaming chunk-    LLMChunk-      { runId :: Text-      , chunkText :: Text-      , toolCallDelta :: Maybe ToolCall-      }-  | -- | LLM lifecycle completion-    LLMEnd-      { runId :: Text-      , finalMessage :: Message-      , tokenUsage :: Maybe TokenUsage-      }-  | -- | Tool execution start-    ToolStart-      { runId :: Text-      , toolName :: Text-      , toolInput :: Value-      }-  | -- | Tool execution completion-    ToolEnd-      { runId :: Text-      , toolName :: Text-      , toolOutput :: Value-      }-  | -- | Tool execution failure-    ToolErrorEvent-      { runId :: Text-      , toolName :: Text-      , toolErrorPayload :: LangchainError-      }-  | -- | Chain execution start-    ChainStart-      { runId :: Text-      , chainName :: Text-      , chainInput :: Value-      }-  | -- | Chain execution completion-    ChainEnd-      { runId :: Text-      , chainName :: Text-      , chainOutput :: Value-      }-  | -- | Graph node execution start-    NodeStart-      { runId :: Text-      , nodeId :: Text-      , nodeState :: Value-      }-  | -- | Graph node execution completion-    NodeEnd-      { runId :: Text-      , nodeId :: Text-      , nodeState :: Value-      }-  deriving (Eq, Show, Generic, ToJSON, FromJSON)---- | Canonical event stream type using Conduit.-type EventStream m = ConduitT () StreamEvent m ()---- | Effects used by resource-safe chat model streams.-type StreamM = ExceptT LangchainError (ResourceT IO)---- | A resource-safe stream of chat model events.-type ChatStream = EventStream StreamM---- | A callback function that produces values of type @a@.-type StreamCallback a = (a -> IO ()) -> IO ()---- | A Conduit source that produces values of type @a@ in the 'StreamM' monad.-type StreamSource a = ConduitT () a StreamM ()---- | Convert a callback-based streaming function into a Conduit source.-callbackSource :: StreamCallback a -> StreamSource a-callbackSource produce = bracketP start (cancel . third) consume-  where-    start = do-      queue <- newTBQueueIO 64-      finished <- newEmptyTMVarIO-      worker <--        async $ produce (atomically . writeTBQueue queue) `finally` atomically (putTMVar finished ())-      pure (queue, finished, worker)--    consume (queue, finished, _worker) = loop-      where-        loop = do-          let waitForFinished = Nothing <$ readTMVar finished-              readEvent = Just <$> readTBQueue queue-          next <- liftIO . atomically $ readEvent `orElse` waitForFinished-          case next of-            Just item -> yield item >> loop-            Nothing -> pure ()--    third (_, _, worker) = worker---- | Collect all emitted events from a stream into a list.-collectEvents :: Monad m => EventStream m -> m [StreamEvent]-collectEvents streamSrc = runConduit (streamSrc .| CL.consume)---- | Debug helper: print all stream events to stdout.-printEvents :: EventStream (ExceptT LangchainError (ResourceT IO)) -> IO (Either LangchainError ())-printEvents streamSrc = runResourceT $ runExceptT $ runConduit (streamSrc .| CL.mapM_ (liftIO . print))

@@ -1,65 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{- |-Module      : Langchain.Core.Tool-Description : Effect-polymorphic Tool specification and parameter validation-Copyright   : (c) 2025-2026 Tushar Adhatrao-License     : MIT-Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>-Stability   : experimental--Provides effect-polymorphic 'Tool m' representation, schema generation, and argument parsing.--}-module Langchain.Core.Tool-  ( Tool (..)-  , createTool-  , toolToValue-  ) where--import Data.Aeson-import Data.Text (Text)--import Langchain.Core.Error (LangchainError)---- | Effect-polymorphic Tool abstraction-data Tool m = Tool-  { toolName :: Text-  -- ^ Unique identifier for the tool-  , toolDescription :: Text-  -- ^ Description explaining when and how to use the tool-  , toolSchema :: Value-  -- ^ JSON Schema describing expected parameters-  , toolExecute :: Value -> m (Either LangchainError Text)-  -- ^ Monadic execution function accepting JSON arguments and returning text output-  }--instance Show (Tool m) where-  show t = "Tool { toolName = " ++ show (toolName t) ++ " }"---- | Helper to create a Tool from a name, description, schema, and execution function-createTool ::-  Text ->-  Text ->-  Value ->-  (Value -> m (Either LangchainError Text)) ->-  Tool m-createTool name desc schema execFn =-  Tool-    { toolName = name-    , toolDescription = desc-    , toolSchema = schema-    , toolExecute = execFn-    }---- | Convert Tool definition to OpenAI/Ollama compatible function definition JSON object-toolToValue :: Tool m -> Value-toolToValue Tool {..} =-  object-    [ "type" .= ("function" :: Text)-    , "function"-        .= object-          [ "name" .= toolName-          , "description" .= toolDescription-          , "parameters" .= toolSchema-          ]-    ]

@@ -0,0 +1,17 @@+{- |+Module      : Langchain.DocumentLoader+Description : Document loading abstractions and standard implementations+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+-}+module Langchain.DocumentLoader+  ( module Langchain.DocumentLoader.Core+  , module Langchain.DocumentLoader.FileLoader+  , module Langchain.DocumentLoader.DirectoryLoader+  ) where++import Langchain.DocumentLoader.Core+import Langchain.DocumentLoader.DirectoryLoader+import Langchain.DocumentLoader.FileLoader

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module      : Langchain.DocumentLoader.Core+Description : Core document loading functionality for LangChain Haskell+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Implementation of LangChain's document loading abstraction.+-}+module Langchain.DocumentLoader.Core+  ( Document (..)+  , BaseLoader (..)+  , splitDocuments+  ) where++import Control.Monad.Except (MonadError)+import Control.Monad.IO.Class (MonadIO)+import Data.Aeson (Value)+import Data.Map (Map, empty)+import qualified Data.Text as TS+import Data.Text.Lazy (Text)++import Langchain.Error (LangchainError)+import Langchain.TextSplitter.Character (defaultCharacterSplitterOps, splitText)++-- | Document container with content and metadata+data Document = Document+  { pageContent :: Text+  -- ^ The text content of the document+  , metadata :: Map TS.Text Value+  -- ^ Additional metadata (e.g., source, page number)+  }+  deriving (Show, Eq)++instance Semigroup Document where+  doc1 <> doc2 =+    Document+      (pageContent doc1 <> pageContent doc2)+      (metadata doc1 <> metadata doc2)++instance Monoid Document where+  mempty = Document mempty empty++-- | Effect-polymorphic BaseLoader typeclass+class BaseLoader loader where+  -- | Load all documents from the source+  load ::+    (MonadIO m, MonadError LangchainError m) =>+    loader ->+    m [Document]++  -- | Load all documents and split their content into chunks using 'defaultCharacterSplitterOps'.+  loadAndSplit ::+    (MonadIO m, MonadError LangchainError m) =>+    loader ->+    m [Text]+  loadAndSplit loader = do+    docs <- load loader+    pure $ concatMap (splitText defaultCharacterSplitterOps . pageContent) docs++{- | Split a list of documents using any text splitting function, preserving metadata on each chunk.++Example:++@+chunks = splitDocuments (splitTextRecursive defaultRecursiveCharacterSplitterOps) docs+@+-}+splitDocuments :: (Text -> [Text]) -> [Document] -> [Document]+splitDocuments splitFn docs =+  [ Document chunk (metadata doc)+  | doc <- docs+  , chunk <- splitFn (pageContent doc)+  ]

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

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

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

@@ -0,0 +1,13 @@+{- |+Module      : Langchain.Embeddings.Core+Description : Re-export of Langchain.Embeddings for backward compatibility+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental+-}+module Langchain.Embeddings.Core+  ( module Langchain.Embeddings+  ) where++import Langchain.Embeddings

@@ -0,0 +1,190 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Langchain.Error+Description : Core structured error types and context metadata+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Structured error handling without String-based error dropping.+-}+module Langchain.Error+  ( LangchainError (..)+  , ErrorContext (..)+  , LangchainResult+  , errorMessage+  , mkContext+  , mkContextIO+  , llmError+  , agentError+  , memoryError+  , toolError+  , vectorStoreError+  , documentLoaderError+  , embeddingError+  , runnableError+  , parsingError+  , networkError+  , configurationError+  , validationError+  , internalError+  ) where++import Control.Exception (Exception (..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (FromJSON, ToJSON)+import Data.Map (Map)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime, getCurrentTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.Generics (Generic)++-- | Detailed context metadata attached to every error.+data ErrorContext = ErrorContext+  { component :: Text+  , operation :: Text+  , timestamp :: UTCTime+  , details :: Map Text Text+  }+  deriving (Show, Eq, Generic, ToJSON, FromJSON)++-- | Pure context constructor.+mkContext :: Text -> Text -> Map Text Text -> ErrorContext+mkContext comp op = ErrorContext comp op (posixSecondsToUTCTime 0)++-- | IO context constructor with real timestamp.+mkContextIO :: MonadIO m => Text -> Text -> Map Text Text -> m ErrorContext+mkContextIO comp op dt = do+  now <- liftIO getCurrentTime+  pure $ ErrorContext comp op now dt++-- | Core framework error type.+data LangchainError+  = LLMError Text (Maybe ErrorContext)+  | AgentError Text (Maybe ErrorContext)+  | MemoryError Text (Maybe ErrorContext)+  | ToolError Text (Maybe ErrorContext)+  | VectorStoreError Text (Maybe ErrorContext)+  | DocumentLoaderError Text (Maybe ErrorContext)+  | EmbeddingError Text (Maybe ErrorContext)+  | RunnableError Text (Maybe ErrorContext)+  | ParsingError Text (Maybe ErrorContext)+  | NetworkError Text (Maybe ErrorContext)+  | ConfigurationError Text (Maybe ErrorContext)+  | ValidationError Text (Maybe ErrorContext)+  | InternalError Text (Maybe ErrorContext)+  deriving (Show, Eq, Generic, ToJSON, FromJSON)++-- | Type alias for Either LangchainError a+type LangchainResult a = Either LangchainError a++-- | Extract human-readable error message text from a LangchainError+errorMessage :: LangchainError -> Text+errorMessage (LLMError msg _) = msg+errorMessage (AgentError msg _) = msg+errorMessage (MemoryError msg _) = msg+errorMessage (ToolError msg _) = msg+errorMessage (VectorStoreError msg _) = msg+errorMessage (DocumentLoaderError msg _) = msg+errorMessage (EmbeddingError msg _) = msg+errorMessage (RunnableError msg _) = msg+errorMessage (ParsingError msg _) = msg+errorMessage (NetworkError msg _) = msg+errorMessage (ConfigurationError msg _) = msg+errorMessage (ValidationError msg _) = msg+errorMessage (InternalError msg _) = msg++instance Exception LangchainError where+  displayException err = case err of+    LLMError msg ctx -> formatError "LLMError" msg ctx+    AgentError msg ctx -> formatError "AgentError" msg ctx+    MemoryError msg ctx -> formatError "MemoryError" msg ctx+    ToolError msg ctx -> formatError "ToolError" msg ctx+    VectorStoreError msg ctx -> formatError "VectorStoreError" msg ctx+    DocumentLoaderError msg ctx -> formatError "DocumentLoaderError" msg ctx+    EmbeddingError msg ctx -> formatError "EmbeddingError" msg ctx+    RunnableError msg ctx -> formatError "RunnableError" msg ctx+    ParsingError msg ctx -> formatError "ParsingError" msg ctx+    NetworkError msg ctx -> formatError "NetworkError" msg ctx+    ConfigurationError msg ctx -> formatError "ConfigurationError" msg ctx+    ValidationError msg ctx -> formatError "ValidationError" msg ctx+    InternalError msg ctx -> formatError "InternalError" msg ctx+    where+      formatError errType msg Nothing = errType ++ ": " ++ T.unpack msg+      formatError errType msg (Just ctx) =+        errType+          ++ ": "+          ++ T.unpack msg+          ++ " [Component: "+          ++ T.unpack (component ctx)+          ++ ", Operation: "+          ++ T.unpack (operation ctx)+          ++ "]"++-- | Helper constructors+mkErrorCtx ::+  (Text -> Maybe ErrorContext -> LangchainError) -> Text -> Maybe Text -> Maybe Text -> LangchainError+mkErrorCtx ctor msg mbComp mbOp =+  let mbCtx = case (mbComp, mbOp) of+        (Nothing, Nothing) -> Nothing+        (Just c, Just o) -> Just $ mkContext c o mempty+        (Just c, Nothing) -> Just $ mkContext c "unspecified" mempty+        (Nothing, Just o) -> Just $ mkContext "unspecified" o mempty+   in ctor msg mbCtx++-- | Construct an 'LLMError' with optional component and operation.+llmError :: Text -> Maybe Text -> Maybe Text -> LangchainError+llmError = mkErrorCtx LLMError++-- | Construct an 'AgentError' with optional component and operation.+agentError :: Text -> Maybe Text -> Maybe Text -> LangchainError+agentError = mkErrorCtx AgentError++-- | Construct a 'MemoryError' with optional component and operation.+memoryError :: Text -> Maybe Text -> Maybe Text -> LangchainError+memoryError = mkErrorCtx MemoryError++-- | Construct a 'ToolError' with optional component and operation.+toolError :: Text -> Maybe Text -> Maybe Text -> LangchainError+toolError = mkErrorCtx ToolError++-- | Construct a 'VectorStoreError' with optional component and operation.+vectorStoreError :: Text -> Maybe Text -> Maybe Text -> LangchainError+vectorStoreError = mkErrorCtx VectorStoreError++-- | Construct a 'DocumentLoaderError' with optional component and operation.+documentLoaderError :: Text -> Maybe Text -> Maybe Text -> LangchainError+documentLoaderError = mkErrorCtx DocumentLoaderError++-- | Construct an 'EmbeddingError' with optional component and operation.+embeddingError :: Text -> Maybe Text -> Maybe Text -> LangchainError+embeddingError = mkErrorCtx EmbeddingError++-- | Construct a 'RunnableError' with optional component and operation.+runnableError :: Text -> Maybe Text -> Maybe Text -> LangchainError+runnableError = mkErrorCtx RunnableError++-- | Construct a 'ParsingError' with optional component and operation.+parsingError :: Text -> Maybe Text -> Maybe Text -> LangchainError+parsingError = mkErrorCtx ParsingError++-- | Construct a 'NetworkError' with optional component and operation.+networkError :: Text -> Maybe Text -> Maybe Text -> LangchainError+networkError = mkErrorCtx NetworkError++-- | Construct a 'ConfigurationError' with optional component and operation.+configurationError :: Text -> Maybe Text -> Maybe Text -> LangchainError+configurationError = mkErrorCtx ConfigurationError++-- | Construct a 'ValidationError' with optional component and operation.+validationError :: Text -> Maybe Text -> Maybe Text -> LangchainError+validationError = mkErrorCtx ValidationError++-- | Construct an 'InternalError' with optional component and operation.+internalError :: Text -> Maybe Text -> Maybe Text -> LangchainError+internalError = mkErrorCtx InternalError

@@ -0,0 +1,16 @@+{- |+Module      : Langchain.Guardrail+Description : 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+  ( module Langchain.Guardrail.Core+  ) where++import Langchain.Guardrail.Core

@@ -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.Error (LangchainError, agentError)+import Langchain.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

@@ -0,0 +1,33 @@+{-# LANGUAGE DuplicateRecordFields #-}++{- |+Module      : Langchain.Memory+Description : Conversation memory interfaces and implementations+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Conversation memory management including:+* Unbounded buffer memory ('ConversationBufferMemory')+* Sliding window memory ('WindowBufferMemory')+* Token-budgeted sliding buffer ('TokenBufferMemory')+* Progressive transactional summarization memory ('SummaryMemory')+* Multi-session memory stores with TTL eviction ('SessionMemoryStore')+* Structured entity and attribute fact memory ('EntityMemory')+* Composite memory combinations ('CombinedMemory')+* JSON file persistence and variable loading+-}+module Langchain.Memory+  ( module Langchain.Memory.Core+  , module Langchain.Memory.Summary+  , module Langchain.Memory.Session+  , module Langchain.Memory.Entity+  , module Langchain.Memory.Combined+  ) where++import Langchain.Memory.Combined+import Langchain.Memory.Core+import Langchain.Memory.Entity+import Langchain.Memory.Session+import Langchain.Memory.Summary

@@ -0,0 +1,49 @@+{- |+Module      : Langchain.Memory.Combined+Description : Composition of multiple heterogeneous memory stores+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Composite memory combining multiple distinct memory backends (e.g. WindowBufferMemory + EntityMemory)+into a single unified BaseMemory interface. Broadcasts inputs to all child memories and aggregates+their history and variable outputs.+-}+module Langchain.Memory.Combined+  ( CombinedMemory (..)+  , newCombinedMemory+  ) where++import Control.Monad (forM_)++import Langchain.Memory.Core (BaseMemory (..), SomeMemory (..))++-- | Composite memory multiplexing over a list of existential 'SomeMemory' instances+newtype CombinedMemory = CombinedMemory+  { memories :: [SomeMemory]+  }++-- | Construct a new CombinedMemory from a list of 'SomeMemory' wrappers+newCombinedMemory :: [SomeMemory] -> CombinedMemory+newCombinedMemory = CombinedMemory++instance BaseMemory CombinedMemory where+  messages (CombinedMemory mems) = do+    listOfLists <- mapM messages mems+    pure $ concat listOfLists++  addMessage (CombinedMemory mems) msg =+    forM_ mems (`addMessage` msg)++  addUserMessage (CombinedMemory mems) txt =+    forM_ mems (`addUserMessage` txt)++  addAiMessage (CombinedMemory mems) txt =+    forM_ mems (`addAiMessage` txt)++  clear (CombinedMemory mems) =+    forM_ mems clear++  importMessages (CombinedMemory mems) msgs =+    forM_ mems (`importMessages` msgs)

@@ -0,0 +1,455 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Langchain.Memory.Core+Description : Effect-polymorphic, thread-safe conversation memory interfaces+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Thread-safe, effect-polymorphic conversation memory interfaces using STM.+Includes sliding window buffers, token-budgeted buffers, unbounded conversation buffers,+context saving, variable loading for prompt interpolation, and JSON persistence.+-}+module Langchain.Memory.Core+  ( -- * Base Memory Interface+    BaseMemory (..)+  , SomeMemory (..)++    -- * Context Saving & Variable Loading+  , saveContext+  , loadMemoryVariables+  , formatHistory+  , formatHistoryWithLabels++    -- * Memory Implementations+  , ConversationBufferMemory (..)+  , newConversationBufferMemory+  , WindowBufferMemory (..)+  , newWindowBufferMemory+  , TokenBufferMemory (..)+  , newTokenBufferMemory+  , newTokenBufferMemoryWithStrategy+  , OverflowStrategy (..)+  , TokenCounter++    -- * Persistence & Serialization+  , exportMessages+  , saveMemoryToFile+  , loadMemoryFromFile++    -- * Utility Functions+  , countTokens+  , approximateTokenCount+  , trimMessages+  , initialMessages+  , resetToInitial+  , resetConversationBuffer+  , resetWindowBuffer+  , resetTokenBuffer+  ) where++import Control.Concurrent.STM+  ( TVar+  , atomically+  , modifyTVar'+  , newTVarIO+  , readTVarIO+  , writeTVar+  )+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (decode, encode)+import qualified Data.ByteString.Lazy as BSL+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics (Generic)++import Langchain.Error (LangchainError, memoryError)+import Langchain.Model+  ( Message (..)+  , Role (..)+  , assistantMessage+  , extractMessageText+  , systemMessage+  , userMessage+  )++-- ---------------------------------------------------------------------------+-- Base Memory Interface+-- ---------------------------------------------------------------------------++-- | Effect-polymorphic BaseMemory typeclass providing full conversation management.+class BaseMemory mem where+  -- | Retrieve current conversation messages+  messages ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    m [Message]++  -- | Add a structured message to history+  addMessage ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    Message ->+    m ()++  -- | Add a user message to history+  addUserMessage ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    Text ->+    m ()+  addUserMessage mem txt = addMessage mem (userMessage txt)++  -- | Add an AI response message to history+  addAiMessage ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    Text ->+    m ()+  addAiMessage mem txt = addMessage mem (assistantMessage txt)++  -- | Reset memory to initial state+  clear ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    m ()++  -- | Import and replace conversation messages completely+  importMessages ::+    (MonadIO m, MonadError LangchainError m) =>+    mem ->+    [Message] ->+    m ()+  importMessages mem msgs = do+    clear mem+    mapM_ (addMessage mem) msgs++-- | Atomically record both user input and AI response in a single step+saveContext ::+  (BaseMemory mem, MonadIO m, MonadError LangchainError m) =>+  mem ->+  Text ->+  Text ->+  m ()+saveContext mem userTxt aiTxt = do+  addUserMessage mem userTxt+  addAiMessage mem aiTxt++-- | Load memory variables as a Map for direct prompt template interpolation+loadMemoryVariables ::+  (BaseMemory mem, MonadIO m, MonadError LangchainError m) =>+  mem ->+  m (Map Text Text)+loadMemoryVariables mem = do+  msgs <- messages mem+  pure $ Map.singleton "history" (formatHistory msgs)++-- | Format conversation messages to standard string representation+formatHistory :: [Message] -> Text+formatHistory = formatHistoryWithLabels "Human" "AI"++-- | Format conversation messages with custom role labels+formatHistoryWithLabels :: Text -> Text -> [Message] -> Text+formatHistoryWithLabels userLabel aiLabel msgs =+  T.intercalate "\n" (map formatMsg msgs)+  where+    formatMsg m =+      let prefix = case messageRole m of+            User -> userLabel <> ": "+            Assistant -> aiLabel <> ": "+            System -> "System: "+            Tool -> "Tool: "+            Function -> "Function: "+            Developer -> "Developer: "+       in prefix <> extractMessageText m++-- ---------------------------------------------------------------------------+-- Existential Wrapper+-- ---------------------------------------------------------------------------++-- | Existential wrapper for any 'BaseMemory' instance+data SomeMemory where+  SomeMemory :: (BaseMemory mem) => mem -> SomeMemory++instance BaseMemory SomeMemory where+  messages (SomeMemory m) = messages m+  addMessage (SomeMemory m) = addMessage m+  clear (SomeMemory m) = clear m+  addUserMessage (SomeMemory m) = addUserMessage m+  addAiMessage (SomeMemory m) = addAiMessage m+  importMessages (SomeMemory m) = importMessages m++-- | No-op BaseMemory instance for unit+instance BaseMemory () where+  messages () = pure []+  addMessage () _ = pure ()+  clear () = pure ()++-- ---------------------------------------------------------------------------+-- ConversationBufferMemory (Unbounded)+-- ---------------------------------------------------------------------------++-- | Unbounded conversation memory keeping the full message history in a thread-safe STM TVar+data ConversationBufferMemory = ConversationBufferMemory+  { memVar :: !(TVar [Message])+  , initialMessagesList :: ![Message]+  }++instance Show ConversationBufferMemory where+  show _ = "ConversationBufferMemory"++instance Eq ConversationBufferMemory where+  (ConversationBufferMemory tv1 _) == (ConversationBufferMemory tv2 _) = tv1 == tv2++-- | Construct a new unbounded ConversationBufferMemory+newConversationBufferMemory :: (MonadIO m) => [Message] -> m ConversationBufferMemory+newConversationBufferMemory initMsgs = liftIO $ do+  tv <- newTVarIO initMsgs+  pure $ ConversationBufferMemory tv initMsgs++instance BaseMemory ConversationBufferMemory where+  messages (ConversationBufferMemory tv _) = liftIO $ readTVarIO tv++  addMessage (ConversationBufferMemory tv _) newMsg = liftIO $ atomically $ do+    modifyTVar' tv (\curr -> curr ++ [newMsg])++  clear (ConversationBufferMemory tv inits) = liftIO $ atomically $ do+    let resetMsgs = if null inits then [systemMessage "You are a helpful AI assistant"] else inits+    writeTVar tv resetMsgs++  importMessages (ConversationBufferMemory tv _) msgs = liftIO $ atomically $ do+    writeTVar tv msgs++-- ---------------------------------------------------------------------------+-- WindowBufferMemory (Sliding Window by Count)+-- ---------------------------------------------------------------------------++-- | Sliding window memory backed by thread-safe STM TVar+data WindowBufferMemory = WindowBufferMemory+  { maxWindowSize :: !Int+  , memVar :: !(TVar [Message])+  , initialMessagesList :: ![Message]+  }++instance Show WindowBufferMemory where+  show (WindowBufferMemory sz _ _) = "WindowBufferMemory { maxWindowSize = " ++ show sz ++ " }"++instance Eq WindowBufferMemory where+  (WindowBufferMemory sz1 tv1 _) == (WindowBufferMemory sz2 tv2 _) =+    sz1 == sz2 && tv1 == tv2++-- | Construct a thread-safe WindowBufferMemory in MonadIO+newWindowBufferMemory ::+  (MonadIO m) =>+  -- | Maximum message window size+  Int ->+  -- | Initial messages to seed the window+  [Message] ->+  -- | Initialized thread-safe WindowBufferMemory+  m WindowBufferMemory+newWindowBufferMemory sz initMsgs = liftIO $ do+  tv <- newTVarIO initMsgs+  pure $ WindowBufferMemory sz tv initMsgs++instance BaseMemory WindowBufferMemory where+  messages (WindowBufferMemory _ tv _) = liftIO $ readTVarIO tv++  addMessage (WindowBufferMemory maxSz tv _) newMsg = liftIO $ do+    atomically $ modifyTVar' tv $ \currMsgs ->+      let combined = currMsgs ++ [newMsg]+       in if length combined > maxSz+            then removeOldestNonSystem combined+            else combined+    where+      removeOldestNonSystem [] = []+      removeOldestNonSystem (m : ms)+        | messageRole m == System = m : removeOldestNonSystem ms+        | otherwise = ms++  clear (WindowBufferMemory _ tv _) = liftIO $ do+    atomically $ writeTVar tv [systemMessage "You are a helpful AI assistant"]++  importMessages (WindowBufferMemory _ tv _) msgs = liftIO $ atomically $ do+    writeTVar tv msgs++-- ---------------------------------------------------------------------------+-- TokenBufferMemory (Sliding Window by Token Budget)+-- ---------------------------------------------------------------------------++-- | Strategy for handling incoming messages that exceed token capacity+data OverflowStrategy+  = EvictOldest+  | RejectOnOverflow+  deriving (Show, Eq, Generic)++-- | Function type for counting tokens in a list of messages+type TokenCounter = [Message] -> Int++-- | Approximate token count: 4 characters ≈ 1 token+approximateTokenCount :: [Message] -> Int+approximateTokenCount =+  sum . map (\m -> ceiling (fromIntegral (T.length (extractMessageText m)) / (4.0 :: Double)))++-- | Approximate token count alias for backwards compatibility+countTokens :: [Message] -> Int+countTokens = approximateTokenCount++-- | Token-based sliding window memory type+data TokenBufferMemory = TokenBufferMemory+  { maxTokens :: !Int+  , memVar :: !(TVar [Message])+  , overflowStrategy :: !OverflowStrategy+  , tokenCounter :: !TokenCounter+  , initialMessagesList :: ![Message]+  }++instance Show TokenBufferMemory where+  show (TokenBufferMemory maxT _ strat _ _) =+    "TokenBufferMemory { maxTokens = " ++ show maxT ++ ", overflowStrategy = " ++ show strat ++ " }"++instance Eq TokenBufferMemory where+  (TokenBufferMemory t1 tv1 s1 _ _) == (TokenBufferMemory t2 tv2 s2 _ _) =+    t1 == t2 && tv1 == tv2 && s1 == s2++-- | Construct a new TokenBufferMemory with default eviction strategy and approximate counting+newTokenBufferMemory ::+  (MonadIO m) =>+  -- | Maximum allowed tokens in history+  Int ->+  -- | Initial messages to seed the buffer+  [Message] ->+  -- | Initialized thread-safe TokenBufferMemory+  m TokenBufferMemory+newTokenBufferMemory maxT initMsgs =+  newTokenBufferMemoryWithStrategy maxT initMsgs EvictOldest approximateTokenCount++-- | Construct a TokenBufferMemory with explicit overflow strategy and custom token counter+newTokenBufferMemoryWithStrategy ::+  (MonadIO m) =>+  Int ->+  [Message] ->+  OverflowStrategy ->+  TokenCounter ->+  m TokenBufferMemory+newTokenBufferMemoryWithStrategy maxT initMsgs strat counter = liftIO $ do+  tv <- newTVarIO initMsgs+  pure $ TokenBufferMemory maxT tv strat counter initMsgs++instance BaseMemory TokenBufferMemory where+  messages (TokenBufferMemory _ tv _ _ _) = liftIO $ readTVarIO tv++  addMessage (TokenBufferMemory maxT tv _ counter _) newMsg = do+    let newMsgTokens = counter [newMsg]+    if newMsgTokens > maxT+      then+        throwError $+          memoryError "New message exceeds maximum token limit" (Just "TokenBufferMemory") Nothing+      else liftIO $ atomically $ modifyTVar' tv $ \currMsgs ->+        trimToLimit currMsgs newMsgTokens [newMsg]+    where+      trimToLimit currMsgs newMsgToks acc =+        let candidate = currMsgs ++ acc+         in if counter candidate <= maxT+              then candidate+              else case removeOldestNonSystem currMsgs of+                Just trimmed -> trimToLimit trimmed newMsgToks acc+                Nothing -> [newMsg]++      removeOldestNonSystem [] = Nothing+      removeOldestNonSystem (m : ms)+        | messageRole m == System = fmap (m :) (removeOldestNonSystem ms)+        | otherwise = Just ms++  clear (TokenBufferMemory _ tv _ _ _) = liftIO $ do+    atomically $ writeTVar tv [systemMessage "You are a helpful AI assistant"]++  importMessages (TokenBufferMemory _ tv _ _ _) msgs = liftIO $ atomically $ do+    writeTVar tv msgs++-- ---------------------------------------------------------------------------+-- Persistence & Serialization+-- ---------------------------------------------------------------------------++-- | Export all conversation messages from memory+exportMessages ::+  (BaseMemory mem, MonadIO m, MonadError LangchainError m) =>+  mem ->+  m [Message]+exportMessages = messages++-- | Persist memory state to a JSON file+saveMemoryToFile ::+  (BaseMemory mem, MonadIO m, MonadError LangchainError m) =>+  FilePath ->+  mem ->+  m ()+saveMemoryToFile path mem = do+  msgs <- messages mem+  liftIO $ BSL.writeFile path (encode msgs)++-- | Load memory state from a JSON file+loadMemoryFromFile ::+  (BaseMemory mem, MonadIO m, MonadError LangchainError m) =>+  FilePath ->+  mem ->+  m ()+loadMemoryFromFile path mem = do+  content <- liftIO $ BSL.readFile path+  case decode content of+    Nothing ->+      throwError $+        memoryError+          ("Failed to parse memory JSON from file: " <> T.pack path)+          (Just "loadMemoryFromFile")+          Nothing+    Just msgs -> importMessages mem msgs++-- ---------------------------------------------------------------------------+-- Utilities+-- ---------------------------------------------------------------------------++-- | Reset memory back to its exact initial messages+resetToInitial ::+  (MonadIO m) =>+  TVar [Message] ->+  [Message] ->+  m ()+resetToInitial tv inits = liftIO $ atomically $ writeTVar tv inits++-- | Reset a 'ConversationBufferMemory' back to its initial seed messages+resetConversationBuffer :: (MonadIO m) => ConversationBufferMemory -> m ()+resetConversationBuffer (ConversationBufferMemory tv inits) = resetToInitial tv inits++-- | Reset a 'WindowBufferMemory' back to its initial seed messages+resetWindowBuffer :: (MonadIO m) => WindowBufferMemory -> m ()+resetWindowBuffer (WindowBufferMemory _ tv inits) = resetToInitial tv inits++-- | Reset a 'TokenBufferMemory' back to its initial seed messages+resetTokenBuffer :: (MonadIO m) => TokenBufferMemory -> m ()+resetTokenBuffer (TokenBufferMemory _ tv _ _ inits) = resetToInitial tv inits++-- | Pure helper to trim messages to last N+trimMessages ::+  -- | Number of most recent messages to keep+  Int ->+  -- | Input message list+  [Message] ->+  -- | Trimmed message list+  [Message]+trimMessages n msgs = drop (max 0 (length msgs - n)) msgs++-- | Pure helper to construct initial system message history+initialMessages ::+  -- | System prompt text+  Text ->+  -- | Initial message history with system message+  [Message]+initialMessages sysPrompt = [systemMessage sysPrompt]

@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Memory.Entity+Description : Structured key-value and entity fact memory+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Thread-safe entity and fact memory.+Retains user attributes, preferences, and extracted facts across conversation turns+for injection into prompt variables and system messages.+-}+module Langchain.Memory.Entity+  ( EntityMemory (..)+  , newEntityMemory+  , setEntity+  , getEntity+  , getAllEntities+  , deleteEntity+  , clearEntities+  , formatEntities+  , resetEntitiesToInitial+  ) where++import Control.Concurrent.STM+  ( TVar+  , atomically+  , modifyTVar'+  , newTVarIO+  , readTVarIO+  , writeTVar+  )+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T++import Langchain.Memory.Core (BaseMemory (..))+import Langchain.Model (systemMessage)++-- | Entity memory holding key-value facts and attributes in STM+data EntityMemory = EntityMemory+  { entityVar :: !(TVar (Map Text Text))+  , initialEntities :: !(Map Text Text)+  }++-- | Construct a new EntityMemory with optional initial facts+newEntityMemory :: MonadIO m => Map Text Text -> m EntityMemory+newEntityMemory inits = liftIO $ do+  var <- newTVarIO inits+  pure $ EntityMemory var inits++-- | Set or update a specific entity attribute+setEntity :: MonadIO m => EntityMemory -> Text -> Text -> m ()+setEntity EntityMemory {..} key val = liftIO $ atomically $ do+  modifyTVar' entityVar (Map.insert key val)++-- | Look up a specific entity attribute+getEntity :: MonadIO m => EntityMemory -> Text -> m (Maybe Text)+getEntity EntityMemory {..} key = liftIO $ do+  m <- readTVarIO entityVar+  pure $ Map.lookup key m++-- | Retrieve all current entity facts+getAllEntities :: MonadIO m => EntityMemory -> m (Map Text Text)+getAllEntities EntityMemory {..} = liftIO $ readTVarIO entityVar++-- | Delete an entity attribute+deleteEntity :: MonadIO m => EntityMemory -> Text -> m ()+deleteEntity EntityMemory {..} key = liftIO $ atomically $ do+  modifyTVar' entityVar (Map.delete key)++-- | Clear all entity attributes+clearEntities :: MonadIO m => EntityMemory -> m ()+clearEntities EntityMemory {..} = liftIO $ atomically $ do+  writeTVar entityVar Map.empty++-- | Reset entity memory back to its initial seed facts+resetEntitiesToInitial :: MonadIO m => EntityMemory -> m ()+resetEntitiesToInitial EntityMemory {..} = liftIO $ atomically $ do+  writeTVar entityVar initialEntities++-- | Format key-value entities into bullet points+formatEntities :: Map Text Text -> Text+formatEntities m+  | Map.null m = ""+  | otherwise =+      T.intercalate "\n" ["- " <> k <> ": " <> v | (k, v) <- Map.toList m]++instance BaseMemory EntityMemory where+  messages EntityMemory {..} = liftIO $ do+    m <- readTVarIO entityVar+    if Map.null m+      then pure []+      else pure [systemMessage ("Relevant context facts:\n" <> formatEntities m)]++  addMessage _ _ = pure ()++  clear = clearEntities

@@ -0,0 +1,159 @@+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Memory.Session+Description : Multi-session conversation memory management with TTL eviction+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Thread-safe multi-session conversation store.+Provides per-session memory isolation for web servers, chatbots, and multi-tenant agents+with configurable Time-To-Live (TTL) expiration to avoid unbounded memory leaks.+-}+module Langchain.Memory.Session+  ( SessionId+  , SessionMemoryStore (..)+  , newSessionMemoryStore+  , newSessionMemoryStoreWithTTL+  , getSessionMemory+  , listSessions+  , hasSession+  , deleteSession+  , clearAllSessions+  , sessionCount+  , cleanupExpiredSessions+  , exportAllSessions+  ) where++import Control.Concurrent.STM+  ( TVar+  , atomically+  , modifyTVar'+  , newTVarIO+  , readTVar+  , readTVarIO+  , writeTVar+  )+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)++import Langchain.Model (Message)++-- | Unique identifier for a conversation session (e.g. user ID, session token, or UUID)+type SessionId = Text++-- | Thread-safe multi-session memory repository+data SessionMemoryStore mem = SessionMemoryStore+  { storeVar :: !(TVar (Map SessionId (mem, UTCTime)))+  , memFactory :: !(SessionId -> IO mem)+  , sessionTTL :: !(Maybe NominalDiffTime)+  }++-- | Create a new SessionMemoryStore with no TTL (sessions persist until explicitly deleted)+newSessionMemoryStore ::+  MonadIO m =>+  -- | Factory creating a fresh memory instance for a given SessionId+  (SessionId -> IO mem) ->+  m (SessionMemoryStore mem)+newSessionMemoryStore factory = liftIO $ do+  var <- newTVarIO Map.empty+  pure $ SessionMemoryStore var factory Nothing++-- | Create a new SessionMemoryStore with automatic Time-To-Live expiration+newSessionMemoryStoreWithTTL ::+  MonadIO m =>+  -- | Maximum idle time before session is considered expired+  NominalDiffTime ->+  -- | Factory creating a fresh memory instance for a given SessionId+  (SessionId -> IO mem) ->+  m (SessionMemoryStore mem)+newSessionMemoryStoreWithTTL ttl factory = liftIO $ do+  var <- newTVarIO Map.empty+  pure $ SessionMemoryStore var factory (Just ttl)++-- | Retrieve (or create) the memory instance for a specific session, updating its last access timestamp+getSessionMemory ::+  MonadIO m =>+  SessionMemoryStore mem ->+  SessionId ->+  m mem+getSessionMemory SessionMemoryStore {..} sId = liftIO $ do+  now <- getCurrentTime+  mExisting <- atomically $ do+    m <- readTVar storeVar+    case Map.lookup sId m of+      Just (mem, lastAccess) ->+        case sessionTTL of+          Just ttl | diffUTCTime now lastAccess > ttl -> pure Nothing+          _ -> do+            modifyTVar' storeVar (Map.insert sId (mem, now))+            pure (Just mem)+      Nothing -> pure Nothing++  case mExisting of+    Just mem -> pure mem+    Nothing -> do+      newMem <- memFactory sId+      atomically $ modifyTVar' storeVar (Map.insert sId (newMem, now))+      pure newMem++-- | List all active session IDs+listSessions :: MonadIO m => SessionMemoryStore mem -> m [SessionId]+listSessions SessionMemoryStore {..} = liftIO $ do+  m <- readTVarIO storeVar+  pure $ Map.keys m++-- | Check if a session exists and is not expired+hasSession :: MonadIO m => SessionMemoryStore mem -> SessionId -> m Bool+hasSession SessionMemoryStore {..} sId = liftIO $ do+  now <- getCurrentTime+  m <- readTVarIO storeVar+  pure $ case Map.lookup sId m of+    Just (_, lastAccess) ->+      case sessionTTL of+        Just ttl -> diffUTCTime now lastAccess <= ttl+        Nothing -> True+    Nothing -> False++-- | Delete a specific session from the store+deleteSession :: MonadIO m => SessionMemoryStore mem -> SessionId -> m ()+deleteSession SessionMemoryStore {..} sId = liftIO $ atomically $ do+  modifyTVar' storeVar (Map.delete sId)++-- | Remove all sessions from the store+clearAllSessions :: MonadIO m => SessionMemoryStore mem -> m ()+clearAllSessions SessionMemoryStore {..} = liftIO $ atomically $ do+  writeTVar storeVar Map.empty++-- | Count active sessions+sessionCount :: MonadIO m => SessionMemoryStore mem -> m Int+sessionCount SessionMemoryStore {..} = liftIO $ do+  m <- readTVarIO storeVar+  pure $ Map.size m++-- | Purge all sessions that have exceeded the TTL limit. Returns the number of evicted sessions.+cleanupExpiredSessions :: MonadIO m => SessionMemoryStore mem -> m Int+cleanupExpiredSessions SessionMemoryStore {..} = liftIO $ case sessionTTL of+  Nothing -> pure 0+  Just ttl -> do+    now <- getCurrentTime+    atomically $ do+      m <- readTVar storeVar+      let (active, expired) = Map.partition (\(_, lastAccess) -> diffUTCTime now lastAccess <= ttl) m+      writeTVar storeVar active+      pure (Map.size expired)++-- | Export all sessions' message histories+exportAllSessions ::+  MonadIO m =>+  (mem -> m [Message]) ->+  SessionMemoryStore mem ->+  m (Map SessionId [Message])+exportAllSessions getMsgs SessionMemoryStore {..} = do+  sMap <- liftIO $ readTVarIO storeVar+  Map.traverseWithKey (\_ (mem, _) -> getMsgs mem) sMap

@@ -0,0 +1,134 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Memory.Summary+Description : Summary-based conversation memory with progressive LLM summarization+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Progressively summarizes older conversation history using a ChatModel when history exceeds a threshold.+Guarantees transaction safety: conversation history is only pruned after the LLM summarization+call successfully completes, preventing irreversible data loss on network or model failures.+-}+module Langchain.Memory.Summary+  ( SummaryMemory (..)+  , newSummaryMemory+  , newSummaryMemoryWithPrompt+  , getSummary+  , defaultSummaryPrompt+  , formatMessages+  ) where++import Control.Concurrent.STM+  ( TVar+  , atomically+  , modifyTVar'+  , newTVarIO+  , readTVar+  , readTVarIO+  , writeTVar+  )+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.List (partition)+import Data.Text (Text)+import qualified Data.Text as T++import Langchain.Memory.Core (BaseMemory (..), formatHistory)+import Langchain.Model+  ( ChatModel (..)+  , Message (..)+  , Role (..)+  , extractMessageText+  , systemMessage+  , userMessage+  )++-- | Progressive summarization memory backed by thread-safe STM TVars+data SummaryMemory model = SummaryMemory+  { summaryModel :: model+  , maxMessageThreshold :: !Int+  , summaryBufferVar :: !(TVar Text)+  , recentMessagesVar :: !(TVar [Message])+  , promptBuilder :: !(Text -> [Message] -> Text)+  , initialMessagesList :: ![Message]+  }++-- | Default summarization prompt generator+defaultSummaryPrompt :: Text -> [Message] -> Text+defaultSummaryPrompt currentSummary toSummarize =+  "Current summary:\n"+    <> currentSummary+    <> "\n\nNew lines to summarize:\n"+    <> formatMessages toSummarize+    <> "\n\nPlease provide an updated, concise summary of the conversation above."++-- | Construct a new SummaryMemory instance with default prompt+newSummaryMemory :: MonadIO m => model -> Int -> [Message] -> m (SummaryMemory model)+newSummaryMemory model threshold initMsgs =+  newSummaryMemoryWithPrompt model threshold initMsgs defaultSummaryPrompt++-- | Construct a SummaryMemory instance with custom summarization prompt generator+newSummaryMemoryWithPrompt ::+  MonadIO m =>+  model ->+  Int ->+  [Message] ->+  (Text -> [Message] -> Text) ->+  m (SummaryMemory model)+newSummaryMemoryWithPrompt model threshold initMsgs pBuilder = liftIO $ do+  sVar <- newTVarIO ""+  mVar <- newTVarIO initMsgs+  pure $ SummaryMemory model threshold sVar mVar pBuilder initMsgs++-- | Retrieve the current accumulated summary text+getSummary :: MonadIO m => SummaryMemory model -> m Text+getSummary SummaryMemory {..} = liftIO $ readTVarIO summaryBufferVar++instance (ChatModel model) => BaseMemory (SummaryMemory model) where+  messages SummaryMemory {..} = liftIO $ do+    sumTxt <- readTVarIO summaryBufferVar+    recent <- readTVarIO recentMessagesVar+    if T.null sumTxt+      then pure recent+      else do+        -- Preserve any system instructions at the head, followed by the summary, followed by recent turns+        let (sysMsgs, nonSysMsgs) = partition (\m -> messageRole m == System) recent+            summaryMsg = systemMessage ("Summary of previous conversation:\n" <> sumTxt)+        pure (sysMsgs ++ [summaryMsg] ++ nonSysMsgs)++  addMessage SummaryMemory {..} newMsg = do+    -- 1. Append message to recent buffer+    (shouldSummarize, toSummarize, keepCount) <- liftIO $ atomically $ do+      modifyTVar' recentMessagesVar (\msgs -> msgs ++ [newMsg])+      currentMsgs <- readTVar recentMessagesVar+      if length currentMsgs > maxMessageThreshold+        then do+          let keep = max 2 (maxMessageThreshold `div` 2)+              (old, _) = splitAt (length currentMsgs - keep) currentMsgs+          pure (True, old, keep)+        else pure (False, [], length currentMsgs)++    -- 2. If summarization threshold reached, execute LLM summarization.+    -- Crucial: Pruning ONLY happens after the LLM invoke succeeds!+    when (shouldSummarize && not (null toSummarize)) $ do+      currentSummary <- liftIO $ readTVarIO summaryBufferVar+      let summaryPrompt = promptBuilder currentSummary toSummarize+      aiResp <- invoke summaryModel [userMessage summaryPrompt] Nothing+      let newSummary = extractMessageText aiResp++      -- Atomically commit new summary and prune summarized messages+      liftIO $ atomically $ do+        writeTVar summaryBufferVar newSummary+        modifyTVar' recentMessagesVar (\msgs -> drop (max 0 (length msgs - keepCount)) msgs)++  clear SummaryMemory {..} = liftIO $ atomically $ do+    writeTVar summaryBufferVar ""+    writeTVar recentMessagesVar []++formatMessages :: [Message] -> Text+formatMessages = formatHistory

@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Langchain.Model+Description : Central ChatModel typeclass for LLM providers+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Provides effect-polymorphic 'ChatModel' interface.+-}+module Langchain.Model+  ( ChatModel (..)+  , module Langchain.Model.Types+  ) where++import Control.Monad.Except (MonadError)+import Control.Monad.IO.Class (MonadIO)+import Data.Kind (Type)++import Langchain.Error (LangchainError)+import Langchain.Model.Types+import Langchain.Stream (ChatStream)++-- | Effect-polymorphic ChatModel typeclass for LLM providers+class ChatModel model where+  type ModelConfig model :: Type++  -- | Single synchronous invocation+  invoke ::+    (MonadIO m, MonadError LangchainError m) =>+    model ->+    [Message] ->+    Maybe (ModelConfig model) ->+    m Message++  -- | Batch invocations (default: sequential)+  batch ::+    (MonadIO m, MonadError LangchainError m) =>+    model ->+    [[Message]] ->+    Maybe (ModelConfig model) ->+    m [Message]+  batch model msgs cfg = mapM (\m -> invoke model m cfg) msgs++  -- | Streaming invocation yielding structured StreamEvents via Conduit+  stream ::+    model ->+    [Message] ->+    Maybe (ModelConfig model) ->+    ChatStream

@@ -0,0 +1,200 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-partial-fields #-}++{- |+Module      : Langchain.Model.Types+Description : Multi-modal ContentBlock and Message data types+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Data types for multi-modal messages, content blocks, roles, and tool calls.+-}+module Langchain.Model.Types+  ( ContentBlock (..)+  , ImageContent (..)+  , ImageSource (..)+  , Role (..)+  , ToolCall (..)+  , Message (..)+  , textMessage+  , userMessage+  , systemMessage+  , assistantMessage+  , toolMessage+  , imageMessage+  , extractMessageText+  , roleLabel+  , formatMessageString+  ) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.:?), (.=))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as Base64+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+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.Encoding as TE+import GHC.Generics (Generic)++-- | A single content block within a multi-modal message.+data ContentBlock+  = TextBlock {blockText :: Text}+  | ImageBlock ImageContent+  | AudioBlock {blockMimeType :: Text, blockBase64 :: Text}+  | DataBlock {blockBytes :: ByteString}+  deriving (Eq, Show, Generic)++-- | Multi-modal image content with source, optional detail, and metadata.+data ImageContent = ImageContent+  { imageSource :: ImageSource+  , imageDetail :: Maybe Text+  , imageMetadata :: Maybe Value+  }+  deriving (Eq, Show, Generic)++-- | Underlying image data source: either raw base64 or a remote URL.+data ImageSource+  = ImageBase64 {imageMimeType :: Maybe Text, imageData :: Text}+  | ImageUrl {imageUrl :: Text}+  deriving (Eq, Show, Generic)++instance ToJSON ContentBlock where+  toJSON (TextBlock t) = object ["type" .= ("text" :: Text), "text" .= t]+  toJSON (ImageBlock ImageContent {imageSource = ImageUrl url, imageDetail = detail}) =+    object+      [ "type" .= ("image_url" :: Text)+      , "image_url" .= object (maybe id ((:) . ("detail" .=)) detail ["url" .= url])+      ]+  toJSON (ImageBlock ImageContent {imageSource = ImageBase64 (Just mime) imageData, imageMetadata = metadata}) =+    object $+      ["type" .= ("image" :: Text), "mime_type" .= mime, "data" .= imageData]+        <> maybe [] (pure . ("metadata" .=)) metadata+  toJSON (ImageBlock ImageContent {imageSource = ImageBase64 _ imageData, imageMetadata = metadata}) =+    object $+      ["type" .= ("image" :: Text), "source_type" .= ("base64" :: Text), "data" .= imageData]+        <> maybe [] (pure . ("metadata" .=)) metadata+  toJSON (AudioBlock mime b64) = object ["type" .= ("audio" :: Text), "mime_type" .= mime, "data" .= b64]+  toJSON (DataBlock bs) = object ["type" .= ("data" :: Text), "data" .= TE.decodeUtf8 (Base64.encode bs)]++instance FromJSON ContentBlock where+  parseJSON = withObject "ContentBlock" $ \v -> do+    typ <- v .: "type"+    case (typ :: Text) of+      "text" -> TextBlock <$> v .: "text"+      "image" -> do+        mimeType <- v .:? "mime_type"+        case mimeType of+          Just mime -> do+            imageData <- v .: "data"+            metadata <- v .:? "metadata"+            pure $ ImageBlock $ ImageContent (ImageBase64 (Just mime) imageData) Nothing metadata+          Nothing -> do+            sourceType <- v .: "source_type"+            imageData <- v .: "data"+            metadata <- v .:? "metadata"+            let source =+                  case (sourceType :: Text) of+                    "url" -> ImageUrl imageData+                    _ -> ImageBase64 Nothing imageData+            pure $ ImageBlock $ ImageContent source Nothing metadata+      "image_url" -> do+        imageUrl <- v .: "image_url"+        url <- imageUrl .: "url"+        detail <- imageUrl .:? "detail"+        pure $ ImageBlock $ ImageContent (ImageUrl url) detail Nothing+      "audio" -> AudioBlock <$> v .: "mime_type" <*> v .: "data"+      "data" -> do+        b64Text <- v .: "data"+        case Base64.decode (TE.encodeUtf8 b64Text) of+          Left err -> fail $ "Invalid base64 data block: " ++ err+          Right bs -> pure $ DataBlock bs+      other -> fail $ "Unknown ContentBlock type: " ++ show other++-- | Complete set of conversation roles supported across LLM providers.+data Role+  = System+  | User+  | Assistant+  | Tool+  | Developer+  | Function+  deriving (Eq, Ord, Show, Bounded, Enum, Generic, ToJSON, FromJSON)++-- | Structured tool call from an LLM response.+data ToolCall = ToolCall+  { toolCallId :: Text+  , toolCallType :: Text+  -- ^ Always "function" for current providers+  , toolCallName :: Text+  , toolCallArguments :: Value+  -- ^ Parsed JSON Value arguments+  }+  deriving (Eq, Show, Generic, ToJSON, FromJSON)++-- | Structured chat message supporting multi-modal content blocks.+data Message = Message+  { messageRole :: Role+  , messageContents :: NonEmpty ContentBlock+  , messageName :: Maybe Text+  , messageToolCalls :: Maybe [ToolCall]+  , messageToolId :: Maybe Text+  -- ^ Associated tool call ID for Tool role+  , messageMetadata :: Map Text Value+  -- ^ Opaque provider-specific metadata.+  }+  deriving (Eq, Show, Generic, ToJSON, FromJSON)++-- | Create a message with a single text content block.+textMessage :: Role -> Text -> Message+textMessage r t = Message r (TextBlock t :| []) Nothing Nothing Nothing Map.empty++-- | Create a User role text message.+userMessage :: Text -> Message+userMessage = textMessage User++-- | Create a System role text message.+systemMessage :: Text -> Message+systemMessage = textMessage System++-- | Create an Assistant role text message.+assistantMessage :: Text -> Message+assistantMessage = textMessage Assistant++-- | Create a Tool role text message.+toolMessage :: Text -> Message+toolMessage = textMessage Tool++-- | Create an Image content block message.+imageMessage :: Role -> Text -> Text -> Message+imageMessage r mime b64 =+  Message+    r+    (ImageBlock (ImageContent (ImageBase64 (Just mime) b64) Nothing Nothing) :| [])+    Nothing+    Nothing+    Nothing+    Map.empty++-- | Extract all text content blocks concatenated into a single Text string.+extractMessageText :: Message -> Text+extractMessageText msg = T.intercalate "\n" [t | TextBlock t <- NonEmpty.toList (messageContents msg)]++-- | Label used when rendering a chat message role as plain text.+roleLabel :: Role -> Text+roleLabel System = "System"+roleLabel User = "Human"+roleLabel Assistant = "AI"+roleLabel Tool = "Tool"+roleLabel Developer = "Developer"+roleLabel Function = "Function"++-- | Render a message as a single plain-text line with its role label.+formatMessageString :: Message -> Text+formatMessageString chatMessage =+  roleLabel (messageRole chatMessage) <> ": " <> extractMessageText chatMessage

@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module      : Langchain.Monad+Description : Core LangchainT monad transformer+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Provides the canonical monad transformer stack 'LangchainT' and its execution+runner 'runLangchainT'.++'LangchainT' is parameterised over the reader environment @r@, so each+provider (or application) can supply its own config type rather than being+forced into a one-size-fits-all @LangchainConfig@.  Use @r = ()@ when you do+not need a shared environment at all.++@+-- With a custom config+type App a = LangchainT MyConfig IO a++runApp :: MyConfig -> App a -> IO (Either LangchainError a)+runApp = runLangchainT++-- Without any config+runSimple :: LangchainT () IO a -> IO (Either LangchainError a)+runSimple = runLangchainT ()+@+-}+module Langchain.Monad+  ( LangchainT+  , runLangchainT+  , throwLangchainError+  ) where++import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)+import Control.Monad.Reader (ReaderT, runReaderT)++import Langchain.Error (LangchainError)++{- | Standard framework monad transformer stack: ReaderT over ExceptT.++The type variable @r@ is the reader environment — pass your own provider+config, application context, or @()@ when none is needed.+-}+type LangchainT r m = ReaderT r (ExceptT LangchainError m)++-- | Execute a 'LangchainT' computation with a given environment.+runLangchainT :: r -> LangchainT r m a -> m (Either LangchainError a)+runLangchainT env action = runExceptT (runReaderT action env)++-- | Throw a 'LangchainError' inside any 'MonadError' context.+throwLangchainError :: MonadError LangchainError m => LangchainError -> m a+throwLangchainError = throwError

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

@@ -0,0 +1,18 @@+{- |+Module      : Langchain.OutputParser+Description : Output parsers and structured data extraction+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Output parsers to transform raw LLM text into structured formats including+lists, JSON, and typed Haskell data structures via JSON Schema generation.+-}+module Langchain.OutputParser+  ( module Langchain.OutputParser.Core+  , module Langchain.OutputParser.Structured+  ) where++import Langchain.OutputParser.Core+import Langchain.OutputParser.Structured

@@ -0,0 +1,84 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module:      Langchain.OutputParser.Core+Copyright:   (c) 2025-2026 Tushar Adhatrao+License:     MIT+Maintainer:  Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability:   experimental++Core output parser typeclass and standard instances for basic text transformations.+For typed JSON and schema-driven parsing, see "Langchain.OutputParser.Structured".+-}+module Langchain.OutputParser.Core+  ( -- * Typeclass+    OutputParser (..)++    -- * Parsers+  , CommaSeparatedList (..)+  ) where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Text.Read as TR++import Langchain.Error (LangchainResult, parsingError)++{- | Typeclass for parsing output from language models into specific types.+Instances of this class define how to convert a 'Text' output into a value of type @a@.+-}+class OutputParser a where+  {- | Parse the given text into a value of type @a@.+  Returns 'Left' with an error message if parsing fails, or 'Right' with the parsed value.+  -}+  parse :: Text -> LangchainResult a++-- | Identity parser returning the raw text output unchanged.+instance OutputParser Text where+  parse = Right++{- | Parse a boolean value from text using case-insensitive normalization.++Accepts @"true"@, @"t"@, @"yes"@, @"1"@ as 'True', and @"false"@, @"f"@, @"no"@, @"0"@ as 'False'.+-}+instance OutputParser Bool where+  parse txt =+    case T.toLower (T.strip txt) of+      "true" -> Right True+      "t" -> Right True+      "yes" -> Right True+      "1" -> Right True+      "false" -> Right False+      "f" -> Right False+      "no" -> Right False+      "0" -> Right False+      _ -> Left $ parsingError "Invalid boolean value" (Just "Bool") (Just txt)++-- | Represents a list of text items separated by commas.+newtype CommaSeparatedList = CommaSeparatedList [Text]+  deriving (Show, Eq)++instance OutputParser CommaSeparatedList where+  parse txt = Right $ CommaSeparatedList $ map T.strip $ T.splitOn "," txt++-- | Parse an 'Int' value from trimmed text output.+instance OutputParser Int where+  parse txt =+    case TR.readMaybe (T.unpack (T.strip txt)) of+      Just n -> Right n+      Nothing -> Left $ parsingError "Failed to parse Int from output" (Just "Int") (Just txt)++-- | Parse an 'Integer' value from trimmed text output.+instance OutputParser Integer where+  parse txt =+    case TR.readMaybe (T.unpack (T.strip txt)) of+      Just n -> Right n+      Nothing -> Left $ parsingError "Failed to parse Integer from output" (Just "Integer") (Just txt)++-- | Parse a 'Double' value from trimmed text output.+instance OutputParser Double where+  parse txt =+    case TR.readMaybe (T.unpack (T.strip txt)) of+      Just n -> Right n+      Nothing -> Left $ parsingError "Failed to parse Double from output" (Just "Double") (Just txt)

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

@@ -0,0 +1,382 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}++{- |+Module      : Langchain.Prelude+Description : Canonical umbrella re-export module for langchain-hs-core+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Exports all core data types, typeclasses, vector stores, memory stores,+advanced agents, guardrails, observability, structured logging,+circuit breakers, callbacks, output parsers, and pipeline DSLs.+-}+module Langchain.Prelude+  ( -- * Core Monad & Errors+    LangchainT+  , runLangchainT+  , throwLangchainError+  , LangchainError (..)+  , ErrorContext (..)+  , errorMessage+  , mkContext+  , mkContextIO+  , LangchainResult+  , llmError+  , parsingError+  , vectorStoreError+  , documentLoaderError+  , embeddingError+  , runnableError+  , toolError+  , agentError+  , memoryError+  , networkError+  , configurationError+  , validationError+  , internalError++    -- * Multi-Modal Models & Messages+  , ChatModel (..)+  , Message (..)+  , Role+  , ContentBlock (..)+  , ToolCall (..)+  , textMessage+  , userMessage+  , systemMessage+  , assistantMessage+  , toolMessage+  , imageMessage+  , extractMessageText+  , StreamEvent+    ( LLMStart+    , LLMChunk+    , LLMEnd+    , ToolStart+    , ToolEnd+    , ToolErrorEvent+    , ChainStart+    , ChainEnd+    , NodeStart+    , NodeEnd+    )+  , TokenUsage (..)+  , EventStream+  , collectEvents+  , printEvents++    -- * Pure AST Pipelines (RunnableTree)+  , RunnableTree (..)+  , (|>>)+  , (&>&)+  , interpret+  , runLambda+  , runPrim+  , runPure+  , runPassthrough+  , runIdent+  , runBranch+  , runFallback+  , runChat+  , runChatWithConfig+  , runModel+  , runModelWithConfig+  , runConfiguredModel+  , runRetriever+  , ModelRunnable (..)+  , modelRunnable+  , modelRunnableWithConfig+  , bindConfig+  , TextModelRunnable (..)+  , textModelRunnable+  , textModelRunnableWithConfig+  , bindTextConfig+  , ConfiguredModelRunnable (..)++    -- * Effect-Polymorphic Tools+  , Tool (..)+  , createTool+  , toolToValue+  , ToolBinder (..)+  , DeriveToolSchema (..)+  , deriveToolParametersSchema++    -- * Advanced Agent Patterns+  , PlanStep (..)+  , Plan (..)+  , StepExecutor (..)+  , PlanAndExecuteAgent (..)+  , newPlanAndExecuteAgent+  , newPlanAndExecuteAgentWithTools+  , runPlanAndExecute++    -- * Guardrails & Safety+  , GuardrailResult (..)+  , Guardrail (..)+  , contentSafetyGuardrail+  , topicGuardrail+  , outputLengthGuardrail+  , composeGuardrails+  , withGuardrails++    -- * Telemetry, Logging & OpenTelemetry+  , LogLevel (..)+  , LogEvent (..)+  , Logger (..)+  , InMemoryLogger (..)+  , newInMemoryLogger+  , getInMemoryLogs+  , stderrLogger+  , logEvent+  , logDebug+  , logInfo+  , logWarn+  , logError+  , SpanKind (..)+  , SpanStatus (..)+  , Span (..)+  , OTelTracer (..)+  , newOTelTracer+  , getSpans+  , startSpan+  , endSpan+  , addSpanAttribute+  , withSpan+  , exportSpansJson++    -- * Callbacks+  , CallbackEvent (..)+  , CallbackHandler (..)+  , CallbackManager (..)+  , newCallbackManager+  , registerHandler+  , dispatchEvent+  , dispatchEventAsync+  , newLoggingCallbackHandler+  , getCallbackLogs++    -- * Resilience+  , CircuitState (..)+  , CircuitBreakerConfig (..)+  , defaultCircuitConfig+  , CircuitBreaker (..)+  , newCircuitBreaker+  , getCircuitState+  , withCircuitBreaker++    -- * Memory Systems+  , BaseMemory (..)+  , SomeMemory (..)+  , ConversationBufferMemory (..)+  , newConversationBufferMemory+  , resetConversationBuffer+  , WindowBufferMemory (..)+  , newWindowBufferMemory+  , resetWindowBuffer+  , TokenBufferMemory (..)+  , newTokenBufferMemory+  , resetTokenBuffer+  , countTokens+  , SummaryMemory (..)+  , newSummaryMemory+  , SessionId+  , SessionMemoryStore (..)+  , newSessionMemoryStore+  , newSessionMemoryStoreWithTTL+  , getSessionMemory+  , listSessions+  , hasSession+  , deleteSession+  , clearAllSessions+  , sessionCount+  , cleanupExpiredSessions+  , exportAllSessions+  , EntityMemory (..)+  , newEntityMemory+  , setEntity+  , getEntity+  , getAllEntities+  , deleteEntity+  , clearEntities+  , formatEntities+  , resetEntitiesToInitial+  , CombinedMemory (..)+  , newCombinedMemory+  , initialMessages+  , trimMessages+  , resetToInitial++    -- * Vector Stores & Retrieval+  , VectorStore (..)+  , InMemory (..)+  , emptyInMemoryVectorStore+  , fromDocuments+  , Retriever (..)+  , VectorStoreRetriever (..)+  , retrieveWithCallbacks++    -- * Embeddings (provider-agnostic typeclass)+  , Embeddings (..)++    -- * Document Loaders+  , Document (..)+  , BaseLoader (..)+  , FileLoader (..)+  , DirectoryLoader (..)+  , DirectoryLoaderOptions (..)+  , defaultDirectoryLoaderOptions+  , splitDocuments++    -- * Prompt Templates+  , PromptTemplate (..)+  , PromptTemplateOptions (..)+  , TemplateFormat (..)+  , defaultPromptTemplateOptions+  , fromTemplate+  , fromTemplateWithOptions+  , fromTemplateWithFormat+  , partialPromptTemplate+  , renderPrompt++    -- * Text Splitters+  , CharacterSplitterOps (CharacterSplitterOps)+  , defaultCharacterSplitterOps+  , splitText+  , RecursiveCharacterSplitterOps (RecursiveCharacterSplitterOps)+  , defaultRecursiveCharacterSplitterOps+  , splitTextRecursive+  , MarkdownSplitterOps (MarkdownSplitterOps)+  , defaultMarkdownSplitterOps+  , splitMarkdown+  , splitMarkdownToChunks+  , TokenSplitterOps (TokenSplitterOps)+  , defaultTokenSplitterOps+  , splitByTokens+  , Language (..)+  , CodeSplitterOps (CodeSplitterOps)+  , splitCode++    -- * Caching & Resilience+  , CacheBackend (..)+  , InMemoryCache (..)+  , newInMemoryCache+  , SQLiteCache (..)+  , newSQLiteCache+  , CachedModel (..)+  , CacheableChatModel (..)+  , withCaching+  , RetryPolicy (RetryPolicy)+  , defaultRetryPolicy+  , withRetry+  , RateLimiter (..)+  , newRateLimiter+  , withRateLimit++    -- * Chains+  , RetrievalQA (RetrievalQA)+  , newRetrievalQA+  , runRetrievalQA++    -- * Structured Output & Parsers+  , OutputParser (..)+  , CommaSeparatedList (..)+  , StructuredOutput (..)+  , TypeSchema (..)+  , structuredInvoke+  , structuredInvokeWithRetries++    -- * Agents & Execution+  , ReActAgent (ReActAgent)+  , AgentStep (..)+  , AgentTrace (..)+  , ToolErrorStrategy (..)+  , defaultReActAgent+  , withMemory+  , withoutMemory+  , withSystemPrompt+  , withMaxIterations+  , withModelConfig+  , withCallbackManager+  , withStopCondition+  , withToolErrorStrategy+  , reactStep+  , runReActAgent+  , runReActAgentWithTrace++    -- * Tool Suite & Security+  , ToolTier (..)+  , SecurityPolicy (..)+  , defaultSecurityPolicy+  , readOnlySecurityPolicy+  , workspaceSandboxPolicy+  , withSecurity+  , newFileSystemSuite+  , findFilesTool+  , grepSearchTool+  , readFileTool+  , listDirTool+  , editFileTool+  , writeFileTool+  , newProcessSuite+  , commandRunTool+  , commandStatusTool+  , commandKillTool+  , shellTool++    -- * Hybrid Retrieval & BM25+  , BM25Index (..)+  , newBM25Index+  , newBM25IndexWithParams+  , addDocumentsBM25+  , bm25Search+  , bm25SearchWithScores+  , HybridRetriever (..)+  , newHybridRetriever+  , newHybridRetrieverWithWeights+  , searchHybrid+  , searchHybridWithScores+  , reciprocalRankFusion+  ) where++import Langchain.Agent.PlanAndExecute+import Langchain.Agent.ReAct+import Langchain.Cache.Core+import Langchain.Callback.Manager+import Langchain.Chain.RetrievalQA+import Langchain.DocumentLoader.Core+import Langchain.DocumentLoader.DirectoryLoader+import Langchain.DocumentLoader.FileLoader+import Langchain.Embeddings.Core+import Langchain.Error+import Langchain.Guardrail.Core+import Langchain.Memory+import Langchain.Model+import Langchain.Monad+import Langchain.Observability+import Langchain.OutputParser.Core+import Langchain.OutputParser.Structured+import Langchain.PromptTemplate.Prompt+import Langchain.Resilience.CircuitBreaker+import Langchain.Resilience.Retry+import Langchain.Retriever.BM25+import Langchain.Retriever.Core+import Langchain.Retriever.Hybrid+import Langchain.Runnable hiding (invoke)+import Langchain.Stream+import Langchain.TextSplitter.Character+import Langchain.TextSplitter.Code+import Langchain.TextSplitter.Markdown+import Langchain.TextSplitter.RecursiveCharacter+import Langchain.TextSplitter.Token+import Langchain.Tool+import Langchain.Tool.Binding+import Langchain.Tool.FileSystem+import Langchain.Tool.GenericSchema+import Langchain.Tool.Process+import Langchain.Tool.Security+import Langchain.Tool.Shell (shellTool)+import Langchain.VectorStore.Core+import Langchain.VectorStore.InMemory

@@ -0,0 +1,17 @@+{- |+Module      : Langchain.PromptTemplate+Description : Prompt templates and variable interpolation+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++String-based prompt templates with variable interpolation and Runnable integration.+-}+module Langchain.PromptTemplate+  ( module Langchain.PromptTemplate.Prompt+  , module Langchain.PromptTemplate.String+  ) where++import Langchain.PromptTemplate.Prompt+import Langchain.PromptTemplate.String

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

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

@@ -0,0 +1,18 @@+{- |+Module      : Langchain.Resilience+Description : Resilience patterns for LLM invocations and tool calls+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Resilience combinators including exponential backoff retries, token-bucket rate limiting,+and circuit breakers for fault-tolerant LLM pipelines.+-}+module Langchain.Resilience+  ( module Langchain.Resilience.CircuitBreaker+  , module Langchain.Resilience.Retry+  ) where++import Langchain.Resilience.CircuitBreaker+import Langchain.Resilience.Retry

@@ -0,0 +1,119 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Resilience.CircuitBreaker+Description : Circuit breaker pattern for LLM provider failover and graceful degradation+Copyright   : (c) 2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Implements the Circuit Breaker pattern (Closed, Open, HalfOpen) to prevent cascading failures+when upstream LLM APIs or vector stores experience outages.+-}+module Langchain.Resilience.CircuitBreaker+  ( CircuitState (..)+  , CircuitBreakerConfig (..)+  , defaultCircuitConfig+  , CircuitBreaker (..)+  , newCircuitBreaker+  , getCircuitState+  , withCircuitBreaker+  ) where++import Control.Concurrent.STM+import Control.Monad.Except (MonadError, catchError, throwError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)+import GHC.Generics (Generic)++import Langchain.Error (LangchainError, internalError)++-- | State of the circuit breaker+data CircuitState+  = CircuitClosed+  | CircuitOpen !UTCTime -- Timestamp when opened+  | CircuitHalfOpen+  deriving (Show, Eq, Generic, ToJSON, FromJSON)++-- | Configuration parameters for the circuit breaker+data CircuitBreakerConfig = CircuitBreakerConfig+  { failureThreshold :: !Int+  , resetTimeoutSec :: !Double+  }+  deriving (Show, Eq, Generic, ToJSON, FromJSON)++-- | Sensible default configuration (5 failures to open, 30 seconds reset timeout)+defaultCircuitConfig :: CircuitBreakerConfig+defaultCircuitConfig =+  CircuitBreakerConfig+    { failureThreshold = 5+    , resetTimeoutSec = 30.0+    }++-- | Circuit breaker handle backed by STM TVar+data CircuitBreaker = CircuitBreaker+  { circuitName :: !Text+  , circuitConfig :: !CircuitBreakerConfig+  , circuitStateVar :: !(TVar (CircuitState, Int)) -- (State, consecutive failures)+  }++-- | Construct a new CircuitBreaker+newCircuitBreaker :: MonadIO m => Text -> CircuitBreakerConfig -> m CircuitBreaker+newCircuitBreaker name cfg = liftIO $ do+  var <- newTVarIO (CircuitClosed, 0)+  pure $ CircuitBreaker name cfg var++-- | Query current state of the circuit breaker+getCircuitState :: MonadIO m => CircuitBreaker -> m CircuitState+getCircuitState CircuitBreaker {..} = liftIO $ do+  (st, _) <- readTVarIO circuitStateVar+  pure st++-- | Execute a protected action through the circuit breaker+withCircuitBreaker ::+  (MonadIO m, MonadError LangchainError m) =>+  CircuitBreaker ->+  m a ->+  m a+withCircuitBreaker CircuitBreaker {..} action = do+  now <- liftIO getCurrentTime+  canProceed <- liftIO $ atomically $ do+    (st, _) <- readTVar circuitStateVar -- Only the state is needed to gate; count is managed in the error handler below+    case st of+      CircuitClosed -> pure True+      CircuitHalfOpen -> pure True+      CircuitOpen openTime ->+        if diffUTCTime now openTime >= realToFrac (resetTimeoutSec circuitConfig)+          then do+            writeTVar circuitStateVar (CircuitHalfOpen, 0)+            pure True+          else pure False++  if not canProceed+    then+      throwError $+        internalError+          ("Circuit breaker '" <> circuitName <> "' is OPEN. Fast-failing request.")+          (Just circuitName)+          Nothing+    else do+      res <-+        action `catchError` \err -> do+          liftIO $ atomically $ do+            (st, fails) <- readTVar circuitStateVar+            let newFails = fails + 1+            if newFails >= failureThreshold circuitConfig+              then writeTVar circuitStateVar (CircuitOpen now, newFails)+              else writeTVar circuitStateVar (st, newFails)+          throwError err++      -- On success, reset circuit to closed and reset failure count+      liftIO $ atomically $ writeTVar circuitStateVar (CircuitClosed, 0)+      pure res

@@ -0,0 +1,114 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module      : Langchain.Resilience.Retry+Description : Retry policies with exponential backoff and token-bucket rate limiting+Copyright   : (c) 2025-2026 Tushar Adhatrao+License     : MIT+Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability   : experimental++Resilience combinators for network calls and LLM provider invocations.+-}+module Langchain.Resilience.Retry+  ( RetryPolicy (..)+  , defaultRetryPolicy+  , withRetry+  , RateLimiter (..)+  , newRateLimiter+  , withRateLimit+  ) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.STM+import Control.Monad (when)+import Control.Monad.Except (MonadError, catchError, throwError)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Time.Clock+import System.Random (randomRIO)++import Langchain.Error (LangchainError)++-- | Exponential backoff retry policy+data RetryPolicy = RetryPolicy+  { maxRetries :: !Int+  , baseDelayMicros :: !Int+  , maxDelayMicros :: !Int+  , useJitter :: !Bool+  }+  deriving (Show, Eq)++-- | Default retry policy (3 retries, base 50ms, max 2s, with jitter)+defaultRetryPolicy :: RetryPolicy+defaultRetryPolicy =+  RetryPolicy+    { maxRetries = 3+    , baseDelayMicros = 50000+    , maxDelayMicros = 2000000+    , useJitter = True+    }++-- | Execute an action with retry according to RetryPolicy on LangchainError+withRetry ::+  (MonadIO m, MonadError LangchainError m) =>+  RetryPolicy ->+  m a ->+  m a+withRetry policy action = go (maxRetries policy) (baseDelayMicros policy)+  where+    go retriesLeft currentDelay =+      action `catchError` \err ->+        if retriesLeft <= 0+          then throwError err+          else do+            delayWithJitter <-+              if useJitter policy+                then liftIO $ randomRIO (currentDelay `div` 2, currentDelay)+                else pure currentDelay+            liftIO $ threadDelay delayWithJitter+            let nextDelay = min (maxDelayMicros policy) (currentDelay * 2)+            go (retriesLeft - 1) nextDelay++-- | Token bucket rate limiter backed by STM TVars+data RateLimiter = RateLimiter+  { bucketCapacity :: !Double+  , refillRatePerSec :: !Double+  , tokensVar :: !(TVar Double)+  , lastRefillVar :: !(TVar UTCTime)+  }++-- | Construct a new Token Bucket RateLimiter (e.g. capacity = 10 tokens, refill = 5 tokens/sec)+newRateLimiter :: MonadIO m => Double -> Double -> m RateLimiter+newRateLimiter cap rate = liftIO $ do+  now <- getCurrentTime+  tVar <- newTVarIO cap+  rVar <- newTVarIO now+  pure $ RateLimiter cap rate tVar rVar++-- | Execute an action subject to token-bucket rate limiting (blocks if bucket empty)+withRateLimit :: (MonadIO m) => RateLimiter -> m a -> m a+withRateLimit RateLimiter {..} action = do+  liftIO $ do+    waitForToken+  action+  where+    waitForToken = do+      now <- getCurrentTime+      waitNeeded <- atomically $ do+        lastTime <- readTVar lastRefillVar+        tokens <- readTVar tokensVar+        let elapsedSecs = realToFrac (diffUTCTime now lastTime) :: Double+            refilledTokens = min bucketCapacity (tokens + elapsedSecs * refillRatePerSec)+        if refilledTokens >= 1.0+          then do+            writeTVar tokensVar (refilledTokens - 1.0)+            writeTVar lastRefillVar now+            pure (0 :: Int)+          else do+            let deficit = 1.0 - refilledTokens+                sleepSecs = deficit / refillRatePerSec+            pure (ceiling (sleepSecs * 1000000) :: Int)+      when (waitNeeded > 0) $ do+        threadDelay waitNeeded+        waitForToken