--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Patat.Images
    ( Backend
    , Handle
    , withHandle
    , drawImage
    ) where


--------------------------------------------------------------------------------
import           Control.Exception           (catch)
import qualified Data.Aeson                  as A
import qualified Data.Text                   as T
import           Patat.Cleanup
import           Patat.Images.Internal
import qualified Patat.Images.ITerm2         as ITerm2
import qualified Patat.Images.Kitty          as Kitty
import qualified Patat.Images.W3m            as W3m
import           Patat.Presentation.Internal


--------------------------------------------------------------------------------
withHandle :: ImageSettings -> (Handle -> IO a) -> IO a
withHandle :: forall a. ImageSettings -> (Handle -> IO a) -> IO a
withHandle ImageSettings
is Handle -> IO a
f
    | ImageSettings -> Text
isBackend ImageSettings
is Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"auto" = IO Handle
auto IO Handle -> (Handle -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO a
f
    | Just (Backend Config a -> IO Handle
b) <- Text -> [(Text, Backend)] -> Maybe Backend
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ImageSettings -> Text
isBackend ImageSettings
is) [(Text, Backend)]
backends =
        case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON (Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ ImageSettings -> Object
isParams ImageSettings
is) of
            A.Success a
c -> Config a -> IO Handle
b (a -> Config a
forall a. a -> Config a
Explicit a
c) IO Handle -> (Handle -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO a
f
            A.Error [Char]
err -> [Char] -> IO a
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO a) -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$
                [Char]
"Patat.Images.new: Error parsing config for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                Text -> [Char]
forall a. Show a => a -> [Char]
show (ImageSettings -> Text
isBackend ImageSettings
is) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" image backend: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
withHandle ImageSettings
is Handle -> IO a
_ = [Char] -> IO a
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO a) -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$
    [Char]
"Patat.Images.new: Could not find " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show (ImageSettings -> Text
isBackend ImageSettings
is) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
    [Char]
" image backend."


--------------------------------------------------------------------------------
auto :: IO Handle
auto :: IO Handle
auto = [Text] -> [(Text, Backend)] -> IO Handle
go [] [(Text, Backend)]
backends
  where
    go :: [Text] -> [(Text, Backend)] -> IO Handle
go [Text]
names ((Text
name, Backend Config a -> IO Handle
b) : [(Text, Backend)]
bs) = IO Handle -> (BackendNotSupported -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
        (Config a -> IO Handle
b Config a
forall a. Config a
Auto)
        (\(BackendNotSupported [Char]
_) -> [Text] -> [(Text, Backend)] -> IO Handle
go (Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
names) [(Text, Backend)]
bs)
    go [Text]
names [] = [Char] -> IO Handle
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO Handle) -> [Char] -> IO Handle
forall a b. (a -> b) -> a -> b
$
        [Char]
"Could not find a supported backend, tried: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        Text -> [Char]
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
names))


--------------------------------------------------------------------------------
-- | All supported backends.  We can use CPP to include or exclude some
-- depending on platform availability.
backends :: [(T.Text, Backend)]
backends :: [(Text, Backend)]
backends =
    [ (Text
"iterm2", Backend
ITerm2.backend)
    , (Text
"kitty",  Backend
Kitty.backend)
    , (Text
"w3m",    Backend
W3m.backend)
    ]


--------------------------------------------------------------------------------
drawImage :: Handle -> FilePath -> IO Cleanup
drawImage :: Handle -> [Char] -> IO Cleanup
drawImage = Handle -> [Char] -> IO Cleanup
hDrawImage