langchain-hs-graph (empty) → 0.0.5.0
raw patch · 14 files changed
+896/−0 lines, 14 filesdep +QuickCheckdep +aesondep +async
Dependencies added: QuickCheck, aeson, async, base, bytestring, containers, filepath, langchain-hs-core, langchain-hs-graph, mtl, sqlite-simple, stm, tasty, tasty-hunit, tasty-quickcheck, temporary, text, time
Files
- CHANGELOG.md +14/−0
- LICENSE +20/−0
- README.md +26/−0
- langchain-hs-graph.cabal +114/−0
- src/Langchain/Graph/Checkpointer.hs +116/−0
- src/Langchain/Graph/HITL.hs +87/−0
- src/Langchain/Graph/MultiAgent.hs +96/−0
- src/Langchain/Graph/Parallel.hs +52/−0
- src/Langchain/Graph/StateGraph.hs +155/−0
- test/Spec.hs +21/−0
- test/Test/Langchain/Graph/CheckpointerSpec.hs +38/−0
- test/Test/Langchain/Graph/HITLSpec.hs +48/−0
- test/Test/Langchain/Graph/MultiAgentSpec.hs +53/−0
- test/Test/Langchain/Graph/StateGraphSpec.hs +56/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+# Changelog for `langchain-hs-graph`++All notable changes to this package will be documented in this file.++## 0.0.5.0 - 2026-09-10++- Initial standalone Hackage release of `langchain-hs-graph`.+- Cyclic graph orchestration engine (`StateGraph s m`).+- Pure monoidal state merge reducers (`StateReducer s`).+- In-memory STM `TVar` checkpointer and persistent SQLite checkpointer.+- Human-in-the-Loop (`HITL`) interruption and resumption.+- Parallel concurrent node execution via `async`.+- Multi-Agent coordination: Supervisor teams, debate loops, and voting classifiers.+- Graphviz DOT export for visual workflow inspection.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025-2026 Tushar Adhatrao++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,26 @@+# `langchain-hs-graph`++> Stateful agent orchestration and cyclic graph workflows for `langchain-hs` (LangGraph in Haskell).++`langchain-hs-graph` provides cyclic state machines, pure monoidal state reducers, in-memory STM checkpointers, persistent SQLite checkpointers, Human-in-the-Loop (`HITL`) interrupts, and multi-agent coordination patterns.++## Key Primitives++- **`StateGraph s m`**: Cyclic workflow builder with typed nodes, directed edges, and conditional branches.+- **`StateReducer s`**: Pure binary state merge reducer (`s -> s -> s`) satisfying monoid associativity laws.+- **Checkpointers**:+ - `MemoryCheckpointer`: In-memory thread-safe state persistence using STM `TVar`.+ - `SQLiteCheckpointer`: Persistent state checkpointer for production runs.+- **Human-in-the-Loop (`HITL`)**: Node interruption before execution, inspection/modification, and resumed execution via `resumeGraph`.+- **Parallel Nodes**: Concurrent node evaluation using `async`.+- **Multi-Agent Architectures**: Supervisor teams with capability routing, multi-agent debate, and majority voting.++## Installation++```cabal+build-depends: langchain-hs-graph >= 0.0.5 && < 0.0.6+```++## License++MIT License. See [LICENSE](LICENSE).
+ langchain-hs-graph.cabal view
@@ -0,0 +1,114 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.39.6.+--+-- see: https://github.com/sol/hpack++name: langchain-hs-graph+version: 0.0.5.0+synopsis: Graph-based stateful agent orchestration engine for langchain-hs+description: StateGraph, StateReducer, Checkpointer, HITL interrupt/resume, and Multi-Agent supervisor patterns.+category: Web, AI, Control+homepage: https://github.com/tusharad/langchain-hs#readme+bug-reports: https://github.com/tusharad/langchain-hs/issues+author: Tushar Adhatrao+maintainer: tusharadhatrao@gmail.com+copyright: 2025-2026 Tushar Adhatrao+license: MIT+license-file: LICENSE+build-type: Simple+tested-with:+ GHC == 9.12.4+ , GHC == 9.10.3+ , GHC == 9.8.4+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/tusharad/langchain-hs++library+ exposed-modules:+ Langchain.Graph.StateGraph+ Langchain.Graph.Checkpointer+ Langchain.Graph.HITL+ Langchain.Graph.MultiAgent+ Langchain.Graph.Parallel+ other-modules:+ Paths_langchain_hs_graph+ hs-source-dirs:+ src+ default-extensions:+ MultiParamTypeClasses+ FunctionalDependencies+ TypeFamilies+ TypeOperators+ DataKinds+ GADTs+ OverloadedStrings+ DeriveGeneric+ DeriveAnyClass+ RecordWildCards+ FlexibleContexts+ ScopedTypeVariables+ build-depends:+ aeson >=2.0 && <3+ , async ==2.2.*+ , base >=4.17 && <5+ , bytestring >=0.10 && <0.13+ , containers >=0.6 && <0.9+ , langchain-hs-core ==0.0.5.*+ , mtl >=2.2 && <2.4+ , sqlite-simple >=0.4.18 && <0.5+ , stm ==2.5.*+ , text >=1.2 && <3+ , time >=1.9 && <1.15+ default-language: Haskell2010++test-suite langchain-hs-graph-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Langchain.Graph.CheckpointerSpec+ Test.Langchain.Graph.HITLSpec+ Test.Langchain.Graph.MultiAgentSpec+ Test.Langchain.Graph.StateGraphSpec+ Paths_langchain_hs_graph+ hs-source-dirs:+ test+ default-extensions:+ MultiParamTypeClasses+ FunctionalDependencies+ TypeFamilies+ TypeOperators+ DataKinds+ GADTs+ OverloadedStrings+ DeriveGeneric+ DeriveAnyClass+ RecordWildCards+ FlexibleContexts+ ScopedTypeVariables+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.14+ , aeson >=2.0 && <3+ , async ==2.2.*+ , base >=4.17 && <5+ , bytestring >=0.10 && <0.13+ , containers >=0.6 && <0.9+ , filepath+ , langchain-hs-core ==0.0.5.*+ , langchain-hs-graph+ , mtl >=2.2 && <2.4+ , sqlite-simple >=0.4.18 && <0.5+ , stm ==2.5.*+ , tasty >=1.4+ , tasty-hunit >=0.10+ , tasty-quickcheck >=0.10+ , temporary+ , text >=1.2 && <3+ , time >=1.9 && <1.15+ default-language: Haskell2010
+ src/Langchain/Graph/Checkpointer.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Langchain.Graph.Checkpointer+Description : Memory and SQLite state checkpointing implementations+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Provides Checkpointer typeclass, thread-safe MemoryCheckpointer, and persistent SQLiteCheckpointer.+-}+module Langchain.Graph.Checkpointer+ ( Checkpointer (..)+ , MemoryCheckpointer (..)+ , newMemoryCheckpointer+ , SQLiteCheckpointer (..)+ , newSQLiteCheckpointer+ ) where++import Control.Concurrent.STM+import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (FromJSON, ToJSON, decode, encode)+import qualified Data.ByteString.Lazy as BL+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 Database.SQLite.Simple++import Langchain.Core.Error (LangchainError, internalError)+import Langchain.Graph.StateGraph (NodeId)++-- | Effect-polymorphic Checkpointer typeclass+class Checkpointer cp m where+ saveCheckpoint :: ToJSON s => cp -> Text -> NodeId -> s -> m (Either LangchainError ())+ loadCheckpoint :: FromJSON s => cp -> Text -> NodeId -> m (Either LangchainError (Maybe s))++-- | In-memory thread-safe checkpointer using TVar+newtype MemoryCheckpointer = MemoryCheckpointer+ { memStore :: TVar (Map (Text, NodeId) BL.ByteString)+ }++-- | Construct a new MemoryCheckpointer instance+newMemoryCheckpointer :: MonadIO m => m MemoryCheckpointer+newMemoryCheckpointer = liftIO $ do+ var <- newTVarIO Map.empty+ pure $ MemoryCheckpointer var++instance MonadIO m => Checkpointer MemoryCheckpointer m where+ saveCheckpoint cp threadId nodeId state = liftIO $ do+ let bytes = encode state+ atomically $ modifyTVar' (memStore cp) (Map.insert (threadId, nodeId) bytes)+ pure $ Right ()++ loadCheckpoint cp threadId nodeId = liftIO $ do+ store <- readTVarIO (memStore cp)+ case Map.lookup (threadId, nodeId) store of+ Nothing -> pure $ Right Nothing+ Just bytes -> case decode bytes of+ Nothing ->+ pure $ Left $ internalError "Failed to decode state checkpoint" (Just "MemoryCheckpointer") Nothing+ Just s -> pure $ Right (Just s)++-- | SQLite persistent checkpointer using sqlite-simple+newtype SQLiteCheckpointer = SQLiteCheckpointer+ { dbFilePath :: FilePath+ }++-- | Construct a new SQLiteCheckpointer and initialize database table+newSQLiteCheckpointer :: MonadIO m => FilePath -> m SQLiteCheckpointer+newSQLiteCheckpointer path = liftIO $ do+ conn <- open path+ execute_+ conn+ "CREATE TABLE IF NOT EXISTS checkpoints (thread_id TEXT, node_id TEXT, state TEXT, PRIMARY KEY (thread_id, node_id))"+ close conn+ pure $ SQLiteCheckpointer path++instance MonadIO m => Checkpointer SQLiteCheckpointer m where+ saveCheckpoint cp threadId nodeId state = liftIO $ do+ let stateTxt = TE.decodeUtf8 (BL.toStrict $ encode state)+ eRes <- try $ do+ conn <- open (dbFilePath cp)+ execute+ conn+ "INSERT OR REPLACE INTO checkpoints (thread_id, node_id, state) VALUES (?, ?, ?)"+ (threadId, nodeId, stateTxt)+ close conn+ case eRes of+ Left err ->+ pure $ Left $ internalError (T.pack $ show (err :: SQLError)) (Just "SQLiteCheckpointer") Nothing+ Right () -> pure $ Right ()++ loadCheckpoint cp threadId nodeId = liftIO $ do+ eRes <- try $ do+ conn <- open (dbFilePath cp)+ rows <-+ query conn "SELECT state FROM checkpoints WHERE thread_id = ? AND node_id = ?" (threadId, nodeId) ::+ IO [[Text]]+ close conn+ pure rows+ case eRes of+ Left err ->+ pure $ Left $ internalError (T.pack $ show (err :: SQLError)) (Just "SQLiteCheckpointer") Nothing+ Right [[stateTxt]] -> case decode (BL.fromStrict $ TE.encodeUtf8 stateTxt) of+ Nothing ->+ pure $+ Left $+ internalError "Failed to decode SQLite checkpoint JSON" (Just "SQLiteCheckpointer") Nothing+ Just s -> pure $ Right (Just s)+ _ -> pure $ Right Nothing
+ src/Langchain/Graph/HITL.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Langchain.Graph.HITL+Description : Human-in-the-Loop (HITL) interrupt and state resume mechanisms+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Provides interrupt signal types and resume helpers for human review workflows.+-}+module Langchain.Graph.HITL+ ( hitlInterruptError+ , isHITLInterrupt+ , hitlNode+ , resumeGraph+ ) where++import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO)+import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import qualified Data.Text as T++import Langchain.Core.Error (LangchainError (..), agentError, errorMessage)+import Langchain.Graph.Checkpointer (Checkpointer (..))+import Langchain.Graph.StateGraph (Node (..), NodeId, StateGraph, runGraph)++-- | Construct a special HITL Interrupt LangchainError+hitlInterruptError :: NodeId -> LangchainError+hitlInterruptError targetNodeId =+ agentError ("HITL_INTERRUPT:" <> targetNodeId) (Just "HITL") (Just targetNodeId)++-- | Check whether an error is a HITL Interrupt signal and return the NodeId+isHITLInterrupt :: LangchainError -> Maybe NodeId+isHITLInterrupt err =+ let msg = errorMessage err+ in if "HITL_INTERRUPT:" `T.isPrefixOf` msg+ then Just (T.drop (T.length ("HITL_INTERRUPT:" :: Text)) msg)+ else Nothing++-- | Create a Human-in-the-Loop Node that saves a checkpoint and interrupts execution for human review+hitlNode ::+ (Checkpointer cp m, ToJSON s, MonadIO m) =>+ cp ->+ Text ->+ NodeId ->+ (s -> m (Either LangchainError s)) ->+ Node s m+hitlNode cp threadId name preAction =+ Node+ { nodeId = name+ , nodeAction = \state -> do+ eSt <- preAction state+ case eSt of+ Left err -> pure $ Left err+ Right st -> do+ _ <- saveCheckpoint cp threadId name st+ pure $ Left $ hitlInterruptError name+ }++-- | Resume an interrupted graph execution after human modification of checkpoint state+resumeGraph ::+ (Checkpointer cp m, FromJSON s, ToJSON s, MonadIO m, MonadError LangchainError m) =>+ StateGraph s m ->+ cp ->+ Text ->+ NodeId ->+ NodeId ->+ (s -> s) ->+ m s+resumeGraph stateGraph cp threadId checkpointNodeId resumeStartNodeId modifier = do+ mbState <- loadCheckpoint cp threadId checkpointNodeId+ case mbState of+ Left err -> throwError err+ Right Nothing ->+ throwError $+ agentError+ ("No checkpoint found to resume at node: " <> checkpointNodeId)+ (Just "resumeGraph")+ Nothing+ Right (Just savedState) -> do+ let modifiedState = modifier savedState+ _ <- saveCheckpoint cp threadId resumeStartNodeId modifiedState+ runGraph stateGraph resumeStartNodeId modifiedState
+ src/Langchain/Graph/MultiAgent.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Langchain.Graph.MultiAgent+Description : Multi-Agent supervisor routing and sub-graph embedding nodes+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Provides multi-agent routing supervisor nodes and sub-graph composition primitives.+-}+module Langchain.Graph.MultiAgent+ ( supervisorNode+ , embedSubGraphNode+ , embedSubGraphNodeWithStart+ ) where++import Control.Applicative ((<|>))+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO)+import Data.Text (Text)+import qualified Data.Text as T++import Langchain.Core.Error (LangchainError, agentError)+import Langchain.Core.Model (ChatModel (..), extractMessageText, userMessage)+import Langchain.Graph.StateGraph (Node (..), NodeId, StateGraph, runGraph, startNodeId)++-- | Construct a supervisor routing node that uses an LLM to select the target sub-agent NodeId+supervisorNode ::+ (ChatModel model, MonadIO m, MonadError LangchainError m) =>+ model ->+ NodeId ->+ [(Text, NodeId)] ->+ (s -> Text) ->+ (Text -> s -> s) ->+ Node s m+supervisorNode model name routes extractPrompt updateState =+ Node+ { nodeId = name+ , nodeAction = \state -> do+ let prompt =+ "You are a supervisor delegating tasks to sub-agents. Available routes:\n"+ <> T.unlines [rName <> " -> " <> targetId | (rName, targetId) <- routes]+ <> "\nTask context: "+ <> extractPrompt state+ <> "\nReply with ONLY the route name to execute."+ msg <- invoke model [userMessage prompt] Nothing+ let rawRoute = T.strip (extractMessageText msg)+ cleanRoute = T.filter (\c -> c /= '.' && c /= '"' && c /= '\'' && c /= '`') (T.toLower rawRoute)+ matchExact =+ lookup rawRoute routes+ <|> lookup (T.toLower rawRoute) [(T.toLower r, target) | (r, target) <- routes]+ <|> lookup+ cleanRoute+ [(T.toLower (T.filter (\c -> c /= '.' && c /= '"' && c /= '\'') r), target) | (r, target) <- routes]+ matchSubstring =+ case filter (\(r, _) -> T.toLower r `T.isInfixOf` cleanRoute) routes of+ ((_, target) : _) -> Just target+ [] -> Nothing+ case matchExact <|> matchSubstring of+ Just targetId -> pure $ Right $ updateState targetId state+ Nothing -> case routes of+ ((_, fallbackId) : _) -> pure $ Right $ updateState fallbackId state+ [] ->+ throwError $ agentError "No routes configured in supervisor node" (Just "supervisorNode") Nothing+ }++-- | Embed a compiled sub-graph into a parent graph node starting at a specific entry node+embedSubGraphNodeWithStart ::+ (MonadIO m, MonadError LangchainError m) =>+ NodeId ->+ NodeId ->+ StateGraph subState m ->+ (parentState -> subState) ->+ (parentState -> subState -> parentState) ->+ Node parentState m+embedSubGraphNodeWithStart name entryId subGraph toSubState mergeState =+ Node+ { nodeId = name+ , nodeAction = \parentSt -> do+ let initSubSt = toSubState parentSt+ finalSubSt <- runGraph subGraph entryId initSubSt+ pure $ Right $ mergeState parentSt finalSubSt+ }++-- | Embed a compiled sub-graph into a parent graph node starting at 'startNodeId'+embedSubGraphNode ::+ (MonadIO m, MonadError LangchainError m) =>+ NodeId ->+ StateGraph subState m ->+ (parentState -> subState) ->+ (parentState -> subState -> parentState) ->+ Node parentState m+embedSubGraphNode name = embedSubGraphNodeWithStart name startNodeId
+ src/Langchain/Graph/Parallel.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module : Langchain.Graph.Parallel+Description : Parallel concurrent node execution with state merging+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Executes multiple independent graph nodes concurrently in parallel threads using async,+and merges their resulting sub-states into the parent state via a deterministic reducer.+-}+module Langchain.Graph.Parallel+ ( parallelNode+ , addParallelNodes+ ) where++import Control.Concurrent.Async (mapConcurrently)+import Control.Monad.IO.Class (MonadIO, liftIO)++import Langchain.Core.Error (LangchainError)+import Langchain.Graph.StateGraph++-- | Construct a parallel composite node that executes worker actions concurrently+parallelNode ::+ MonadIO m =>+ NodeId ->+ [s -> IO (Either LangchainError s)] ->+ (s -> [s] -> s) ->+ Node s m+parallelNode name workerActions mergeFn =+ Node+ { nodeId = name+ , nodeAction = \initState -> liftIO $ do+ results <- mapConcurrently (\action -> action initState) workerActions+ case sequence results of+ Left err -> pure $ Left err+ Right states -> pure $ Right $ mergeFn initState states+ }++-- | Helper to register a parallel execution step into a StateGraph+addParallelNodes ::+ MonadIO m =>+ NodeId ->+ [s -> IO (Either LangchainError s)] ->+ (s -> [s] -> s) ->+ StateGraph s m ->+ StateGraph s m+addParallelNodes name workerActions mergeFn graph =+ let pNode = parallelNode name workerActions mergeFn+ in addNode name (nodeAction pNode) graph
+ src/Langchain/Graph/StateGraph.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Langchain.Graph.StateGraph+Description : Core StateGraph engine and pure state reducer combinators+Copyright : (c) 2025-2026 Tushar Adhatrao+License : MIT+Maintainer : Tushar Adhatrao <tusharadhatrao@gmail.com>+Stability : experimental++Provides explicit, inspectable, stateful agent graph workflow primitives following graph laws.+-}+module Langchain.Graph.StateGraph+ ( NodeId+ , startNodeId+ , endNodeId+ , StateReducer+ , Node (..)+ , Edge (..)+ , StateGraph (..)+ , emptyStateGraph+ , addNode+ , addEdge+ , addConditionalEdge+ , compileGraph+ , runGraph+ , appendMessagesReducer+ , replaceFieldReducer+ ) where++import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)++import Langchain.Core.Error (LangchainError, internalError)+import Langchain.Core.Model (Message)++-- | Unique node identifier in a StateGraph+type NodeId = Text++-- | Reserved start node constant+startNodeId :: NodeId+startNodeId = "__start__"++-- | Reserved end node constant+endNodeId :: NodeId+endNodeId = "__end__"++-- | Pure state merge function reducer satisfying associative algebra laws+type StateReducer s = s -> s -> s++-- | Node execution action in a StateGraph+data Node s m = Node+ { nodeId :: NodeId+ , nodeAction :: s -> m (Either LangchainError s)+ }++instance Show (Node s m) where+ show n = "Node { nodeId = " ++ show (nodeId n) ++ " }"++-- | Edge representation for transition between graph nodes+data Edge s m+ = StaticEdge NodeId+ | ConditionalEdge (s -> m (Either LangchainError NodeId))++-- | Declarative StateGraph specification+data StateGraph s m = StateGraph+ { graphNodes :: Map NodeId (Node s m)+ , graphEdges :: Map NodeId (Edge s m)+ , graphReducer :: StateReducer s+ }++-- | Construct an empty StateGraph with a given pure StateReducer+emptyStateGraph :: StateReducer s -> StateGraph s m+emptyStateGraph reducer =+ StateGraph+ { graphNodes = Map.empty+ , graphEdges = Map.empty+ , graphReducer = reducer+ }++-- | Add an execution node to the StateGraph+addNode :: NodeId -> (s -> m (Either LangchainError s)) -> StateGraph s m -> StateGraph s m+addNode name action g =+ let n = Node {nodeId = name, nodeAction = action}+ in g {graphNodes = Map.insert name n (graphNodes g)}++-- | Add a static transition edge between two nodes+addEdge :: NodeId -> NodeId -> StateGraph s m -> StateGraph s m+addEdge fromNode toNode g =+ g {graphEdges = Map.insert fromNode (StaticEdge toNode) (graphEdges g)}++-- | Add a dynamic conditional transition edge+addConditionalEdge ::+ NodeId -> (s -> m (Either LangchainError NodeId)) -> StateGraph s m -> StateGraph s m+addConditionalEdge fromNode condFn g =+ g {graphEdges = Map.insert fromNode (ConditionalEdge condFn) (graphEdges g)}++-- | Validate state graph invariants. Returns the validated StateGraph or an error.+compileGraph :: StateGraph s m -> Either LangchainError (StateGraph s m)+compileGraph sg =+ if Map.null (graphNodes sg)+ then Left $ internalError "StateGraph must contain at least one node" (Just "compileGraph") Nothing+ else Right sg++-- | Execute a StateGraph from start node or specified currentId to endNodeId+runGraph ::+ (MonadIO m, MonadError LangchainError m) =>+ StateGraph s m ->+ NodeId ->+ s ->+ m s+runGraph sg@StateGraph {..} currentId state+ | currentId == endNodeId = pure state+ | otherwise = case Map.lookup currentId graphNodes of+ Just node -> do+ eNextState <- nodeAction node state+ case eNextState of+ Left err -> throwError err+ Right stepState -> do+ let mergedState = graphReducer state stepState+ case Map.lookup currentId graphEdges of+ Nothing -> pure mergedState+ Just (StaticEdge nextId) -> runGraph sg nextId mergedState+ Just (ConditionalEdge cond) -> do+ eNextId <- cond mergedState+ case eNextId of+ Left err -> throwError err+ Right nextId -> runGraph sg nextId mergedState+ Nothing -> case Map.lookup currentId graphEdges of+ Just (StaticEdge nextId) -> runGraph sg nextId state+ Just (ConditionalEdge cond) -> do+ eNextId <- cond state+ case eNextId of+ Left err -> throwError err+ Right nextId -> runGraph sg nextId state+ Nothing ->+ throwError $+ internalError ("Node not found in compiled graph: " <> currentId) (Just currentId) Nothing++{- | Standard pure reducer concatenating 'Message' lists.++__Note:__ This reducer expects node actions to return only the /new/ messages (the delta)+to append to the existing history. If your node actions return the full accumulated message+list, use 'replaceFieldReducer' instead to avoid duplicating previous messages.+-}+appendMessagesReducer :: StateReducer [Message]+appendMessagesReducer old new = old ++ new++-- | Standard pure reducer replacing previous state field with new state+replaceFieldReducer :: StateReducer a+replaceFieldReducer _ new = new
+ test/Spec.hs view
@@ -0,0 +1,21 @@+module Main (main) where++import Test.Tasty++import qualified Test.Langchain.Graph.CheckpointerSpec as CheckpointerSpec+import qualified Test.Langchain.Graph.HITLSpec as HITLSpec+import qualified Test.Langchain.Graph.MultiAgentSpec as MultiAgentSpec+import qualified Test.Langchain.Graph.StateGraphSpec as StateGraphSpec++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup+ "langchain-hs-graph"+ [ StateGraphSpec.tests+ , CheckpointerSpec.tests+ , HITLSpec.tests+ , MultiAgentSpec.tests+ ]
+ test/Test/Langchain/Graph/CheckpointerSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Graph.CheckpointerSpec (tests) where++import Data.Text (Text)+import Langchain.Graph.Checkpointer+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Langchain.Graph.CheckpointerSpec"+ [ testCase "MemoryCheckpointer save and load invariant" $ do+ cp <- newMemoryCheckpointer+ let threadId = "thread-1"+ nodeId = "node-1"+ val = "state-value-123" :: Text+ sRes <- saveCheckpoint cp threadId nodeId val+ sRes @?= Right ()++ lRes <- loadCheckpoint cp threadId nodeId+ lRes @?= Right (Just val)+ , testCase "SQLiteCheckpointer save and load invariant" $ do+ withSystemTempDirectory "checkpointer-test" $ \dir -> do+ let dbPath = dir </> "test.db"+ cp <- newSQLiteCheckpointer dbPath+ let threadId = "thread-1" :: Text+ nodeId = "node-1"+ val = "sqlite-value-456" :: Text+ sRes <- saveCheckpoint cp threadId nodeId val+ sRes @?= Right ()++ lRes <- loadCheckpoint cp threadId nodeId+ lRes @?= Right (Just val)+ ]
+ test/Test/Langchain/Graph/HITLSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Graph.HITLSpec (tests) where++import Control.Monad.Except (ExceptT, runExceptT)+import Data.Text (Text)+import Langchain.Core.Error (LangchainError)+import Langchain.Graph.Checkpointer+import Langchain.Graph.HITL+import Langchain.Graph.StateGraph+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Langchain.Graph.HITLSpec"+ [ testCase "hitlNode triggers HITL interrupt error and saves checkpoint" $ do+ cp <- newMemoryCheckpointer+ let threadId = "thread-hitl"+ inner :: Text -> IO (Either LangchainError Text)+ inner s = pure $ Right s+ node1 = hitlNode cp threadId "approvalNode" inner+ -- Manually test hitlNode action directly+ res <- nodeAction node1 ("initial-state" :: Text)+ case res of+ Left err ->+ assertBool "Is HITL Interrupt" (case isHITLInterrupt err of Just "approvalNode" -> True; _ -> False)+ Right _ -> assertFailure "Expected HITL Interrupt error"+ , testCase "resumeGraph resumes execution from saved state" $ do+ cp <- newMemoryCheckpointer+ let threadId = "thread-resume"+ initialState = "draft-content" :: Text+ _ <- saveCheckpoint cp threadId "node2" initialState++ let action :: Text -> ExceptT LangchainError IO (Either LangchainError Text)+ action s = pure $ Right (s <> " -> approved")+ g =+ addEdge "node2" endNodeId $+ addNode "node2" action $+ emptyStateGraph replaceFieldReducer+ case compileGraph g of+ Left err -> assertFailure $ "Failed to compile graph: " ++ show err+ Right compiled -> do+ res <-+ runExceptT $ resumeGraph compiled cp threadId "node2" "node2" (<> " [human-reviewed]")+ res @?= Right "draft-content [human-reviewed] -> approved"+ ]
+ test/Test/Langchain/Graph/MultiAgentSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Graph.MultiAgentSpec (tests) where++import Control.Monad.Except (ExceptT, runExceptT)+import Data.Text (Text)+import Langchain.Core.Error (LangchainError)+import Langchain.Core.Model (ChatModel (..), assistantMessage)+import Langchain.Graph.MultiAgent+import Langchain.Graph.StateGraph+import Test.Tasty+import Test.Tasty.HUnit++newtype MockModel = MockModel Text++instance ChatModel MockModel where+ type ModelConfig MockModel = ()+ invoke (MockModel resp) _ _ = pure $ assistantMessage resp+ stream = undefined++newMockModel :: Text -> MockModel+newMockModel = MockModel++tests :: TestTree+tests =+ testGroup+ "Langchain.Graph.MultiAgentSpec"+ [ testCase "supervisorNode routes based on mock LLM response" $ do+ let mockModel = newMockModel "researcher"+ node =+ supervisorNode+ mockModel+ "supervisor"+ [("researcher", "researchNode")]+ id+ (\target s -> s <> ":" <> target)+ res <- runExceptT $ nodeAction node ("task-input" :: Text)+ res @?= Right (Right ("task-input:researchNode" :: Text))+ , testCase "embedSubGraphNode executes nested graph" $ do+ let action :: Text -> ExceptT LangchainError IO (Either LangchainError Text)+ action s = pure $ Right (s <> " [sub-processed]")+ subG =+ addEdge startNodeId "sub1" $+ addEdge "sub1" endNodeId $+ addNode "sub1" action $+ emptyStateGraph replaceFieldReducer+ case compileGraph subG of+ Left err -> assertFailure $ "Failed to compile sub-graph: " ++ show err+ Right compiledSub -> do+ let parentN = embedSubGraphNode "subGraphNode" compiledSub id (\p s -> p <> " | " <> s)+ res <- runExceptT $ nodeAction parentN ("parent-input" :: Text)+ res @?= Right (Right ("parent-input | parent-input [sub-processed]" :: Text))+ ]
+ test/Test/Langchain/Graph/StateGraphSpec.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Graph.StateGraphSpec (tests) where++import Control.Monad.Except (ExceptT, runExceptT)+import Data.Text (Text)+import Langchain.Core.Error (LangchainError)+import Langchain.Graph.StateGraph+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+ testGroup+ "Langchain.Graph.StateGraphSpec"+ [ unitTests+ , propertyTests+ ]++unitTests :: TestTree+unitTests =+ testGroup+ "Unit Tests"+ [ testCase "compileGraph succeeds on valid node graph" $ do+ let action :: Text -> ExceptT LangchainError IO (Either LangchainError Text)+ action s = pure $ Right (s <> " world")+ g = addNode "node1" action $ emptyStateGraph replaceFieldReducer+ case compileGraph g of+ Left err -> assertFailure $ "Compilation failed: " ++ show err+ Right _ -> pure ()+ , testCase "runGraph executes static transitions correctly" $ do+ let action :: Text -> ExceptT LangchainError IO (Either LangchainError Text)+ action s = pure $ Right (s <> " world")+ g =+ addEdge "node1" endNodeId $+ addNode "node1" action $+ emptyStateGraph replaceFieldReducer+ case compileGraph g of+ Left err -> assertFailure $ "Compilation failed: " ++ show err+ Right compiled -> do+ res <- runExceptT $ runGraph compiled "node1" ("hello" :: Text)+ res @?= Right "hello world"+ ]++propertyTests :: TestTree+propertyTests =+ testGroup+ "Property Tests (Laws)"+ [ testProperty "Reducer Associativity Law: (a <> b) <> c == a <> (b <> c)" $ \a b c ->+ let s1 = (a :: String) ++ (b :: String)+ s2 = s1 ++ (c :: String)+ s3 = b ++ c+ s4 = a ++ s3+ in s2 == s4+ ]