    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where

    import GHC.Prelude

    #if defined(MIN_VERSION_terminfo)
    import Control.Exception (catch)
    import Data.Maybe (fromMaybe)
    import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
                                    setupTermFromEnv, termColors)
    import System.Posix (queryTerminal, stdError)
    #elif defined(mingw32_HOST_OS)
    import Control.Exception (catch, try)
    -- import Data.Bits ((.|.), (.&.))
    import Foreign (Ptr, peek, with)
    import qualified Graphics.Win32 as Win32
    import qualified System.Win32 as Win32
    #endif

    import System.IO.Unsafe

    #if defined(mingw32_HOST_OS) && !defined(WINAPI)
    # if defined(i386_HOST_ARCH)
    #  define WINAPI stdcall
    # elif defined(x86_64_HOST_ARCH)
    #  define WINAPI ccall
    # else
    #  error unknown architecture
    # endif
    #endif

    -- | Does the controlling terminal support ANSI color sequences?
    -- This memoized to avoid thread-safety issues in ncurses (see #17922).
    stderrSupportsAnsiColors :: Bool
    stderrSupportsAnsiColors :: Bool
    stderrSupportsAnsiColors = IO Bool -> Bool
    forall a. IO a -> a
    unsafePerformIO IO Bool
    stderrSupportsAnsiColors'
    {-# NOINLINE stderrSupportsAnsiColors #-}

    -- | Check if ANSI escape sequences can be used to control color in stderr.
    stderrSupportsAnsiColors' :: IO Bool
    stderrSupportsAnsiColors' :: IO Bool
    stderrSupportsAnsiColors' = do
    #if defined(MIN_VERSION_terminfo)
        Bool
    stderr_available <- Fd -> IO Bool
    queryTerminal Fd
    stdError
        if Bool
    stderr_available then
          (Terminal -> Bool) -> IO Terminal -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Terminal -> Bool
    termSupportsColors IO Terminal
    setupTermFromEnv
            IO Bool -> (SetupTermError -> IO Bool) -> IO Bool
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \ (SetupTermError
    _ :: SetupTermError) -> Bool -> IO Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        else
          Bool -> IO Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      where
        termSupportsColors :: Terminal -> Bool
        termSupportsColors :: Terminal -> Bool
    termSupportsColors Terminal
    term = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Terminal -> Capability Int -> Maybe Int
    forall a. Terminal -> Capability a -> Maybe a
    getCapability Terminal
    term Capability Int
    termColors) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0

    #elif defined(mingw32_HOST_OS)
      h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
             `catch` \ (_ :: IOError) ->
               pure Win32.nullHANDLE
      if h == Win32.nullHANDLE
        then pure False
        else do
          eMode <- try (getConsoleMode h)
          case eMode of
            Left (_ :: IOError) -> Win32.isMinTTYHandle h
                                     -- Check if the we're in a MinTTY terminal
                                     -- (e.g., Cygwin or MSYS2)
            Right mode
              | modeHasVTP mode -> pure True
              | otherwise       -> enableVTP h mode

      where

        enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool
        enableVTP h mode = do
            setConsoleMode h (modeAddVTP mode)
            modeHasVTP <$> getConsoleMode h
          `catch` \ (_ :: IOError) ->
            pure False

        modeHasVTP :: Win32.DWORD -> Bool
        modeHasVTP mode = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0

        modeAddVTP :: Win32.DWORD -> Win32.DWORD
        modeAddVTP mode = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING

    eNABLE_VIRTUAL_TERMINAL_PROCESSING :: Win32.DWORD
    eNABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004

    getConsoleMode :: Win32.HANDLE -> IO Win32.DWORD
    getConsoleMode h = with 64 $ \ mode -> do
      Win32.failIfFalse_ "GetConsoleMode" (c_GetConsoleMode h mode)
      peek mode

    setConsoleMode :: Win32.HANDLE -> Win32.DWORD -> IO ()
    setConsoleMode h mode = do
      Win32.failIfFalse_ "SetConsoleMode" (c_SetConsoleMode h mode)

    foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode
      :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL

    foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode
      :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL

    #else
       pure False
    #endif