{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.Vty.Platform.Windows.Output.Color
( detectColorMode
, defaultColorMode
)
where
import Control.Exception (Exception(..))
import Data.Typeable (Typeable)
import Graphics.Vty.Attributes.Color ( ColorMode(..) )
newtype VtyConfigurationError =
VtyUnsupportedTermType String
deriving (Int -> VtyConfigurationError -> ShowS
[VtyConfigurationError] -> ShowS
VtyConfigurationError -> String
(Int -> VtyConfigurationError -> ShowS)
-> (VtyConfigurationError -> String)
-> ([VtyConfigurationError] -> ShowS)
-> Show VtyConfigurationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VtyConfigurationError -> ShowS
showsPrec :: Int -> VtyConfigurationError -> ShowS
$cshow :: VtyConfigurationError -> String
show :: VtyConfigurationError -> String
$cshowList :: [VtyConfigurationError] -> ShowS
showList :: [VtyConfigurationError] -> ShowS
Show, VtyConfigurationError -> VtyConfigurationError -> Bool
(VtyConfigurationError -> VtyConfigurationError -> Bool)
-> (VtyConfigurationError -> VtyConfigurationError -> Bool)
-> Eq VtyConfigurationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VtyConfigurationError -> VtyConfigurationError -> Bool
== :: VtyConfigurationError -> VtyConfigurationError -> Bool
$c/= :: VtyConfigurationError -> VtyConfigurationError -> Bool
/= :: VtyConfigurationError -> VtyConfigurationError -> Bool
Eq, Typeable)
instance Exception VtyConfigurationError where
displayException :: VtyConfigurationError -> String
displayException (VtyUnsupportedTermType String
name) = String
"TERM type [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] is not supported at this time"
detectColorMode :: String -> IO ColorMode
detectColorMode :: String -> IO ColorMode
detectColorMode String
termType =
case String
termType of
String
"xterm-256color" -> ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorMode
FullColor
String
"xterm" -> ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorMode
FullColor
String
_ -> ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorMode
FullColor
defaultColorMode :: IO ColorMode
defaultColorMode :: IO ColorMode
defaultColorMode = ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorMode
FullColor