Fix colors in emacs terminal

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 ()