{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Graphics.Vty.Platform.Unix.Settings
( VtyUnixConfigurationError(..)
, UnixSettings(..)
, currentTerminalName
, defaultSettings
)
where
import Control.Exception (Exception(..), throwIO)
import Control.Monad (when, void)
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Typeable (Typeable)
import System.Environment (lookupEnv)
import System.IO (Handle, BufferMode(..), hReady, hSetBuffering, hGetChar, stdin)
import System.Posix.IO (stdInput, stdOutput)
import System.Posix.Types (Fd(..))
data VtyUnixConfigurationError =
MissingTermEnvVar
deriving (Int -> VtyUnixConfigurationError -> ShowS
[VtyUnixConfigurationError] -> ShowS
VtyUnixConfigurationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VtyUnixConfigurationError] -> ShowS
$cshowList :: [VtyUnixConfigurationError] -> ShowS
show :: VtyUnixConfigurationError -> String
$cshow :: VtyUnixConfigurationError -> String
showsPrec :: Int -> VtyUnixConfigurationError -> ShowS
$cshowsPrec :: Int -> VtyUnixConfigurationError -> ShowS
Show, VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
$c/= :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
== :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
$c== :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
Eq, Typeable)
instance Exception VtyUnixConfigurationError where
displayException :: VtyUnixConfigurationError -> String
displayException VtyUnixConfigurationError
MissingTermEnvVar = String
"TERM environment variable not set"
data UnixSettings =
UnixSettings { UnixSettings -> Int
settingVmin :: Int
, UnixSettings -> Int
settingVtime :: Int
, UnixSettings -> Fd
settingInputFd :: Fd
, UnixSettings -> Fd
settingOutputFd :: Fd
, UnixSettings -> String
settingTermName :: String
}
deriving (Int -> UnixSettings -> ShowS
[UnixSettings] -> ShowS
UnixSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnixSettings] -> ShowS
$cshowList :: [UnixSettings] -> ShowS
show :: UnixSettings -> String
$cshow :: UnixSettings -> String
showsPrec :: Int -> UnixSettings -> ShowS
$cshowsPrec :: Int -> UnixSettings -> ShowS
Show, UnixSettings -> UnixSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnixSettings -> UnixSettings -> Bool
$c/= :: UnixSettings -> UnixSettings -> Bool
== :: UnixSettings -> UnixSettings -> Bool
$c== :: UnixSettings -> UnixSettings -> Bool
Eq)
defaultSettings :: IO UnixSettings
defaultSettings :: IO UnixSettings
defaultSettings = do
Maybe String
mb <- String -> IO (Maybe String)
lookupEnv String
termVariable
case Maybe String
mb of
Maybe String
Nothing -> forall e a. Exception e => e -> IO a
throwIO VtyUnixConfigurationError
MissingTermEnvVar
Just String
t -> do
IO ()
flushStdin
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnixSettings { settingVmin :: Int
settingVmin = Int
1
, settingVtime :: Int
settingVtime = Int
100
, settingInputFd :: Fd
settingInputFd = Fd
stdInput
, settingOutputFd :: Fd
settingOutputFd = Fd
stdOutput
, settingTermName :: String
settingTermName = String
t
}
termVariable :: String
termVariable :: String
termVariable = String
"TERM"
currentTerminalName :: IO (Maybe String)
currentTerminalName :: IO (Maybe String)
currentTerminalName = String -> IO (Maybe String)
lookupEnv String
termVariable
flushStdin :: IO ()
flushStdin :: IO ()
flushStdin = do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
forall (m :: * -> *). Monad m => m Bool -> m ()
whileM forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
consume Handle
stdin
whileM :: (Monad m) => m Bool -> m ()
whileM :: forall (m :: * -> *). Monad m => m Bool -> m ()
whileM m Bool
act = do
Bool
continue <- m Bool
act
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => m Bool -> m ()
whileM m Bool
act
consume :: Handle -> IO Bool
consume :: Handle -> IO Bool
consume Handle
h = do
Bool
avail <- Handle -> IO Bool
hReady Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
avail forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Handle -> IO Char
hGetChar Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
avail