summaryrefslogtreecommitdiff
path: root/compiler/main/SysTools/Terminal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/main/SysTools/Terminal.hs')
-rw-r--r--compiler/main/SysTools/Terminal.hs72
1 files changed, 11 insertions, 61 deletions
diff --git a/compiler/main/SysTools/Terminal.hs b/compiler/main/SysTools/Terminal.hs
index b7f343a3a5..349f5c162c 100644
--- a/compiler/main/SysTools/Terminal.hs
+++ b/compiler/main/SysTools/Terminal.hs
@@ -4,27 +4,24 @@ module SysTools.Terminal (stderrSupportsAnsiColors) where
import GhcPrelude
-#if defined MIN_VERSION_terminfo
+#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
+#elif defined(mingw32_HOST_OS)
import Control.Exception (catch, try)
import Data.Bits ((.|.), (.&.))
-import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
-import Foreign (FunPtr, Ptr, allocaBytes, castPtrToFunPtr,
- peek, plusPtr, sizeOf, with)
-import Foreign.C (CInt(..), CWchar, peekCWStringLen)
+import Foreign (Ptr, peek, with)
import qualified Graphics.Win32 as Win32
import qualified System.Win32 as Win32
#endif
-#if defined mingw32_HOST_OS && !defined WINAPI
-# if defined i386_HOST_ARCH
+#if defined(mingw32_HOST_OS) && !defined(WINAPI)
+# if defined(i386_HOST_ARCH)
# define WINAPI stdcall
-# elif defined x86_64_HOST_ARCH
+# elif defined(x86_64_HOST_ARCH)
# define WINAPI ccall
# else
# error unknown architecture
@@ -34,7 +31,7 @@ import qualified System.Win32 as Win32
-- | Check if ANSI escape sequences can be used to control color in stderr.
stderrSupportsAnsiColors :: IO Bool
stderrSupportsAnsiColors = do
-#if defined MIN_VERSION_terminfo
+#if defined(MIN_VERSION_terminfo)
queryTerminal stdError `andM` do
(termSupportsColors <$> setupTermFromEnv)
`catch` \ (_ :: SetupTermError) ->
@@ -52,7 +49,7 @@ stderrSupportsAnsiColors = do
termSupportsColors :: Terminal -> Bool
termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0
-#elif defined mingw32_HOST_OS
+#elif defined(mingw32_HOST_OS)
h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
`catch` \ (_ :: IOError) ->
pure Win32.nullHANDLE
@@ -61,26 +58,15 @@ stderrSupportsAnsiColors = do
else do
eMode <- try (getConsoleMode h)
case eMode of
- Left (_ :: IOError) -> queryCygwinTerminal h
+ 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
- queryCygwinTerminal :: Win32.HANDLE -> IO Bool
- queryCygwinTerminal h = do
- fileType <- Win32.getFileType h
- if fileType /= Win32.fILE_TYPE_PIPE
- then pure False
- else do
- fn <- getFileNameByHandle h
- pure (("\\cygwin-" `isPrefixOf` fn || "\\msys-" `isPrefixOf` fn) &&
- "-pty" `isInfixOf` fn &&
- "-master" `isSuffixOf` fn)
- `catch` \ (_ :: IOError) ->
- pure False
-
enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool
enableVTP h mode = do
setConsoleMode h (modeAddVTP mode)
@@ -112,42 +98,6 @@ foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode
foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode
:: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL
-fileNameInfo :: CInt
-fileNameInfo = 2
-
-mAX_PATH :: Num a => a
-mAX_PATH = 260
-
-getFileNameByHandle :: Win32.HANDLE -> IO String
-getFileNameByHandle h = do
- let sizeOfDWORD = sizeOf (undefined :: Win32.DWORD)
- let sizeOfWchar = sizeOf (undefined :: CWchar)
- -- note: implicitly assuming that DWORD has stronger alignment than wchar_t
- let bufSize = sizeOfDWORD + mAX_PATH * sizeOfWchar
- allocaBytes bufSize $ \ buf -> do
- getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize)
- len :: Win32.DWORD <- peek buf
- let len' = fromIntegral len `div` sizeOfWchar
- peekCWStringLen (buf `plusPtr` sizeOfDWORD, min len' mAX_PATH)
-
-getFileInformationByHandleEx
- :: Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO ()
-getFileInformationByHandleEx h cls buf bufSize = do
- lib <- Win32.getModuleHandle (Just "kernel32.dll")
- ptr <- Win32.getProcAddress lib "GetFileInformationByHandleEx"
- let c_GetFileInformationByHandleEx =
- mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr)
- Win32.failIfFalse_ "getFileInformationByHandleEx"
- (c_GetFileInformationByHandleEx h cls buf bufSize)
-
-type F_GetFileInformationByHandleEx a =
- Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO Win32.BOOL
-
-foreign import WINAPI "dynamic"
- mk_GetFileInformationByHandleEx
- :: FunPtr (F_GetFileInformationByHandleEx a)
- -> F_GetFileInformationByHandleEx a
-
#else
pure False
#endif