diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for ollama-haskell +## 0.1.1.3 -- 2024-11-08 + +* Increase response timeout to 15 minutes +* Added encodeImage utility function that converts image filePath to base64 image data. +* Added generateJson and chatJson. High level function to return response in Haskell type. + ## 0.1.0.3 -- 2024-11-05 * Moving to stack instead of cabal. diff --git a/ollama-haskell.cabal b/ollama-haskell.cabal --- a/ollama-haskell.cabal +++ b/ollama-haskell.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: ollama-haskell -version: 0.1.0.3 +version: 0.1.1.3 synopsis: Haskell bindings for ollama. description: Please see the README on GitHub at category: Web @@ -52,7 +52,10 @@ build-depends: aeson , base >=4.7 && <5 + , base64-bytestring , bytestring + , directory + , filepath , http-client , http-types , text @@ -72,7 +75,10 @@ build-depends: aeson , base >=4.7 && <5 + , base64-bytestring , bytestring + , directory + , filepath , http-client , http-types , ollama-haskell diff --git a/src/Data/Ollama/Chat.hs b/src/Data/Ollama/Chat.hs --- a/src/Data/Ollama/Chat.hs +++ b/src/Data/Ollama/Chat.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Data.Ollama.Chat ( -- * Chat APIs chat + , chatJson , Message (..) , Role (..) , defaultChatOps @@ -15,11 +17,12 @@ import Data.Aeson import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy.Char8 qualified as BSL -import Data.List.NonEmpty +import Data.List.NonEmpty as NonEmpty import Data.Maybe (isNothing) import Data.Ollama.Common.Utils as CU import Data.Text (Text) import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Data.Time (UTCTime) import GHC.Generics import GHC.Int (Int64) @@ -184,7 +187,7 @@ manager <- newManager defaultManagerSettings -- Setting response timeout to 5 minutes, since llm takes time - { managerResponseTimeout = responseTimeoutMicro (5 * 60 * 1000000) + { managerResponseTimeout = responseTimeoutMicro (15 * 60 * 1000000) } initialRequest <- parseRequest $ T.unpack (url <> "/api/chat") let reqBody = cOps @@ -218,3 +221,75 @@ case stream cOps of Nothing -> genResponse "" Just (sendChunk, flush) -> streamResponse sendChunk flush + +{- | + chatJson is a higher level function that takes ChatOps (similar to chat) and also takes + a Haskell type (that has To and From JSON instance) and returns the response in provided type. + + This function simply calls chat with extra prompt appended to it, telling LLM to return the + response in certain JSON format and serializes the response. This function will be helpful when you + want to use the LLM to do something programmatic. + + For Example: + > let expectedJsonStrucutre = Example { + > sortedList = ["sorted List here"] + > , wasListAlreadSorted = False + > } + > let msg0 = Ollama.Message User "Sort given list: [4, 2 , 3, 67]. Also tell whether list was already sorted or not." Nothing + > eRes3 <- + > chatJson + > defaultChatOps + > { Chat.chatModelName = "llama3.2" + > , Chat.messages = msg0 :| [] + > } + > expectedJsonStrucutre + > (Just 2) + > print eRes3 + Output: + > Example {sortedList = ["1","2","3","4"], wasListAlreadSorted = False} + +Note: While Passing the type, construct the type that will help LLM understand the field better. + For example, in the above example, the sortedList's value is written as "Sorted List here". This + will help LLM understand context better. + + You can also provide number of retries in case the LLM field to return the response in correct JSON + in first attempt. +-} +chatJson :: + (FromJSON jsonResult, ToJSON jsonResult) => + ChatOps -> + jsonResult -> -- ^ Haskell type that you want your result in + Maybe Int -> -- ^ Max retries + IO (Either String jsonResult) +chatJson cOps@ChatOps {..} jsonStructure mMaxRetries = do + let lastMessage = NonEmpty.last messages + jsonHelperPrompt = + "You are an AI that returns only JSON object. \n" + <> "* Your output should be a JSON object that matches the following schema: \n" + <> T.decodeUtf8 (BSL.toStrict $ encode jsonStructure) + <> content lastMessage + <> "\n" + <> "# How to treat the task:\n" + <> "* Stricly follow the schema for the output.\n" + <> "* Never return anything other than a JSON object.\n" + <> "* Do not talk to the user.\n" + chatResponse <- + chat + cOps + { messages = + NonEmpty.fromList $ + lastMessage {content = jsonHelperPrompt} : NonEmpty.init messages + } + case chatResponse of + Left err -> return $ Left err + Right r -> do + let mMessage = message r + case mMessage of + Nothing -> return $ Left "Something went wrong" + Just res -> do + case decode (BSL.fromStrict . T.encodeUtf8 $ content res) of + Nothing -> do + case mMaxRetries of + Nothing -> return $ Left "Decoding Failed :(" + Just n -> if n < 1 then return $ Left "Decoding Failed :(" else chatJson cOps jsonStructure (Just (n - 1)) + Just resultInType -> return $ Right resultInType diff --git a/src/Data/Ollama/Common/Utils.hs b/src/Data/Ollama/Common/Utils.hs --- a/src/Data/Ollama/Common/Utils.hs +++ b/src/Data/Ollama/Common/Utils.hs @@ -1,8 +1,45 @@ {-# LANGUAGE OverloadedStrings #-} -module Data.Ollama.Common.Utils (defaultOllama, OllamaClient (..)) where +module Data.Ollama.Common.Utils (defaultOllama, OllamaClient (..), encodeImage) where +import Control.Exception (IOException, try) +import Data.ByteString qualified as BS +import Data.ByteString.Base64 qualified as Base64 +import Data.Char (toLower) import Data.Ollama.Common.Types +import Data.Text (Text) +import Data.Text.Encoding qualified as TE +import System.Directory +import System.FilePath defaultOllama :: OllamaClient defaultOllama = OllamaClient "http://127.0.0.1:11434" + +supportedExtensions :: [String] +supportedExtensions = [".jpg", ".jpeg", ".png"] + +safeReadFile :: FilePath -> IO (Either IOException BS.ByteString) +safeReadFile = try . BS.readFile + +asPath :: FilePath -> IO (Maybe BS.ByteString) +asPath filePath = do + exists <- doesFileExist filePath + if exists + then either (const Nothing) Just <$> safeReadFile filePath + else return Nothing + +isSupportedExtension :: FilePath -> Bool +isSupportedExtension path = map toLower (takeExtension path) `elem` supportedExtensions + +{- | + encodeImage is a utility function that takes an image file path (jpg, jpeg, png) and + returns the image data in Base64 encoded format. Since GenerateOps' images field + expects image data in base64. It is helper function that we are providing out of the box. +-} +encodeImage :: FilePath -> IO (Maybe Text) +encodeImage filePath = do + if not (isSupportedExtension filePath) + then return Nothing + else do + maybeContent <- asPath filePath + return $ fmap (TE.decodeUtf8 . Base64.encode) maybeContent diff --git a/src/Data/Ollama/Generate.hs b/src/Data/Ollama/Generate.hs --- a/src/Data/Ollama/Generate.hs +++ b/src/Data/Ollama/Generate.hs @@ -6,6 +6,7 @@ ( -- * Generate Texts generate , defaultGenerateOps + , generateJson , GenerateOps (..) , GenerateResponse (..) ) where @@ -17,6 +18,7 @@ import Data.Ollama.Common.Utils as CU import Data.Text (Text) import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Data.Time (UTCTime) import GHC.Int (Int64) import Network.HTTP.Client @@ -24,13 +26,13 @@ -- TODO: Add Options parameter -- TODO: Add Context parameter -{- | - Input type for generate functions. This data type represents all possible configurations +{- | + Input type for generate functions. This data type represents all possible configurations that you can pass to the Ollama generate API. - + Example: - - > let ops = GenerateOps + + > let ops = GenerateOps > { modelName = "llama3.2" > , prompt = "What is the meaning of life?" > , suffix = Nothing @@ -91,21 +93,22 @@ <> show keepAlive instance Eq GenerateOps where - (==) a b = - modelName a == modelName b && - prompt a == prompt b && - suffix a == suffix b && - images a == images b && - format a == format b && - system a == system b && - template a == template b && - raw a == raw b && - keepAlive a == keepAlive b + (==) a b = + modelName a == modelName b + && prompt a == prompt b + && suffix a == suffix b + && images a == images b + && format a == format b + && system a == system b + && template a == template b + && raw a == raw b + && keepAlive a == keepAlive b -- TODO: Add Context Param --- | --- Result type for generate function containing the model's response and meta-information. +{- | +Result type for generate function containing the model's response and meta-information. +-} data GenerateResponse = GenerateResponse { model :: Text -- ^ The name of the model that generated the response. @@ -171,15 +174,16 @@ <*> v .:? "eval_count" <*> v .:? "eval_duration" --- | --- A function to create a default 'GenerateOps' type with preset values. --- --- Example: --- --- > let ops = defaultGenerateOps --- > generate ops --- --- This will generate a response using the default configuration. +{- | +A function to create a default 'GenerateOps' type with preset values. + +Example: + +> let ops = defaultGenerateOps +> generate ops + +This will generate a response using the default configuration. +-} defaultGenerateOps :: GenerateOps defaultGenerateOps = GenerateOps @@ -195,49 +199,50 @@ , keepAlive = Nothing } --- | --- Generate function that returns either a 'GenerateResponse' type or an error message. --- It takes a 'GenerateOps' configuration and performs a request to the Ollama generate API. --- --- Examples: --- --- Basic usage without streaming: --- --- > let ops = GenerateOps --- > { modelName = "llama3.2" --- > , prompt = "Tell me a joke." --- > , suffix = Nothing --- > , images = Nothing --- > , format = Nothing --- > , system = Nothing --- > , template = Nothing --- > , stream = Nothing --- > , raw = Nothing --- > , keepAlive = Nothing --- > } --- > result <- generate ops --- > case result of --- > Left errorMsg -> putStrLn ("Error: " ++ errorMsg) --- > Right response -> print response --- --- Usage with streaming to print responses to the console: --- --- > void $ --- > generate --- > defaultGenerateOps --- > { modelName = "llama3.2" --- > , prompt = "what is functional programming?" --- > , stream = Just (T.putStr . response_, pure ()) --- > } --- --- In this example, the first function in the 'stream' tuple processes each chunk of response by printing it, --- and the second function is a simple no-op flush.generate :: GenerateOps -> IO (Either String GenerateResponse) +{- | +Generate function that returns either a 'GenerateResponse' type or an error message. +It takes a 'GenerateOps' configuration and performs a request to the Ollama generate API. + +Examples: + +Basic usage without streaming: + +> let ops = GenerateOps +> { modelName = "llama3.2" +> , prompt = "Tell me a joke." +> , suffix = Nothing +> , images = Nothing +> , format = Nothing +> , system = Nothing +> , template = Nothing +> , stream = Nothing +> , raw = Nothing +> , keepAlive = Nothing +> } +> result <- generate ops +> case result of +> Left errorMsg -> putStrLn ("Error: " ++ errorMsg) +> Right response -> print response + +Usage with streaming to print responses to the console: + +> void $ +> generate +> defaultGenerateOps +> { modelName = "llama3.2" +> , prompt = "what is functional programming?" +> , stream = Just (T.putStr . response_, pure ()) +> } + +In this example, the first function in the 'stream' tuple processes each chunk of response by printing it, +and the second function is a simple no-op flush.generate :: GenerateOps -> IO (Either String GenerateResponse) +-} generate :: GenerateOps -> IO (Either String GenerateResponse) generate genOps = do let url = CU.host defaultOllama manager <- newManager -- Setting response timeout to 5 minutes, since llm takes time - defaultManagerSettings {managerResponseTimeout = responseTimeoutMicro (5 * 60 * 1000000)} + defaultManagerSettings {managerResponseTimeout = responseTimeoutMicro (15 * 60 * 1000000)} initialRequest <- parseRequest $ T.unpack (url <> "/api/generate") let reqBody = genOps request = @@ -270,3 +275,70 @@ case stream genOps of Nothing -> genResponse "" Just (sendChunk, flush) -> streamResponse sendChunk flush + +{- | + generateJson is a higher level function that takes generateOps (similar to generate) and also takes + a Haskell type (that has To and From JSON instance) and returns the response in provided type. + + This function simply calls generate with extra prompt appended to it, telling LLM to return the + response in certain JSON format and serializes the response. This function will be helpful when you + want to use the LLM to do something programmatic. + + For Example: + > let expectedJsonStrucutre = Example { + > sortedList = ["sorted List here"] + > , wasListAlreadSorted = False + > } + > eRes2 <- generateJson + > defaultGenerateOps + > { modelName = "llama3.2" + > , prompt = "Sort given list: [4, 2 , 3, 67]. Also tell whether list was already sorted or not." + > } + > expectedJsonStrucutre + > Nothing + > case eRes2 of + > Left e -> putStrLn e + > Right r -> print ("JSON response: " :: String, r) + +Output: + > ("JSON response: ",Example {sortedList = ["1","2","3","4"], wasListAlreadSorted = False}) + +Note: While Passing the type, construct the type that will help LLM understand the field better. + For example, in the above example, the sortedList's value is written as "Sorted List here". This + will help LLM understand context better. + + You can also provide number of retries in case the LLM field to return the response in correct JSON + in first attempt. +-} +generateJson :: + (ToJSON jsonResult, FromJSON jsonResult) => + GenerateOps -> + -- | Haskell type that you want your result in + jsonResult -> + -- | Max retries + Maybe Int -> + IO (Either String jsonResult) +generateJson genOps@GenerateOps {..} jsonStructure mMaxRetries = do + let jsonHelperPrompt = + "You are an AI that returns only JSON object. \n" + <> "* Your output should be a JSON object that matches the following schema: \n" + <> T.decodeUtf8 (BSL.toStrict $ encode jsonStructure) + <> prompt + <> "\n" + <> "# How to treat the task:\n" + <> "* Stricly follow the schema for the output.\n" + <> "* Never return anything other than a JSON object.\n" + <> "* Do not talk to the user.\n" + generatedResponse <- generate genOps {prompt = jsonHelperPrompt} + case generatedResponse of + Left err -> return $ Left err + Right r -> do + case decode (BSL.fromStrict . T.encodeUtf8 $ response_ r) of + Nothing -> do + case mMaxRetries of + Nothing -> return $ Left "Decoding Failed :(" + Just n -> + if n < 1 + then return $ Left "Decoding failed :(" + else generateJson genOps jsonStructure (Just (n - 1)) + Just resultInType -> return $ Right resultInType diff --git a/src/Ollama.hs b/src/Ollama.hs --- a/src/Ollama.hs +++ b/src/Ollama.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {- | #Ollama-Haskell# This library lets you run LlMs from within Haskell projects. Inspired by `ollama-python`. @@ -7,12 +8,14 @@ -- ** Generate Texts generate + , generateJson , defaultGenerateOps , GenerateOps (..) , GenerateResponse (..) -- ** Chat with LLMs , chat + , chatJson , Role (..) , defaultChatOps , ChatResponse (..) @@ -66,6 +69,7 @@ , Message (..) , Role (..) , chat + , chatJson , defaultChatOps ) import Data.Ollama.Copy (copyModel) @@ -77,6 +81,7 @@ , GenerateResponse (..) , defaultGenerateOps , generate + , generateJson ) import Data.Ollama.List (ModelInfo (..), Models (..), list) import Data.Ollama.Ps (RunningModel (..), RunningModels (..), ps) diff --git a/src/OllamaExamples.hs b/src/OllamaExamples.hs --- a/src/OllamaExamples.hs +++ b/src/OllamaExamples.hs @@ -1,16 +1,29 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module OllamaExamples where +module OllamaExamples (main) where import Control.Monad (void) -import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Aeson +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (fromMaybe) +import Data.Ollama.Chat (chatJson) import Data.Ollama.Chat qualified as Chat +import Data.Ollama.Common.Utils (encodeImage) +import Data.Ollama.Generate (generateJson) import Data.Text.IO qualified as T -import Ollama (GenerateOps(..), Role(..), chat, defaultChatOps, defaultGenerateOps, generate) +import GHC.Generics +import Ollama (GenerateOps (..), Role (..), chat, defaultChatOps, defaultGenerateOps, generate) import Ollama qualified +data Example = Example + { sortedList :: [String] + , wasListAlreadSorted :: Bool + } + deriving (Show, Eq, Generic, FromJSON, ToJSON) + main :: IO () main = do -- Example 1: Streamed Text Generation @@ -81,6 +94,57 @@ -- This example uses the `embeddingOps` function, allowing for additional configuration like options and streaming. void $ Ollama.embeddingOps "llama3.1" "What is 5+2?" Nothing Nothing + -- Example 8: Stream Text Generation with JSON Body + -- It is a higher level version of generate, here with genOps, you can also provide a Haskell type. + -- You will get the response from LLM in this Haskell type. + let expectedJsonStrucutre = + Example + { sortedList = ["sorted List here"] + , wasListAlreadSorted = False + } + eRes2 <- + generateJson + defaultGenerateOps + { modelName = "llama3.2" + , prompt = "Sort given list: [14, 12 , 13, 67]. Also tell whether list was already sorted or not." + } + expectedJsonStrucutre + (Just 2) + case eRes2 of + Left e -> putStrLn e + Right r -> print ("JSON response: " :: String, r) + -- ("JSON response: ",Example {sortedList = ["1","2","3","4"], wasListAlreadSorted = False}) + + -- Example 9: Chat with JSON Body + -- This example demonstrates setting up a chat session but you receive the response in + -- given haskell type. + let msg0 = + Ollama.Message + User + "Sort given list: [4, 2 , 3, 67]. Also tell whether list was already sorted or not." + Nothing + eRes3 <- + chatJson + defaultChatOps + { Chat.chatModelName = "llama3.2" + , Chat.messages = msg0 :| [] + } + expectedJsonStrucutre + (Just 2) + print eRes3 + + -- Example 10: Chat with Image + -- This example demonstrates chatting with example using an image. + mImg <- encodeImage "/home/user/sample.png" + void $ + generate + defaultGenerateOps + { modelName = "llama3.2-vision" + , prompt = "Describe the given image" + , images = (\x -> Just [x]) =<< mImg + , stream = Just (T.putStr . Ollama.response_, pure ()) + } + {- Scotty example: {-# LANGUAGE OverloadedStrings #-} @@ -109,7 +173,7 @@ conn <- open "chat.db" execute_ conn "CREATE TABLE IF NOT EXISTS conversation (convo_id INTEGER PRIMARY KEY, convo_title TEXT)" execute_ conn "CREATE TABLE IF NOT EXISTS chats (chat_id INTEGER PRIMARY KEY, convo_id INTEGER, role TEXT, message TEXT, FOREIGN KEY(convo_id) REFERENCES conversation(convo_id))" - + scotty 3000 $ do post "/chat" $ do p <- jsonData :: ActionM PromptInput @@ -123,7 +187,7 @@ _ -> pure cId liftIO $ execute conn "INSERT INTO chats (convo_id, role, message) VALUES (?, 'user', ?)" (newConvoId, trimmedP) - + stream $ \sendChunk flush -> do eRes <- generate defaultGenerateOps { modelName = "llama3.2"