{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module provides functions to detect the most appropriate color mode for the 

-- current environment.

module Graphics.Vty.Platform.Windows.Output.Color
  ( detectColorMode
  , defaultColorMode
  )
where

import Control.Exception (Exception(..))
import Data.Typeable (Typeable)
import Graphics.Vty.Attributes.Color ( ColorMode(..) )

-- | Type of errors that can be thrown when configuring VTY

newtype VtyConfigurationError =
    VtyUnsupportedTermType String
    -- ^ Terminal type not supported by vty

    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"

-- | Windows console supports full color.

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

-- | The default color mode for Windows

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