{-# LANGUAGE OverloadedStrings #-}

module Data.Ollama.Common.Utils (defaultOllamaUrl, 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

defaultOllamaUrl :: Text
defaultOllamaUrl :: Text
defaultOllamaUrl = Text
"http://127.0.0.1:11434"

supportedExtensions :: [String]
supportedExtensions :: [[Char]]
supportedExtensions = [[Char]
".jpg", [Char]
".jpeg", [Char]
".png"]

safeReadFile :: FilePath -> IO (Either IOException BS.ByteString)
safeReadFile :: [Char] -> IO (Either IOException ByteString)
safeReadFile = IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> ([Char] -> IO ByteString)
-> [Char]
-> IO (Either IOException ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
BS.readFile

asPath :: FilePath -> IO (Maybe BS.ByteString)
asPath :: [Char] -> IO (Maybe ByteString)
asPath [Char]
filePath = do
  Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
filePath
  if Bool
exists
    then (IOException -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either IOException ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> IOException -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either IOException ByteString -> Maybe ByteString)
-> IO (Either IOException ByteString) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either IOException ByteString)
safeReadFile [Char]
filePath
    else Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing

isSupportedExtension :: FilePath -> Bool
isSupportedExtension :: [Char] -> Bool
isSupportedExtension [Char]
path = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]
takeExtension [Char]
path) [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
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 :: [Char] -> IO (Maybe Text)
encodeImage [Char]
filePath = do
  if Bool -> Bool
not ([Char] -> Bool
isSupportedExtension [Char]
filePath)
    then Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    else do
      Maybe ByteString
maybeContent <- [Char] -> IO (Maybe ByteString)
asPath [Char]
filePath
      Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode) Maybe ByteString
maybeContent