module Iris.Colour.Mode (
ColourMode (..),
detectColourMode,
handleColourMode,
) where
import Data.Char (toLower, toUpper)
import Data.Maybe (isJust)
import System.Console.ANSI (hSupportsANSIColor)
import System.Environment (lookupEnv)
import System.IO (Handle)
import Iris.Cli.Colour (ColourOption (..))
data ColourMode
=
DisableColour
|
EnableColour
deriving stock
( Int -> ColourMode -> ShowS
[ColourMode] -> ShowS
ColourMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColourMode] -> ShowS
$cshowList :: [ColourMode] -> ShowS
show :: ColourMode -> String
$cshow :: ColourMode -> String
showsPrec :: Int -> ColourMode -> ShowS
$cshowsPrec :: Int -> ColourMode -> ShowS
Show
, ColourMode -> ColourMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColourMode -> ColourMode -> Bool
$c/= :: ColourMode -> ColourMode -> Bool
== :: ColourMode -> ColourMode -> Bool
$c== :: ColourMode -> ColourMode -> Bool
Eq
, Eq ColourMode
ColourMode -> ColourMode -> Bool
ColourMode -> ColourMode -> Ordering
ColourMode -> ColourMode -> ColourMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColourMode -> ColourMode -> ColourMode
$cmin :: ColourMode -> ColourMode -> ColourMode
max :: ColourMode -> ColourMode -> ColourMode
$cmax :: ColourMode -> ColourMode -> ColourMode
>= :: ColourMode -> ColourMode -> Bool
$c>= :: ColourMode -> ColourMode -> Bool
> :: ColourMode -> ColourMode -> Bool
$c> :: ColourMode -> ColourMode -> Bool
<= :: ColourMode -> ColourMode -> Bool
$c<= :: ColourMode -> ColourMode -> Bool
< :: ColourMode -> ColourMode -> Bool
$c< :: ColourMode -> ColourMode -> Bool
compare :: ColourMode -> ColourMode -> Ordering
$ccompare :: ColourMode -> ColourMode -> Ordering
Ord
, Int -> ColourMode
ColourMode -> Int
ColourMode -> [ColourMode]
ColourMode -> ColourMode
ColourMode -> ColourMode -> [ColourMode]
ColourMode -> ColourMode -> ColourMode -> [ColourMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ColourMode -> ColourMode -> ColourMode -> [ColourMode]
$cenumFromThenTo :: ColourMode -> ColourMode -> ColourMode -> [ColourMode]
enumFromTo :: ColourMode -> ColourMode -> [ColourMode]
$cenumFromTo :: ColourMode -> ColourMode -> [ColourMode]
enumFromThen :: ColourMode -> ColourMode -> [ColourMode]
$cenumFromThen :: ColourMode -> ColourMode -> [ColourMode]
enumFrom :: ColourMode -> [ColourMode]
$cenumFrom :: ColourMode -> [ColourMode]
fromEnum :: ColourMode -> Int
$cfromEnum :: ColourMode -> Int
toEnum :: Int -> ColourMode
$ctoEnum :: Int -> ColourMode
pred :: ColourMode -> ColourMode
$cpred :: ColourMode -> ColourMode
succ :: ColourMode -> ColourMode
$csucc :: ColourMode -> ColourMode
Enum
, ColourMode
forall a. a -> a -> Bounded a
maxBound :: ColourMode
$cmaxBound :: ColourMode
minBound :: ColourMode
$cminBound :: ColourMode
Bounded
)
handleColourMode :: Handle -> IO ColourMode
handleColourMode :: Handle -> IO ColourMode
handleColourMode Handle
handle = do
Bool
supportsANSI <- Handle -> IO Bool
hSupportsANSIColor Handle
handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
supportsANSI then ColourMode
EnableColour else ColourMode
DisableColour
detectColourMode
:: Handle
-> ColourOption
-> Maybe String
-> IO ColourMode
detectColourMode :: Handle -> ColourOption -> Maybe String -> IO ColourMode
detectColourMode Handle
handle ColourOption
colour Maybe String
maybeAppName = case ColourOption
colour of
ColourOption
Never -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ColourMode
DisableColour
ColourOption
Always -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ColourMode
EnableColour
ColourOption
Auto -> IO ColourMode
autoDetectColour
where
autoDetectColour :: IO ColourMode
autoDetectColour :: IO ColourMode
autoDetectColour = Bool -> ColourMode
disabledToMode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
checkIfDisabled
disabledToMode :: Bool -> ColourMode
disabledToMode :: Bool -> ColourMode
disabledToMode Bool
isDisabled =
if Bool
isDisabled then ColourMode
DisableColour else ColourMode
EnableColour
checkIfDisabled :: IO Bool
checkIfDisabled :: IO Bool
checkIfDisabled =
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM
[ IO Bool
isHandleColouringDisabled
, IO Bool
hasNoColourEnvVars
, IO Bool
isTermDumb
]
isHandleColouringDisabled :: IO Bool
isHandleColouringDisabled :: IO Bool
isHandleColouringDisabled = (forall a. Eq a => a -> a -> Bool
== ColourMode
DisableColour) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ColourMode
handleColourMode Handle
handle
hasNoColourEnvVars :: IO Bool
hasNoColourEnvVars :: IO Bool
hasNoColourEnvVars = forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> IO Bool
hasEnvVar [String]
allVarNames
isTermDumb :: IO Bool
isTermDumb :: IO Bool
isTermDumb =
String -> IO (Maybe String)
lookupEnv String
"TERM" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe String
mVal -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe String
mVal of
Maybe String
Nothing -> Bool
False
Just String
val -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
val forall a. Eq a => a -> a -> Bool
== String
"dumb"
hasEnvVar :: String -> IO Bool
hasEnvVar :: String -> IO Bool
hasEnvVar String
var = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
var
noColourVarNames :: [String]
noColourVarNames :: [String]
noColourVarNames = [String
"NO_COLOR", String
"NO_COLOUR"]
prepend :: String -> String -> String
prepend :: String -> ShowS
prepend String
appName String
envName = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
appName forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> String
envName
allVarNames :: [String]
allVarNames :: [String]
allVarNames = case Maybe String
maybeAppName of
Maybe String
Nothing -> [String]
noColourVarNames
Just String
appName -> [String]
noColourVarNames forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
prepend String
appName) [String]
noColourVarNames
(||^) :: Monad m => m Bool -> m Bool -> m Bool
m Bool
mx ||^ :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ m Bool
my = do
Bool
x <- m Bool
mx
if Bool
x
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else m Bool
my
orM :: Monad m => [m Bool] -> m Bool
orM :: forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(||^) (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)