--------------------------------------------------------------------------------
{-# LANGUAGE TemplateHaskell #-}
module Patat.Images.ITerm2
    ( backend
    ) where


--------------------------------------------------------------------------------
import           Control.Exception           (throwIO)
import           Control.Monad               (unless, when)
import qualified Data.Aeson                  as A
import qualified Data.ByteString.Base64.Lazy as B64
import qualified Data.ByteString.Lazy        as BL
import qualified Data.List                   as L
import           Patat.Cleanup               (Cleanup)
import qualified Patat.Images.Internal       as Internal
import           System.Environment          (lookupEnv)


--------------------------------------------------------------------------------
backend :: Internal.Backend
backend :: Backend
backend = (Config Config -> IO Handle) -> Backend
forall a. FromJSON a => (Config a -> IO Handle) -> Backend
Internal.Backend Config Config -> IO Handle
new


--------------------------------------------------------------------------------
data Config = Config deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq)
instance A.FromJSON Config where parseJSON :: Value -> Parser Config
parseJSON Value
_ = Config -> Parser Config
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
Config


--------------------------------------------------------------------------------
new :: Internal.Config Config -> IO Internal.Handle
new :: Config Config -> IO Handle
new Config Config
config = do
    Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config Config
config Config Config -> Config Config -> Bool
forall a. Eq a => a -> a -> Bool
== Config Config
forall a. Config a
Internal.Auto) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ do
        Maybe String
termProgram <- String -> IO (Maybe String)
lookupEnv String
"TERM_PROGRAM"
        Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String
termProgram Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"iTerm.app") (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ BackendNotSupported -> Cleanup
forall e a. Exception e => e -> IO a
throwIO (BackendNotSupported -> Cleanup) -> BackendNotSupported -> Cleanup
forall a b. (a -> b) -> a -> b
$
            String -> BackendNotSupported
Internal.BackendNotSupported String
"TERM_PROGRAM not iTerm.app"

    Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Internal.Handle {hDrawImage :: String -> IO Cleanup
Internal.hDrawImage = String -> IO Cleanup
drawImage}


--------------------------------------------------------------------------------
drawImage :: FilePath -> IO Cleanup
drawImage :: String -> IO Cleanup
drawImage String
path = do
    ByteString
content <- String -> IO ByteString
BL.readFile String
path
    Cleanup -> Cleanup
withEscapeSequence (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ do
        String -> Cleanup
putStr String
"1337;File=inline=1;width=100%;height=100%:"
        ByteString -> Cleanup
BL.putStr (ByteString -> ByteString
B64.encode ByteString
content)
    Cleanup -> IO Cleanup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cleanup
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
withEscapeSequence :: IO () -> IO ()
withEscapeSequence :: Cleanup -> Cleanup
withEscapeSequence Cleanup
f = do
    Maybe String
term <- String -> IO (Maybe String)
lookupEnv String
"TERM"
    let inScreen :: Bool
inScreen = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String
"screen" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) Maybe String
term
    String -> Cleanup
putStr (String -> Cleanup) -> String -> Cleanup
forall a b. (a -> b) -> a -> b
$ if Bool
inScreen then String
"\ESCPtmux;\ESC\ESC]" else String
"\ESC]"
    Cleanup
f
    String -> Cleanup
putStrLn (String -> Cleanup) -> String -> Cleanup
forall a b. (a -> b) -> a -> b
$ if Bool
inScreen then String
"\a\ESC\\" else String
"\a"