diff options
-rw-r--r-- | compiler/GHC/SysTools/Terminal.hs | 7 | ||||
-rw-r--r-- | utils/ghc-pkg/Main.hs | 6 |
2 files changed, 9 insertions, 4 deletions
diff --git a/compiler/GHC/SysTools/Terminal.hs b/compiler/GHC/SysTools/Terminal.hs index 5e20db8739..a3f60e2436 100644 --- a/compiler/GHC/SysTools/Terminal.hs +++ b/compiler/GHC/SysTools/Terminal.hs @@ -5,6 +5,7 @@ module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GHC.Prelude #if !defined(mingw32_HOST_OS) +import System.Environment (lookupEnv) import System.IO (hIsTerminalDevice, stderr) #else import GHC.IO (catchException) @@ -36,8 +37,10 @@ stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' stderrSupportsAnsiColors' :: IO Bool stderrSupportsAnsiColors' = do #if !defined(mingw32_HOST_OS) - -- Coloured text is a part of ANSI standard, no reason to query terminfo - hIsTerminalDevice stderr + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + isTerminal <- hIsTerminalDevice stderr + term <- lookupEnv "TERM" + pure $ isTerminal && term /= Just "dumb" #else h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE `catchException` \ (_ :: IOError) -> diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 5fb6a85bce..8746b0296e 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -86,6 +86,7 @@ import qualified Data.ByteString as BS #if defined(mingw32_HOST_OS) import GHC.ConsoleHandler #else +import System.Environment (lookupEnv) import System.Posix hiding (fdToHandle) #endif @@ -1591,8 +1592,9 @@ listPackages verbosity my_flags mPackageName mModuleName = do pkg = display (mungedId p) is_tty <- hIsTerminalDevice stdout - -- Coloured text is a part of ANSI standard, no reason to query terminfo - mapM_ (if is_tty then show_colour else show_normal) stack + -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI + term <- lookupEnv "TERM" + mapM_ (if is_tty && term /= Just "dumb" then show_colour else show_normal) stack #endif simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () |