blob: 37f53772effe6a7192a6ee8a2a3a758b58e26b15 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where
import GHC.Prelude
import GHC.IO (catchException)
#if defined(MIN_VERSION_terminfo)
import Data.Maybe (fromMaybe)
import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
setupTermFromEnv, termColors)
import System.Posix (queryTerminal, stdError)
#elif defined(mingw32_HOST_OS)
import GHC.Utils.Exception (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 = unsafePerformIO stderrSupportsAnsiColors'
{-# NOINLINE stderrSupportsAnsiColors #-}
-- | Check if ANSI escape sequences can be used to control color in stderr.
stderrSupportsAnsiColors' :: IO Bool
stderrSupportsAnsiColors' = do
#if defined(MIN_VERSION_terminfo)
stderr_available <- queryTerminal stdError
if stderr_available then
fmap termSupportsColors setupTermFromEnv
`catchException` \ (_ :: SetupTermError) -> pure False
else
pure False
where
termSupportsColors :: Terminal -> Bool
termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0
#elif defined(mingw32_HOST_OS)
h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
`catchException` \ (_ :: 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
`catchException` \ (_ :: 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
|
