Added encodeImage utility function

CHANGELOG.md

@@ -1,7 +1,9 @@
 # Revision history for ollama-haskell
 
-## 0.1.1.3 -- 2024-11-06
+## 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

ollama-haskell.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- 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 <https://github.com/tusharad/ollama-haskell#readme>
 category:       Web
@@ -52,7 +52,10 @@ library
   build-depends:
       aeson
     , base >=4.7 && <5
+    , base64-bytestring
     , bytestring
+    , directory
+    , filepath
     , http-client
     , http-types
     , text
@@ -72,7 +75,10 @@ test-suite ollama-haskell-test
   build-depends:
       aeson
     , base >=4.7 && <5
+    , base64-bytestring
     , bytestring
+    , directory
+    , filepath
     , http-client
     , http-types
     , ollama-haskell

package.yaml

@@ -1,5 +1,5 @@
 name:                ollama-haskell
-version:             0.1.0.3
+version:             0.1.1.3
 github:              "tusharad/ollama-haskell"
 license:             MIT
 author:              "tushar"
@@ -23,6 +23,9 @@ dependencies:
 - time
 - http-client 
 - http-types 
+- base64-bytestring
+- filepath
+- directory
 
 ghc-options:
 - -Wall

src/Data/Ollama/Chat.hs

@@ -187,7 +187,7 @@ chat cOps = do
   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

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

src/Data/Ollama/Generate.hs

@@ -242,7 +242,7 @@ 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 =
@@ -313,8 +313,10 @@ Note: While Passing the type, construct the type that will help LLM understand t
 generateJson ::
   (ToJSON jsonResult, FromJSON jsonResult) =>
   GenerateOps ->
-  jsonResult -> -- ^ Haskell type that you want your result in
-  Maybe Int -> -- ^ Max retries
+  -- | 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 =
@@ -332,8 +334,11 @@ generateJson genOps@GenerateOps {..} jsonStructure mMaxRetries = do
     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))
+        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

src/OllamaExamples.hs

@@ -1,26 +1,28 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 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 Ollama qualified
-import Data.Aeson
 import GHC.Generics
-import Data.Ollama.Generate (generateJson)
-import Data.Ollama.Chat (chatJson)
+import Ollama (GenerateOps (..), Role (..), chat, defaultChatOps, defaultGenerateOps, generate)
+import Ollama qualified
 
-data Example = Example {
-    sortedList :: [String]
+data Example = Example
+  { sortedList :: [String]
   , wasListAlreadSorted :: Bool
-  } deriving (Show, Eq, Generic, FromJSON, ToJSON)
+  }
+  deriving (Show, Eq, Generic, FromJSON, ToJSON)
 
 main :: IO ()
 main = do
@@ -93,13 +95,15 @@ main = do
   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. 
+  -- 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
+  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."
@@ -110,21 +114,37 @@ main = do
     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
+  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)
+      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 #-}
@@ -153,7 +173,7 @@ main = do
   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
@@ -167,7 +187,7 @@ main = do
         _ -> 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"