packages feed

ollama-haskell 0.1.1.3 → 0.1.2.0

raw patch · 17 files changed

+245/−348 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.Ollama.Common.Utils: defaultOllama :: OllamaClient
- OllamaExamples: instance Data.Aeson.Types.FromJSON.FromJSON OllamaExamples.Example
- OllamaExamples: instance Data.Aeson.Types.ToJSON.ToJSON OllamaExamples.Example
- OllamaExamples: instance GHC.Classes.Eq OllamaExamples.Example
- OllamaExamples: instance GHC.Generics.Generic OllamaExamples.Example
- OllamaExamples: instance GHC.Show.Show OllamaExamples.Example
- OllamaExamples: main :: IO ()
+ Data.Ollama.Chat: [hostUrl] :: ChatOps -> Maybe Text
+ Data.Ollama.Chat: [responseTimeOut] :: ChatOps -> Maybe Int
+ Data.Ollama.Common.Utils: defaultOllamaUrl :: Text
+ Data.Ollama.Generate: [$sel:hostUrl:GenerateOps] :: GenerateOps -> Maybe Text
+ Data.Ollama.Generate: [$sel:responseTimeOut:GenerateOps] :: GenerateOps -> Maybe Int
+ Ollama: [$sel:hostUrl:GenerateOps] :: GenerateOps -> Maybe Text
+ Ollama: [$sel:responseTimeOut:GenerateOps] :: GenerateOps -> Maybe Int
+ Ollama: [hostUrl] :: ChatOps -> Maybe Text
+ Ollama: [responseTimeOut] :: ChatOps -> Maybe Int
- Data.Ollama.Chat: ChatOps :: Text -> NonEmpty Message -> Maybe Text -> Maybe Text -> Maybe (ChatResponse -> IO (), IO ()) -> Maybe Text -> ChatOps
+ Data.Ollama.Chat: ChatOps :: Text -> NonEmpty Message -> Maybe Text -> Maybe Text -> Maybe (ChatResponse -> IO (), IO ()) -> Maybe Text -> Maybe Text -> Maybe Int -> ChatOps
- Data.Ollama.Generate: GenerateOps :: Text -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe (GenerateResponse -> IO (), IO ()) -> Maybe Bool -> Maybe Text -> GenerateOps
+ Data.Ollama.Generate: GenerateOps :: Text -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe (GenerateResponse -> IO (), IO ()) -> Maybe Bool -> Maybe Text -> Maybe Text -> Maybe Int -> GenerateOps
- Ollama: ChatOps :: Text -> NonEmpty Message -> Maybe Text -> Maybe Text -> Maybe (ChatResponse -> IO (), IO ()) -> Maybe Text -> ChatOps
+ Ollama: ChatOps :: Text -> NonEmpty Message -> Maybe Text -> Maybe Text -> Maybe (ChatResponse -> IO (), IO ()) -> Maybe Text -> Maybe Text -> Maybe Int -> ChatOps
- Ollama: GenerateOps :: Text -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe (GenerateResponse -> IO (), IO ()) -> Maybe Bool -> Maybe Text -> GenerateOps
+ Ollama: GenerateOps :: Text -> Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe (GenerateResponse -> IO (), IO ()) -> Maybe Bool -> Maybe Text -> Maybe Text -> Maybe Int -> GenerateOps

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for ollama-haskell +## 0.1.2.0 -- 2024-11-20++* Added hostUrl and responseTimeOut options in generate function.+* Added hostUrl and responseTimeOut options in chat function.+ ## 0.1.1.3 -- 2024-11-08  * Increase response timeout to 15 minutes
README.md view
@@ -38,7 +38,7 @@ 3. **Garbage collection**: Haskell handles memory management automatically, freeing you from worries about manual memory deallocation. ``` -You can find practical examples demonstrating how to use the library in the `src/OllamaExamples.hs` file. +You can find practical examples demonstrating how to use the library in the `examples/OllamaExamples.hs` file.   ## Prerequisite 
ollama-haskell.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           ollama-haskell-version:        0.1.1.3+version:        0.1.2.0 synopsis:       Haskell bindings for ollama. description:    Please see the README on GitHub at <https://github.com/tusharad/ollama-haskell#readme> category:       Web@@ -41,7 +41,6 @@       Data.Ollama.Push       Data.Ollama.Show       Ollama-      OllamaExamples   other-modules:       Paths_ollama_haskell   hs-source-dirs:
src/Data/Ollama/Chat.hs view
@@ -14,11 +14,12 @@   , ChatResponse (..)   ) where +import Control.Exception (try) import Data.Aeson import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy.Char8 qualified as BSL import Data.List.NonEmpty as NonEmpty-import Data.Maybe (isNothing)+import Data.Maybe (fromMaybe, isNothing) import Data.Ollama.Common.Utils as CU import Data.Text (Text) import Data.Text qualified as T@@ -72,6 +73,10 @@   -- ^ Optional streaming functions where the first handles each chunk of the response, and the second flushes the stream.   , keepAlive :: Maybe Text   -- ^ Optional text to specify keep-alive behavior.+  , hostUrl :: Maybe Text+  -- ^ Override default Ollama host url. Default url = "http://127.0.0.1:11434"+  , responseTimeOut :: Maybe Int+  -- ^ Override default response timeout in minutes. Default = 15 minutes   }  instance Show ChatOps where@@ -123,7 +128,7 @@   deriving (Show, Eq)  instance ToJSON ChatOps where-  toJSON (ChatOps model_ messages_ tools_ format_ stream_ keepAlive_) =+  toJSON (ChatOps model_ messages_ tools_ format_ stream_ keepAlive_ _ _) =     object       [ "model" .= model_       , "messages" .= messages_@@ -165,6 +170,8 @@     , format = Nothing     , stream = Nothing     , keepAlive = Nothing+    , hostUrl = Nothing+    , responseTimeOut = Nothing     }  {- |@@ -183,45 +190,57 @@ -} chat :: ChatOps -> IO (Either String ChatResponse) chat cOps = do-  let url = CU.host defaultOllama+  let url = fromMaybe defaultOllamaUrl (hostUrl cOps)+      responseTimeout = fromMaybe 15 (responseTimeOut cOps)   manager <-     newManager       defaultManagerSettings -- Setting response timeout to 5 minutes, since llm takes time-        { managerResponseTimeout = responseTimeoutMicro (15 * 60 * 1000000)+        { managerResponseTimeout = responseTimeoutMicro (responseTimeout * 60 * 1000000)         }-  initialRequest <- parseRequest $ T.unpack (url <> "/api/chat")-  let reqBody = cOps-      request =-        initialRequest-          { method = "POST"-          , requestBody = RequestBodyLBS $ encode reqBody-          }-  withResponse request manager $ \response -> do-    let streamResponse sendChunk flush = do-          bs <- brRead $ responseBody response-          if BS.null bs-            then putStrLn "" >> pure (Left "")-            else do-              let eRes = eitherDecode (BSL.fromStrict bs) :: Either String ChatResponse-              case eRes of-                Left e -> pure (Left e)-                Right r -> do-                  _ <- sendChunk r-                  _ <- flush-                  if done r then pure (Left "") else streamResponse sendChunk flush-    let genResponse op = do-          bs <- brRead $ responseBody response-          if BS.null bs-            then do-              let eRes = eitherDecode (BSL.fromStrict op) :: Either String ChatResponse-              case eRes of-                Left e -> pure (Left e)-                Right r -> pure (Right r)-            else genResponse (op <> bs)-    case stream cOps of-      Nothing -> genResponse ""-      Just (sendChunk, flush) -> streamResponse sendChunk flush+  eInitialRequest <- try $ parseRequest $ T.unpack (url <> "/api/chat") :: IO (Either HttpException Request)+  case eInitialRequest of+    Left e -> return $ Left $ "Failed to parse host url: " <> show e+    Right initialRequest -> do+      let reqBody = cOps+          request =+            initialRequest+              { method = "POST"+              , requestBody = RequestBodyLBS $ encode reqBody+              }+      eRes <-+        try (withResponse request manager $ handleRequest cOps) ::+          IO (Either HttpException (Either String ChatResponse))+      case eRes of+        Left e -> return $ Left $ "HTTP error occured: " <> show e+        Right r -> return r +handleRequest :: ChatOps -> Response BodyReader -> IO (Either String ChatResponse)+handleRequest cOps response = do+  let streamResponse sendChunk flush = do+        bs <- brRead $ responseBody response+        if BS.null bs+          then putStrLn "" >> pure (Left "")+          else do+            let eRes = eitherDecode (BSL.fromStrict bs) :: Either String ChatResponse+            case eRes of+              Left e -> pure (Left e)+              Right r -> do+                _ <- sendChunk r+                _ <- flush+                if done r then pure (Left "") else streamResponse sendChunk flush+  let genResponse op = do+        bs <- brRead $ responseBody response+        if BS.null bs+          then do+            let eRes = eitherDecode (BSL.fromStrict op) :: Either String ChatResponse+            case eRes of+              Left e -> pure (Left e)+              Right r -> pure (Right r)+          else genResponse (op <> bs)+  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.@@ -258,8 +277,10 @@ chatJson ::   (FromJSON jsonResult, ToJSON jsonResult) =>   ChatOps ->-  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) chatJson cOps@ChatOps {..} jsonStructure mMaxRetries = do   let lastMessage = NonEmpty.last messages@@ -288,8 +309,8 @@         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))+            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
src/Data/Ollama/Common/Utils.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Data.Ollama.Common.Utils (defaultOllama, OllamaClient (..), encodeImage) where+module Data.Ollama.Common.Utils (defaultOllamaUrl, OllamaClient (..), encodeImage) where  import Control.Exception (IOException, try) import Data.ByteString qualified as BS@@ -12,8 +12,8 @@ import System.Directory import System.FilePath -defaultOllama :: OllamaClient-defaultOllama = OllamaClient "http://127.0.0.1:11434"+defaultOllamaUrl :: Text+defaultOllamaUrl = "http://127.0.0.1:11434"  supportedExtensions :: [String] supportedExtensions = [".jpg", ".jpeg", ".png"]@@ -33,7 +33,7 @@  {- |   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 +  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)
src/Data/Ollama/Copy.hs view
@@ -36,7 +36,7 @@   source_   destination_ =     do-      let url = CU.host CU.defaultOllama+      let url = CU.defaultOllamaUrl       manager <- newManager defaultManagerSettings       initialRequest <- parseRequest $ T.unpack (url <> "/api/copy")       let reqBody =
src/Data/Ollama/Create.hs view
@@ -69,7 +69,7 @@   stream_   path_ =     do-      let url = CU.host defaultOllama+      let url = defaultOllamaUrl       manager <- newManager defaultManagerSettings       initialRequest <- parseRequest $ T.unpack (url <> "/api/create")       let reqBody =
src/Data/Ollama/Delete.hs view
@@ -28,7 +28,7 @@   IO () deleteModel modelName =   do-    let url = CU.host CU.defaultOllama+    let url = CU.defaultOllamaUrl     manager <- newManager defaultManagerSettings     initialRequest <- parseRequest $ T.unpack (url <> "/api/delete")     let reqBody =
src/Data/Ollama/Embeddings.hs view
@@ -54,7 +54,7 @@   Maybe Text ->   IO (Maybe EmbeddingResp) embeddingOps modelName input_ mTruncate mKeepAlive = do-  let url = CU.host defaultOllama+  let url = defaultOllamaUrl   manager <- newManager defaultManagerSettings   initialRequest <- parseRequest $ T.unpack (url <> "/api/embed")   let reqBody =
src/Data/Ollama/Generate.hs view
@@ -11,6 +11,7 @@   , GenerateResponse (..)   ) where +import Control.Exception (try) import Data.Aeson import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy.Char8 qualified as BSL@@ -66,6 +67,10 @@   -- ^ An optional flag to return the raw response.   , keepAlive :: Maybe Text   -- ^ Optional text to specify keep-alive behavior.+  , hostUrl :: Maybe Text+  -- ^ Override default Ollama host url. Default url = "http://127.0.0.1:11434"+  , responseTimeOut :: Maybe Int+  -- ^ Override default response timeout in minutes. Default = 15 minutes   }  instance Show GenerateOps where@@ -146,6 +151,8 @@         stream         raw         keepAlive+        _ -- Host url+        _ -- Response timeout       ) =       object         [ "model" .= model@@ -197,6 +204,8 @@     , stream = Nothing     , raw = Nothing     , keepAlive = Nothing+    , hostUrl = Nothing+    , responseTimeOut = Nothing     }  {- |@@ -239,42 +248,59 @@ -} generate :: GenerateOps -> IO (Either String GenerateResponse) generate genOps = do-  let url = CU.host defaultOllama+  let url = fromMaybe defaultOllamaUrl (hostUrl genOps)+      responseTimeout = fromMaybe 15 (responseTimeOut genOps)   manager <-     newManager -- Setting response timeout to 5 minutes, since llm takes time-      defaultManagerSettings {managerResponseTimeout = responseTimeoutMicro (15 * 60 * 1000000)}-  initialRequest <- parseRequest $ T.unpack (url <> "/api/generate")-  let reqBody = genOps-      request =-        initialRequest-          { method = "POST"-          , requestBody = RequestBodyLBS $ encode reqBody-          }-  withResponse request manager $ \response -> do-    let streamResponse sendChunk flush = do-          bs <- brRead $ responseBody response-          if BS.null bs-            then putStrLn "" >> pure (Left "")-            else do-              let eRes = eitherDecode (BSL.fromStrict bs) :: Either String GenerateResponse-              case eRes of-                Left e -> pure (Left e)-                Right r -> do-                  _ <- sendChunk r-                  _ <- flush-                  if done r then pure (Left "") else streamResponse sendChunk flush-    let genResponse op = do-          bs <- brRead $ responseBody response-          if bs == ""-            then do-              let eRes0 = eitherDecode (BSL.fromStrict op) :: Either String GenerateResponse-              case eRes0 of-                Left e -> pure (Left e)-                Right r -> pure (Right r)-            else genResponse (op <> bs)-    case stream genOps of-      Nothing -> genResponse ""-      Just (sendChunk, flush) -> streamResponse sendChunk flush+      defaultManagerSettings+        { managerResponseTimeout = responseTimeoutMicro (responseTimeout * 60 * 1000000)+        }+  eInitialRequest <-+    try $ parseRequest $ T.unpack (url <> "/api/generate") :: IO (Either HttpException Request)+  case eInitialRequest of+    Left e -> do+      return $ Left $ show e+    Right initialRequest -> do+      let reqBody = genOps+          request =+            initialRequest+              { method = "POST"+              , requestBody = RequestBodyLBS $ encode reqBody+              }+      eRes <-+        try (withResponse request manager $ handleRequest genOps) ::+          IO (Either HttpException (Either String GenerateResponse))+      case eRes of+        Left e -> do+          return $ Left $ "HTTP error occured: " <> show e+        Right r -> return r++handleRequest :: GenerateOps -> Response BodyReader -> IO (Either String GenerateResponse)+handleRequest genOps response = do+  let streamResponse sendChunk flush = do+        bs <- brRead $ responseBody response+        if BS.null bs+          then putStrLn "" >> pure (Left "")+          else do+            let eRes = eitherDecode (BSL.fromStrict bs) :: Either String GenerateResponse+            case eRes of+              Left e -> pure (Left e)+              Right r -> do+                _ <- sendChunk r+                _ <- flush+                if done r then pure (Left "") else streamResponse sendChunk flush+  let genResponse op = do+        bs <- brRead $ responseBody response+        if bs == ""+          then do+            let eRes0 = eitherDecode (BSL.fromStrict op) :: Either String GenerateResponse+            case eRes0 of+              Left e -> pure (Left e)+              Right r -> pure (Right r)+          else genResponse (op <> bs)+  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
src/Data/Ollama/List.hs view
@@ -46,7 +46,7 @@ -- | List all models from local list :: IO (Maybe Models) list = do-  let url = CU.host defaultOllama+  let url = defaultOllamaUrl   manager <- newManager defaultManagerSettings   request <- parseRequest $ T.unpack (url <> "/api/tags")   response <- httpLbs request manager
src/Data/Ollama/Ps.hs view
@@ -48,7 +48,7 @@ -- | List running models ps :: IO (Maybe RunningModels) ps = do-  let url = CU.host defaultOllama+  let url = defaultOllamaUrl   manager <- newManager defaultManagerSettings   request <- parseRequest $ T.unpack (url <> "/api/ps")   response <- httpLbs request manager
src/Data/Ollama/Pull.hs view
@@ -66,7 +66,7 @@   Maybe Bool ->   IO () pullOps modelName mInsecure mStream = do-  let url = CU.host defaultOllama+  let url = defaultOllamaUrl   manager <- newManager defaultManagerSettings   initialRequest <- parseRequest $ T.unpack (url <> "/api/pull")   let reqBody =
src/Data/Ollama/Push.hs view
@@ -44,7 +44,7 @@   Maybe Bool ->   IO () pushOps modelName mInsecure mStream = do-  let url = CU.host defaultOllama+  let url = defaultOllamaUrl   manager <- newManager defaultManagerSettings   initialRequest <- parseRequest $ T.unpack (url <> "/api/push")   let reqBody =
src/Data/Ollama/Show.hs view
@@ -141,7 +141,7 @@   modelName   verbose_ =     do-      let url = CU.host CU.defaultOllama+      let url = CU.defaultOllamaUrl       manager <- newManager defaultManagerSettings       initialRequest <- parseRequest $ T.unpack (url <> "/api/show")       let reqBody =
− src/OllamaExamples.hs
@@ -1,202 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module OllamaExamples (main) where--import Control.Monad (void)-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 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-  -- This example demonstrates how to generate text using a model and stream the output directly to the console.-  -- The `stream` option enables processing of each chunk of the response as it arrives.-  void $-    generate-      defaultGenerateOps-        { modelName = "llama3.2"-        , prompt = "what is functional programming?"-        , stream = Just (T.putStr . Ollama.response_, pure ())-        }--  -- Example 2: Non-streamed Text Generation-  -- This example shows how to generate text and handle the complete response.-  -- The result is either an error message or the generated text.-  eRes <--    generate-      defaultGenerateOps-        { modelName = "llama3.2"-        , prompt = "What is 2+2?"-        }-  case eRes of-    Left e -> putStrLn e-    Right Ollama.GenerateResponse {..} -> T.putStrLn response_--  -- Example 3: Chat with Streaming-  -- This example demonstrates setting up a chat session with streaming enabled.-  -- As messages are received, they are printed to the console.-  let msg = Ollama.Message User "What is functional programming?" Nothing-      defaultMsg = Ollama.Message User "" Nothing-  void $-    chat-      defaultChatOps-        { Chat.chatModelName = "llama3.2"-        , Chat.messages = msg :| []-        , Chat.stream =-            Just (T.putStr . Chat.content . fromMaybe defaultMsg . Chat.message, pure ())-        }--  -- Example 4: Non-streamed Chat-  -- Here, we handle a complete chat response, checking for potential errors.-  eRes1 <--    chat-      defaultChatOps-        { Chat.chatModelName = "llama3.2"-        , Chat.messages = msg :| []-        }-  case eRes1 of-    Left e -> putStrLn e-    Right r -> do-      let mMessage = Ollama.message r-      case mMessage of-        Nothing -> putStrLn "Something went wrong"-        Just res -> T.putStrLn $ Ollama.content res--  -- Example 5: Check Model Status (ps)-  -- This example checks the status of models using the `ps` function.-  -- It outputs the status or details of the available models.-  res <- Ollama.ps-  print res--  -- Example 6: Simple Embedding-  -- This demonstrates how to request embeddings for a given text using a specific model.-  void $ Ollama.embedding "llama3.1" "What is 5+2?"--  -- Example 7: Embedding with Options-  -- 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 #-}--module Main where--import Web.Scotty-import Control.Monad.IO.Class (liftIO)-import Data.Aeson (FromJSON, ToJSON)-import Data.Text (Text)-import Data.Text qualified as T-import Database.SQLite.Simple-import Ollama (GenerateOps(..), defaultGenerateOps, generate)-import Data.Maybe (fromRight)--data PromptInput = PromptInput-  { conversation_id :: Int-  , prompt :: Text-  } deriving (Show, Generic)--instance FromJSON PromptInput-instance ToJSON PromptInput--main :: IO ()-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-      let cId = conversation_id p-      let trimmedP = T.dropEnd 3 $ T.drop 3 $ prompt p-      newConvoId <- case cId of-        -1 -> do-          liftIO $ execute conn "INSERT INTO conversation (convo_title) VALUES (?)" (Only ("latest title" :: String))-          [Only convoId] <- liftIO $ query_ conn "SELECT last_insert_rowid()" :: ActionM [Only Int]-          pure convoId-        _ -> 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"-                , prompt = prompt p-                , stream = Just (sendChunk . T.pack, flush)-                }-        case eRes of-            Left e -> return ()-            Right r -> do-                let res = response_ r-                liftIO $ execute conn "INSERT INTO chats (convo_id, role, message) VALUES (?, 'ai', ?)" (newConvoId, res)--}
test/Main.hs view
@@ -1,75 +1,123 @@ {-# LANGUAGE OverloadedStrings #-}-module Main where -import Ollama qualified-import Ollama (defaultGenerateOps, GenerateOps(..), defaultChatOps, Role(..))+module Main (main) where++import Data.Either+import Data.List.NonEmpty hiding (length)+import Data.Maybe import Data.Ollama.Chat qualified as Chat import Data.Text.IO qualified as T+import Ollama (GenerateOps (..), Role (..), defaultChatOps, defaultGenerateOps)+import Ollama qualified+import System.IO.Silently (capture) import Test.Tasty import Test.Tasty.HUnit-import System.IO.Silently (capture)-import Data.Either-import Data.List.NonEmpty hiding (length)-import Data.Maybe  tests :: TestTree-tests = testGroup "Tests" [-       generateTest-      , chatTest-      , psTest-      , showTest-   ]+tests =+  testGroup+    "Tests"+    [ generateTest+    , chatTest+    , psTest+    , showTest+    ]  generateTest :: TestTree-generateTest = testGroup "Generate tests" [-       testCase "generate stream" $ do-          output <- capture $ Ollama.generate defaultGenerateOps { modelName = "smollm:360m"-               , prompt = "what is 4 + 2?"-               , stream = Just (T.putStr . Ollama.response_, pure ()) }-          assertBool "Checking if generate function is printing anything" (length output > 0)+generateTest =+  testGroup+    "Generate tests"+    [ testCase "generate stream" $ do+        output <-+          capture $+            Ollama.generate+              defaultGenerateOps+                { modelName = "llama3.2"+                , prompt = "what is 4 + 2?"+                , stream = Just (T.putStr . Ollama.response_, pure ())+                }+        assertBool "Checking if generate function is printing anything" (length output > 0)     , testCase "Generate non-stream" $ do-          eRes <- Ollama.generate defaultGenerateOps { modelName = "smollm:360m"-               , prompt = "what is 4 + 2?" }-          assertBool "Checking if generate function returns a valid value" (isRight eRes)+        eRes <-+          Ollama.generate+            defaultGenerateOps+              { modelName = "llama3.2"+              , prompt = "what is 4 + 2?"+              }+        assertBool "Checking if generate function returns a valid value" (isRight eRes)+    , testCase "Generate with invalid host" $ do+        eRes <- Ollama.generate defaultGenerateOps {+            modelName = "llama3.2"+          , prompt = "what is 23 + 9?"+          , hostUrl = pure "http://some-site"+          , responseTimeOut = pure 2+        }+        print ("got response" :: String ,eRes)+        assertBool "Expecting Left" (isLeft eRes)     , testCase "Generate with invalid model" $ do-          eRes <- Ollama.generate defaultGenerateOps { modelName = "invalid-model" }-          assertBool "Expecting generation to fail with invalid model" (isLeft eRes)-   ]+        eRes <- Ollama.generate defaultGenerateOps {modelName = "invalid-model"}+        assertBool "Expecting generation to fail with invalid model" (isLeft eRes)+    ]  chatTest :: TestTree-chatTest = testGroup "Chat tests" [-        testCase "chat stream" $ do-          let msg = Ollama.Message User "What is 29 + 3?" Nothing-              defaultMsg = Ollama.Message User "" Nothing-          output <- capture $ Ollama.chat defaultChatOps { -                 Chat.chatModelName = "smollm:360m"-               , Chat.messages = msg :| []-               , Chat.stream = Just (T.putStr . Chat.content . fromMaybe defaultMsg . Chat.message, pure ())-               }-          assertBool "Checking if chat function is printing anything" (length output > 0)-+chatTest =+  testGroup+    "Chat tests"+    [ testCase "chat stream" $ do+        let msg = Ollama.Message User "What is 29 + 3?" Nothing+            defaultMsg = Ollama.Message User "" Nothing+        output <-+          capture $+            Ollama.chat+              defaultChatOps+                { Chat.chatModelName = "llama3.2"+                , Chat.messages = msg :| []+                , Chat.stream = Just (T.putStr . Chat.content . fromMaybe defaultMsg . Chat.message, pure ())+                }+        assertBool "Checking if chat function is printing anything" (length output > 0)     , testCase "Chat non-stream" $ do-          let msg = Ollama.Message User "What is 29 + 3?" Nothing-          eRes <- Ollama.chat defaultChatOps { -                 Chat.chatModelName = "smollm:360m"-               , Chat.messages = msg :| []-               }-          assertBool "Checking if chat function returns a valid value" (isRight eRes)-   ]+        let msg = Ollama.Message User "What is 29 + 3?" Nothing+        eRes <-+          Ollama.chat+            defaultChatOps+              { Chat.chatModelName = "llama3.2"+              , Chat.messages = msg :| []+              }+        assertBool "Checking if chat function returns a valid value" (isRight eRes)+    , testCase "Chat invalid host url" $ do+        let msg = Ollama.Message User "What is 29 + 3?" Nothing+        eRes <-+          Ollama.chat+            defaultChatOps+              { Chat.chatModelName = "llama3.2"+              , Chat.messages = msg :| []+              , Chat.hostUrl = pure "some random value"+              , Chat.responseTimeOut = pure 2+              }+        assertBool "It should return Left" (isLeft eRes)+    ]  psTest :: TestTree-psTest = testGroup "PS test" [-       testCase "check ps" $ do-           mRes <- Ollama.ps-           assertBool "Check if ps returns anything" (isJust mRes)-   ]+psTest =+  testGroup+    "PS test"+    [ testCase "check ps" $ do+        mRes <- Ollama.ps+        assertBool "Check if ps returns anything" (isJust mRes)+    ]  showTest :: TestTree-showTest = testGroup "Show test" [-       testCase "check show" $ do-           mRes <- Ollama.showModel "smollm:360m"-           assertBool "Check if model exists or not" (isJust mRes)-   ]+showTest =+  testGroup+    "Show test"+    [ testCase "check show" $ do+        mRes <- Ollama.showModel "llama3.2"+        assertBool "Check if model exists or not" (isJust mRes)+    ]  main :: IO ()-main = defaultMain tests+main = do+  mRes <- Ollama.list+  case mRes of+    Nothing -> pure () -- Ollama is likely not running. Not running tests.+    Just _ -> defaultMain tests