langchain-hs-0.0.2.0: Haskell implementation of Langchain
Copyright(c) 2025 Tushar Adhatrao
LicenseMIT
MaintainerTushar Adhatrao <[email protected]>
Safe HaskellSafe-Inferred
LanguageHaskell2010

Langchain.Runnable.Chain

Description

This module provides various composition patterns for Runnable instances, allowing you to build complex processing pipelines from simpler components.

The primary abstractions include:

These abstractions follow functional programming patterns to create flexible data processing pipelines for language model applications.

Synopsis

Core Data Types

data RunnableBranch a b Source #

A conditional branching structure for Runnable instances.

RunnableBranch allows you to specify multiple condition-runnable pairs, where the first runnable whose condition matches the input is invoked. If no condition matches, a default runnable is used.

The conditions are functions that evaluate the input and return a boolean.

Constructors

(Runnable r, RunnableInput r ~ a, RunnableOutput r ~ b) => RunnableBranch [(a -> Bool, r)] r 

Instances

Instances details
Runnable (RunnableBranch a b) Source # 
Instance details

Defined in Langchain.Runnable.Chain

Associated Types

type RunnableInput (RunnableBranch a b) 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableOutput (RunnableBranch a b) 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableInput (RunnableBranch a b) Source # 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableOutput (RunnableBranch a b) Source # 
Instance details

Defined in Langchain.Runnable.Chain

data RunnableMap a b c Source #

A Runnable that transforms input and/or output when executing another Runnable.

RunnableMap allows you to adapt the input or output types of an existing Runnable to make it compatible with other components in your processing pipeline.

Constructors

(Runnable r, RunnableInput r ~ b, RunnableOutput r ~ c) => RunnableMap (a -> b) (c -> c) r 

Instances

Instances details
Runnable (RunnableMap a b c) Source # 
Instance details

Defined in Langchain.Runnable.Chain

Associated Types

type RunnableInput (RunnableMap a b c) 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableInput (RunnableMap a b c) = a
type RunnableOutput (RunnableMap a b c) 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableOutput (RunnableMap a b c) = c
type RunnableInput (RunnableMap a b c) Source # 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableInput (RunnableMap a b c) = a
type RunnableOutput (RunnableMap a b c) Source # 
Instance details

Defined in Langchain.Runnable.Chain

type RunnableOutput (RunnableMap a b c) = c

data RunnableSequence a b Source #

A sequence of Runnable instances chained together.

RunnableSequence represents a pipeline where the output of each Runnable becomes the input to the next. This is the core abstraction for building processing pipelines in Langchain.

The GADT construction ensures that the output type of each component matches the input type of the next component.

Execution Functions

runBranch :: RunnableBranch a b -> a -> IO (Either String b) Source #

Executes a RunnableBranch by selecting the first matching runnable.

Evaluates each condition in order until one returns True, then invokes the corresponding runnable. If no condition matches, invokes the default runnable.

>>> :{
let isShort text = length text < 100
    isQuestion text = last text == '?'
    shortTextHandler = LLMChain "Process short text"
    questionHandler = LLMChain "Answer the question"
    defaultHandler = LLMChain "Process general text"
    textProcessor = RunnableBranch [(isShort, shortTextHandler), (isQuestion, questionHandler)] defaultHandler
in runBranch textProcessor "How does this work?"
:}
Right "This is a question, so I'm handling it with the question processor."

runMap :: RunnableMap a b c -> a -> IO (Either String c) Source #

Executes a RunnableMap by applying transformations to input and output.

First applies the input transformation function, then invokes the wrapped runnable, and finally applies the output transformation function to the result (if successful).

>>> :{
let extractLength = length :: String -> Int
    isPalindrome str = str == reverse str
    lengthPalindrome = RunnableMap extractLength isPalindrome (pure True)
in runMap lengthPalindrome "hello"
:}
Right False

runSequence :: RunnableSequence a b -> RunnableInputHead a -> IO (Either String b) Source #

Run a sequence of runnables, chaining the output of one as input to the next.

Composition Utilities

chain :: (Runnable r1, Runnable r2, RunnableOutput r1 ~ RunnableInput r2) => r1 -> r2 -> RunnableInput r1 -> IO (Either String (RunnableOutput r2)) Source #

Chains two Runnable instances together sequentially.

The output of the first runnable is fed as input to the second. If the first runnable fails, the error is returned immediately.

>>> :{
let textSplitter = TextSplitter defaultConfig
    llm = OpenAI defaultConfig
    summarizer input = chain textSplitter llm input
in summarizer "Split this text and then summarize each part."
:}
Right "The text was split into chunks and each part was summarized."

branch :: (Runnable r1, Runnable r2, a ~ RunnableInput r1, a ~ RunnableInput r2) => r1 -> r2 -> a -> IO (Either String (RunnableOutput r1, RunnableOutput r2)) Source #

Creates a parallel composition of two Runnable instances.

Both runnables receive the same input and their outputs are combined into a tuple. If either runnable fails, the combined result fails.

>>> :{
let sentimentAnalyzer = LLMChain "Analyze sentiment of this text"
    keywordExtractor = LLMChain "Extract keywords from this text"
    analyzer text = branch sentimentAnalyzer keywordExtractor text
in analyzer "I love Haskell but monads can be challenging at first."
:}
Right ("Positive", ["Haskell", "love", "monads", "challenging"])

buildSequence :: (Runnable r1, Runnable r2, RunnableOutput r1 ~ RunnableInput r2) => r1 -> r2 -> RunnableSequence (RunnableInput r1) (RunnableOutput r2) Source #

Builds a RunnableSequence from two Runnable instances.

This is a convenience function for creating a simple two-component sequence.

>>> :{
let parser = JSONParser defaultConfig
    validator = SchemaValidator personSchema
    personProcessor = buildSequence parser validator
in invoke personProcessor "{\"name\":\"John\",\"age\":30}"
:}
Right (Person "John" 30)

appendSequence :: (Runnable r2, RunnableOutput (RunnableSequence a b) ~ RunnableInput r2) => RunnableSequence a b -> r2 -> RunnableSequence a (RunnableOutput r2) Source #

Appends a Runnable to the end of a RunnableSequence.

This allows you to incrementally build longer processing pipelines.

>>> :{
let retriever = DocumentRetriever defaultConfig
    llm = OpenAI defaultConfig
    formatter = OutputFormatter defaultConfig
    basePipeline = buildSequence retriever llm
    fullPipeline = appendSequence basePipeline formatter
in invoke fullPipeline "Tell me about Haskell's type system"
:}
Right "Haskell has a strong, static type system featuring type inference..."

(|>>) :: (Runnable r1, Runnable r2, RunnableOutput r1 ~ RunnableInput r2) => r1 -> r2 -> RunnableInput r1 -> IO (Either String (RunnableOutput r2)) infix 4 Source #

Operator version of chain for more readable composition.

Allows for cleaner pipeline construction with an infix operator:

>>> textSplitter |>> embedder |>> retriever |>> llm $ "Explain monads in Haskell."
Right "Monads in Haskell are a design pattern that allows for sequencing computations..."