{-# 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
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"

-- | 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
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)

-- | Default runtime settings used by the library.
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