{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Runtime settings for @vty-unix@. Most applications will not need to
-- change any of these settings.
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(..))

-- | Type of exceptions that can be raised when configuring Vty on a
-- Unix system.
data VtyUnixConfigurationError =
    MissingTermEnvVar
    -- ^ The @TERM@ environment variable is not set.
    deriving (Int -> VtyUnixConfigurationError -> ShowS
[VtyUnixConfigurationError] -> ShowS
VtyUnixConfigurationError -> String
(Int -> VtyUnixConfigurationError -> ShowS)
-> (VtyUnixConfigurationError -> String)
-> ([VtyUnixConfigurationError] -> ShowS)
-> Show VtyUnixConfigurationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VtyUnixConfigurationError -> ShowS
showsPrec :: Int -> VtyUnixConfigurationError -> ShowS
$cshow :: VtyUnixConfigurationError -> String
show :: VtyUnixConfigurationError -> String
$cshowList :: [VtyUnixConfigurationError] -> ShowS
showList :: [VtyUnixConfigurationError] -> ShowS
Show, VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
(VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool)
-> (VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool)
-> Eq VtyUnixConfigurationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
== :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
$c/= :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
/= :: VtyUnixConfigurationError -> VtyUnixConfigurationError -> Bool
Eq, Typeable)

instance Exception VtyUnixConfigurationError where
    displayException :: VtyUnixConfigurationError -> String
displayException VtyUnixConfigurationError
MissingTermEnvVar = String
"TERM environment variable not set"

-- | Runtime library settings for interacting with Unix terminals.
--
-- See this page for details on @VTIME@ and @VMIN@:
--
-- http://unixwiz.net/techtips/termios-vmin-vtime.html
data UnixSettings =
    UnixSettings { UnixSettings -> Int
settingVmin :: Int
                 -- ^ VMIN character count.
                 , UnixSettings -> Int
settingVtime :: Int
                 -- ^ VTIME setting in tenths of a second.
                 , UnixSettings -> Fd
settingInputFd :: Fd
                 -- ^ The input file descriptor to use.
                 , UnixSettings -> Fd
settingOutputFd :: Fd
                 -- ^ The output file descriptor to use.
                 , UnixSettings -> String
settingTermName :: String
                 -- ^ The terminal name used to look up terminfo capabilities.
                 }
                 deriving (Int -> UnixSettings -> ShowS
[UnixSettings] -> ShowS
UnixSettings -> String
(Int -> UnixSettings -> ShowS)
-> (UnixSettings -> String)
-> ([UnixSettings] -> ShowS)
-> Show UnixSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnixSettings -> ShowS
showsPrec :: Int -> UnixSettings -> ShowS
$cshow :: UnixSettings -> String
show :: UnixSettings -> String
$cshowList :: [UnixSettings] -> ShowS
showList :: [UnixSettings] -> ShowS
Show, UnixSettings -> UnixSettings -> Bool
(UnixSettings -> UnixSettings -> Bool)
-> (UnixSettings -> UnixSettings -> Bool) -> Eq UnixSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnixSettings -> UnixSettings -> Bool
== :: UnixSettings -> UnixSettings -> Bool
$c/= :: UnixSettings -> UnixSettings -> Bool
/= :: UnixSettings -> UnixSettings -> Bool
Eq)

-- | Default runtime settings used by the library.
defaultSettings :: IO UnixSettings
defaultSettings :: IO UnixSettings
defaultSettings = do
    mb <- String -> IO (Maybe String)
lookupEnv String
termVariable
    case mb of
      Maybe String
Nothing -> VtyUnixConfigurationError -> IO UnixSettings
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO VtyUnixConfigurationError
MissingTermEnvVar
      Just String
t -> do
        IO ()
flushStdin
        UnixSettings -> IO UnixSettings
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnixSettings -> IO UnixSettings)
-> UnixSettings -> IO UnixSettings
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
    IO Bool -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m ()
whileM (IO Bool -> IO ()) -> IO Bool -> IO ()
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
    continue <- m Bool
act
    when continue $ whileM act

consume :: Handle -> IO Bool
consume :: Handle -> IO Bool
consume Handle
h = do
    avail <- Handle -> IO Bool
hReady Handle
h
    when avail $ void $ hGetChar h
    return avail