never executed always true always false

    1 {-# LANGUAGE CPP #-}
    2 {-# LANGUAGE ScopedTypeVariables #-}
    3 module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where
    4 
    5 import GHC.Prelude
    6 
    7 #if defined(MIN_VERSION_terminfo)
    8 import GHC.IO (catchException)
    9 import Data.Maybe (fromMaybe)
   10 import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
   11                                 setupTermFromEnv, termColors)
   12 import System.Posix (queryTerminal, stdError)
   13 #elif defined(mingw32_HOST_OS)
   14 import GHC.IO (catchException)
   15 import GHC.Utils.Exception (try)
   16 -- import Data.Bits ((.|.), (.&.))
   17 import Foreign (Ptr, peek, with)
   18 import qualified Graphics.Win32 as Win32
   19 import qualified System.Win32 as Win32
   20 #endif
   21 
   22 import System.IO.Unsafe
   23 
   24 #if defined(mingw32_HOST_OS) && !defined(WINAPI)
   25 # if defined(i386_HOST_ARCH)
   26 #  define WINAPI stdcall
   27 # elif defined(x86_64_HOST_ARCH)
   28 #  define WINAPI ccall
   29 # else
   30 #  error unknown architecture
   31 # endif
   32 #endif
   33 
   34 -- | Does the controlling terminal support ANSI color sequences?
   35 -- This memoized to avoid thread-safety issues in ncurses (see #17922).
   36 stderrSupportsAnsiColors :: Bool
   37 stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors'
   38 {-# NOINLINE stderrSupportsAnsiColors #-}
   39 
   40 -- | Check if ANSI escape sequences can be used to control color in stderr.
   41 stderrSupportsAnsiColors' :: IO Bool
   42 stderrSupportsAnsiColors' = do
   43 #if defined(MIN_VERSION_terminfo)
   44     stderr_available <- queryTerminal stdError
   45     if stderr_available then
   46       fmap termSupportsColors setupTermFromEnv
   47         `catchException` \ (_ :: SetupTermError) -> pure False
   48     else
   49       pure False
   50   where
   51     termSupportsColors :: Terminal -> Bool
   52     termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0
   53 
   54 #elif defined(mingw32_HOST_OS)
   55   h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
   56          `catchException` \ (_ :: IOError) ->
   57            pure Win32.nullHANDLE
   58   if h == Win32.nullHANDLE
   59     then pure False
   60     else do
   61       eMode <- try (getConsoleMode h)
   62       case eMode of
   63         Left (_ :: IOError) -> Win32.isMinTTYHandle h
   64                                  -- Check if the we're in a MinTTY terminal
   65                                  -- (e.g., Cygwin or MSYS2)
   66         Right mode
   67           | modeHasVTP mode -> pure True
   68           | otherwise       -> enableVTP h mode
   69 
   70   where
   71 
   72     enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool
   73     enableVTP h mode = do
   74         setConsoleMode h (modeAddVTP mode)
   75         modeHasVTP <$> getConsoleMode h
   76       `catchException` \ (_ :: IOError) ->
   77         pure False
   78 
   79     modeHasVTP :: Win32.DWORD -> Bool
   80     modeHasVTP mode = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0
   81 
   82     modeAddVTP :: Win32.DWORD -> Win32.DWORD
   83     modeAddVTP mode = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING
   84 
   85 eNABLE_VIRTUAL_TERMINAL_PROCESSING :: Win32.DWORD
   86 eNABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004
   87 
   88 getConsoleMode :: Win32.HANDLE -> IO Win32.DWORD
   89 getConsoleMode h = with 64 $ \ mode -> do
   90   Win32.failIfFalse_ "GetConsoleMode" (c_GetConsoleMode h mode)
   91   peek mode
   92 
   93 setConsoleMode :: Win32.HANDLE -> Win32.DWORD -> IO ()
   94 setConsoleMode h mode = do
   95   Win32.failIfFalse_ "SetConsoleMode" (c_SetConsoleMode h mode)
   96 
   97 foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode
   98   :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL
   99 
  100 foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode
  101   :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL
  102 
  103 #else
  104    pure False
  105 #endif