{-# 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