module Stack.DefaultColorWhen
  ( defaultColorWhen
  ) where

import           Stack.Prelude ( stdout )
import           Stack.Types.Config ( ColorWhen (ColorAuto, ColorNever) )
import           System.Console.ANSI ( hSupportsANSIWithoutEmulation )
import           System.Environment ( lookupEnv )

-- | The default adopts the standard proposed at http://no-color.org/, that

-- color should not be added by default if the @NO_COLOR@ environment variable

-- is present.

defaultColorWhen :: IO ColorWhen
defaultColorWhen :: IO ColorWhen
defaultColorWhen = do
  -- On Windows, 'hSupportsANSIWithoutEmulation' has the side effect of enabling

  -- ANSI for ANSI-capable native (ConHost) terminals, if not already

  -- ANSI-enabled. Consequently, it is actioned even if @NO_COLOR@ might exist,

  -- as @NO_COLOR@ might be overridden in a yaml configuration file or at the

  -- command line.

  Maybe Bool
supportsANSI <- Handle -> IO (Maybe Bool)
hSupportsANSIWithoutEmulation Handle
stdout
  Maybe String
mIsNoColor <- String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe String
mIsNoColor of
    Just String
_ -> ColorWhen
ColorNever
    Maybe String
_      -> case Maybe Bool
supportsANSI of
      Just Bool
False -> ColorWhen
ColorNever
      Maybe Bool
_          -> ColorWhen
ColorAuto