langchain-hs-core (empty) → 0.0.5.0
raw patch · 18 files changed
+1403/−0 lines, 18 filesdep +QuickCheckdep +aesondep +async
Dependencies added: QuickCheck, aeson, async, base, base64-bytestring, bytestring, conduit, containers, deepseq, langchain-hs-core, mtl, resourcet, stm, tasty, tasty-hunit, tasty-quickcheck, text, time
Files
- CHANGELOG.md +14/−0
- LICENSE +20/−0
- README.md +24/−0
- langchain-hs-core.cabal +118/−0
- src/Langchain/Core/Error.hs +178/−0
- src/Langchain/Core/Model.hs +53/−0
- src/Langchain/Core/Model/Types.hs +199/−0
- src/Langchain/Core/Monad.hs +55/−0
- src/Langchain/Core/Runnable.hs +194/−0
- src/Langchain/Core/Stream.hs +169/−0
- src/Langchain/Core/Tool.hs +65/−0
- test/Spec.hs +23/−0
- test/Test/Langchain/Core/Model.hs +60/−0
- test/Test/Langchain/Core/Monad.hs +30/−0
- test/Test/Langchain/Core/Runnable.hs +100/−0
- test/Test/Langchain/Core/Stream.hs +33/−0
- test/Test/Langchain/Core/TestModel.hs +29/−0
- test/Test/Langchain/Core/Tool.hs +39/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+# Changelog for `langchain-hs-core`++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-core`.+- Zero-dependency pure core architecture.+- First-class `RunnableTree` GADT AST with sequential (`|>>`), parallel (`&>&`), and fallback (`>>>#`) operators.+- `ChatModel` effect-polymorphic interface.+- Multi-modal `ContentBlock` and message structures.+- Conduit-based `StreamEvent` and streaming protocol.+- Decoupled `LangchainT env m a` transformer.+- Typed `Tool` and `FunctionDefinition`.
+ 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,24 @@+# `langchain-hs-core`++> Zero-dependency pure core of the `langchain-hs` 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.++## Key Primitives++- **`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`.++## Installation++```cabal+build-depends: langchain-hs-core >= 0.0.5 && < 0.0.6+```++## License++MIT License. See [LICENSE](LICENSE).
+ langchain-hs-core.cabal view
@@ -0,0 +1,118 @@+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-core+version: 0.0.5.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+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.Core.Error+ Langchain.Core.Model+ Langchain.Core.Model.Types+ Langchain.Core.Monad+ Langchain.Core.Stream+ Langchain.Core.Runnable+ Langchain.Core.Tool+ other-modules:+ Paths_langchain_hs_core+ hs-source-dirs:+ src+ default-extensions:+ MultiParamTypeClasses+ FunctionalDependencies+ TypeFamilies+ TypeOperators+ DataKinds+ GADTs+ OverloadedStrings+ DeriveGeneric+ DeriveAnyClass+ RecordWildCards+ FlexibleContexts+ build-depends:+ aeson >=2.0 && <3+ , async ==2.2.*+ , base >=4.17 && <5+ , base64-bytestring ==1.2.*+ , bytestring >=0.10 && <0.13+ , conduit ==1.3.*+ , containers >=0.6 && <0.9+ , deepseq >=1.4 && <1.6+ , mtl >=2.2 && <2.4+ , resourcet >=1.2 && <1.4+ , stm ==2.5.*+ , text >=1.2 && <3+ , time >=1.9 && <1.15+ default-language: Haskell2010++test-suite langchain-hs-core-test+ 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+ Paths_langchain_hs_core+ hs-source-dirs:+ test+ default-extensions:+ MultiParamTypeClasses+ FunctionalDependencies+ TypeFamilies+ TypeOperators+ DataKinds+ GADTs+ OverloadedStrings+ DeriveGeneric+ DeriveAnyClass+ RecordWildCards+ FlexibleContexts+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.14+ , aeson >=2.0 && <3+ , async ==2.2.*+ , base >=4.17 && <5+ , base64-bytestring ==1.2.*+ , bytestring >=0.10 && <0.13+ , conduit ==1.3.*+ , containers >=0.6 && <0.9+ , deepseq >=1.4 && <1.6+ , langchain-hs-core+ , mtl >=2.2 && <2.4+ , resourcet+ , stm ==2.5.*+ , tasty >=1.4+ , tasty-hunit >=0.10+ , tasty-quickcheck >=0.10+ , text >=1.2 && <3+ , time >=1.9 && <1.15+ default-language: Haskell2010
+ src/Langchain/Core/Error.hs view
@@ -0,0 +1,178 @@+{-# 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
+ src/Langchain/Core/Model.hs view
@@ -0,0 +1,53 @@+{-# 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
+ src/Langchain/Core/Model/Types.hs view
@@ -0,0 +1,199 @@+{-# 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
+ src/Langchain/Core/Monad.hs view
@@ -0,0 +1,55 @@+{-# 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
+ src/Langchain/Core/Runnable.hs view
@@ -0,0 +1,194 @@+{-# 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)
+ src/Langchain/Core/Stream.hs view
@@ -0,0 +1,169 @@+{-# 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))
+ src/Langchain/Core/Tool.hs view
@@ -0,0 +1,65 @@+{-# 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+ ]+ ]
+ test/Spec.hs view
@@ -0,0 +1,23 @@+module Main (main) where++import Test.Tasty++import qualified Test.Langchain.Core.Model as ModelTest+import qualified Test.Langchain.Core.Monad as MonadTest+import qualified Test.Langchain.Core.Runnable as RunnableTest+import qualified Test.Langchain.Core.Stream as StreamTest+import qualified Test.Langchain.Core.Tool as ToolTest++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup+ "langchain-hs-core"+ [ RunnableTest.tests+ , ModelTest.tests+ , StreamTest.tests+ , ToolTest.tests+ , MonadTest.tests+ ]
+ test/Test/Langchain/Core/Model.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Core.Model (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad.Except (runExceptT)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map.Strict as Map++import Langchain.Core.Model+import Test.Langchain.Core.TestModel (TestChatModel (..))++tests :: TestTree+tests =+ testGroup+ "Langchain.Core.Model"+ [ testGroup+ "Multi-Modal ContentBlock & Message"+ [ testCase "textMessage creates User message with TextBlock" $ do+ let msg = userMessage "Hello AI"+ messageRole msg @?= User+ extractMessageText msg @?= "Hello AI"+ messageMetadata msg @?= Map.empty+ , testCase "systemMessage creates System message" $ do+ let msg = systemMessage "You are a assistant"+ messageRole msg @?= System+ extractMessageText msg @?= "You are a assistant"+ , testCase "imageMessage creates ImageBlock message" $ do+ let msg = imageMessage User "image/png" "base64data=="+ messageRole msg @?= User+ case messageContents msg of+ (ImageBlock (ImageContent (ImageBase64 (Just mime) b64) Nothing Nothing) :| []) -> do+ mime @?= "image/png"+ b64 @?= "base64data=="+ _ -> assertFailure "Expected ImageBlock"+ ]+ , testGroup+ "Effect-Polymorphic ChatModel"+ [ testCase "invoke returns Assistant response" $ do+ let model = TestChatModel "Hello human" "mock-gpt"+ input = [userMessage "Hi"]+ res <- runExceptT $ invoke model input Nothing+ case res of+ Left err -> assertFailure $ "Unexpected error: " ++ show err+ Right msg -> do+ messageRole msg @?= Assistant+ extractMessageText msg @?= "Hello human"+ , testCase "batch processes multiple inputs sequentially" $ do+ let model = TestChatModel "Pong" "mock-gpt"+ inputs = [[userMessage "Ping 1"], [userMessage "Ping 2"]]+ res <- runExceptT $ batch model inputs Nothing+ case res of+ Left err -> assertFailure $ "Unexpected error: " ++ show err+ Right msgs -> do+ length msgs @?= 2+ map extractMessageText msgs @?= ["Pong", "Pong"]+ ]+ ]
+ test/Test/Langchain/Core/Monad.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Core.Monad (tests) where++import Control.Monad.Reader (ask)+import Test.Tasty+import Test.Tasty.HUnit++import Langchain.Core.Error (internalError)+import Langchain.Core.Monad++tests :: TestTree+tests =+ testGroup+ "Test.Langchain.Core.Monad"+ [ testCase "runLangchainT executes pure computations successfully" $ do+ res <- runLangchainT () (pure ("hello" :: String))+ res @?= Right "hello"+ , testCase "runLangchainT propagates errors via throwLangchainError" $ do+ res <- runLangchainT () $ do+ throwLangchainError (internalError "test fail" Nothing Nothing)+ case res of+ Left _ -> pure ()+ Right _ -> assertFailure "Expected error"+ , testCase "runLangchainT threads custom env through ask" $ do+ -- Developers use ask / asks from mtl directly with their own r+ let customEnv = (42 :: Int)+ res <- runLangchainT customEnv ask+ res @?= Right 42+ ]
+ test/Test/Langchain/Core/Runnable.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Langchain.Core.Runnable (tests) where++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++import Control.Monad.Except (ExceptT, runExceptT)+import qualified Data.Text as T++import Langchain.Core.Error+import Langchain.Core.Runnable++type TestMonad = ExceptT LangchainError IO++-- Pure test lambda helpers+addOneLambda :: RunnableTree TestMonad Int Int+addOneLambda = runLambda $ \x -> pure (Right (x + 1))++doubleLambda :: RunnableTree TestMonad Int Int+doubleLambda = runLambda $ \x -> pure (Right (x * 2))++failLambda :: RunnableTree TestMonad Int Int+failLambda = runLambda $ \_ -> pure (Left $ runnableError "Pipeline failed" Nothing Nothing)++tests :: TestTree+tests =+ testGroup+ "Langchain.Core.Runnable"+ [ testGroup+ "Identity Laws"+ [ testCase "Left Identity: Id |>> t == t" $ do+ let t = addOneLambda+ r1 <- runExceptT $ interpret (Id |>> t) 5+ r2 <- runExceptT $ interpret t 5+ r1 @?= Right 6+ r1 @?= r2+ , testCase "Right Identity: t |>> Id == t" $ do+ let t = addOneLambda+ r1 <- runExceptT $ interpret (t |>> Id) 5+ r2 <- runExceptT $ interpret t 5+ r1 @?= Right 6+ r1 @?= r2+ ]+ , testGroup+ "Sequential Composition Laws"+ [ testCase "Seq executes in left-to-right order" $ do+ let pipeline = addOneLambda |>> doubleLambda -- (5 + 1) * 2 = 12+ res <- runExceptT $ interpret pipeline 5+ res @?= Right 12+ , testCase "Seq propagates errors early" $ do+ let pipeline = failLambda |>> doubleLambda+ res <- runExceptT $ interpret pipeline 5+ case res of+ Left (RunnableError msg _) -> assertBool "Should contain error message" ("failed" `T.isInfixOf` msg)+ _ -> assertFailure "Expected RunnableError"+ ]+ , testGroup+ "Parallel Composition Laws (&>&)"+ [ testCase "Par executes branches concurrently" $ do+ let pipeline = addOneLambda &>& doubleLambda+ res <- runExceptT $ interpret pipeline 10+ res @?= Right (11, 20)+ ]+ , testGroup+ "Branching and Fallback"+ [ testCase "Branch selects True branch" $ do+ let pipeline = Branch (\x -> pure (x > 0)) addOneLambda doubleLambda+ res <- runExceptT $ interpret pipeline 5+ res @?= Right 6+ , testCase "Branch selects False branch" $ do+ let pipeline = Branch (\x -> pure (x > 0)) addOneLambda doubleLambda+ res <- runExceptT $ interpret pipeline (-5)+ res @?= Right (-10)+ , testCase "Fallback executes secondary when primary fails" $ do+ let pipeline = Fallback failLambda doubleLambda+ res <- runExceptT $ interpret pipeline 7+ res @?= Right 14+ ]+ , testGroup+ "Property Tests (QuickCheck)"+ [ QC.testProperty "Identity Law: Id |>> t(x) == t(x)" $ \(x :: Int) ->+ QC.ioProperty $ do+ r1 <- runExceptT $ interpret (Id |>> addOneLambda) x+ r2 <- runExceptT $ interpret addOneLambda x+ pure (r1 == r2)+ , QC.testProperty "Associativity: (f |>> g) |>> h == f |>> (g |>> h)" $ \(x :: Int) ->+ QC.ioProperty $ do+ let f = addOneLambda+ g = doubleLambda+ h = addOneLambda+ p1 = (f |>> g) |>> h+ p2 = f |>> (g |>> h)+ r1 <- runExceptT $ interpret p1 x+ r2 <- runExceptT $ interpret p2 x+ pure (r1 == r2)+ ]+ ]
+ test/Test/Langchain/Core/Stream.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Langchain.Core.Stream (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad.Except (runExceptT)+import Control.Monad.Trans.Resource (runResourceT)++import Langchain.Core.Model+import Langchain.Core.Stream+import Test.Langchain.Core.TestModel (TestChatModel (..))++tests :: TestTree+tests =+ testGroup+ "Langchain.Core.Stream"+ [ testCase "stream emits LLMStart, LLMChunk, LLMEnd events" $ do+ let model = TestChatModel "Streamed content" "mock-gpt"+ input = [userMessage "Stream test"]+ res <- runResourceT $ runExceptT $ collectEvents (stream model input Nothing)+ case res of+ Left err -> assertFailure $ "Unexpected stream error: " ++ show err+ Right events -> do+ length events @?= 3+ case events of+ [s@LLMStart {}, c@LLMChunk {}, e@LLMEnd {}] -> do+ modelName s @?= "mock-gpt"+ chunkText c @?= "Streamed content"+ extractMessageText (finalMessage e) @?= "Streamed content"+ _ -> assertFailure $ "Unexpected event sequence: " ++ show events+ ]
+ test/Test/Langchain/Core/TestModel.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Langchain.Core.TestModel+ ( TestChatModel (..)+ ) where++import Data.Conduit (yield)+import Data.Text (Text)++import Langchain.Core.Model+import Langchain.Core.Stream (StreamEvent (..))++data TestChatModel = TestChatModel+ { testResponse :: Text+ , testModelName :: Text+ }+ deriving (Eq, Show)++instance ChatModel TestChatModel where+ type ModelConfig TestChatModel = ()++ invoke model _ _ = pure $ assistantMessage (testResponse model)++ stream model inputMsgs _ = do+ let rId = "test-run-id"+ yield $ LLMStart rId (testModelName model) inputMsgs+ yield $ LLMChunk rId (testResponse model) Nothing+ yield $ LLMEnd rId (assistantMessage $ testResponse model) Nothing
+ test/Test/Langchain/Core/Tool.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Langchain.Core.Tool (tests) where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Text (Text)+import Langchain.Core.Error+import Langchain.Core.Tool+import Test.Tasty+import Test.Tasty.HUnit++calcExec :: Value -> IO (Either LangchainError Text)+calcExec (Object _) = pure $ Right "42"+calcExec _ = pure $ Left $ toolError "Invalid arguments" (Just "calc") Nothing++tests :: TestTree+tests =+ testGroup+ "Langchain.Core.Tool"+ [ testCase "createTool initializes tool attributes" $ do+ let t = createTool "calculator" "Performs math" (object []) calcExec+ toolName t @?= "calculator"+ toolDescription t @?= "Performs math"+ , testCase "toolToValue generates correct JSON schema structure" $ do+ let t = createTool "calculator" "Performs math" (object ["type" .= ("object" :: Text)]) calcExec+ val = toolToValue t+ case val of+ Object o -> do+ case parseEither (.: "type") o of+ Right ("function" :: Text) -> pure ()+ res -> assertFailure $ "Expected type = function, got: " ++ show res+ _ -> assertFailure "Expected JSON Object"+ , testCase "toolExecute runs successfully on valid input" $ do+ let t = createTool "calculator" "Performs math" (object []) calcExec+ res <- toolExecute t (object [])+ res @?= Right "42"+ ]