[commit: ghc] wip/nfs-locking: Check if the output supports colors (fixes #244) (0f7bc96)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:01:16 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/0f7bc96a2c8940181818594ffc71bf928ab8aed2/ghc

>---------------------------------------------------------------

commit 0f7bc96a2c8940181818594ffc71bf928ab8aed2
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Sun May 15 17:31:30 2016 +0200

    Check if the output supports colors (fixes #244)
    
    This avoids using colors when the output is, e.g., redirected to a
    file. This requried a change to avoid passing the `--colour` flag to
    shake (so that hadrian is in charge of colors).
    
    Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>


>---------------------------------------------------------------

0f7bc96a2c8940181818594ffc71bf928ab8aed2
 build.cabal-new.sh |  1 -
 build.cabal.sh     |  1 -
 build.sh           |  1 -
 build.stack.sh     |  1 -
 src/Base.hs        | 12 ++++++++++--
 5 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/build.cabal-new.sh b/build.cabal-new.sh
index bca8c7c..65e222a 100755
--- a/build.cabal-new.sh
+++ b/build.cabal-new.sh
@@ -55,5 +55,4 @@ popd
 "$root/.shake/build"       \
     --lint                 \
     --directory "$root/.." \
-    --colour               \
     "$@"
diff --git a/build.cabal.sh b/build.cabal.sh
index f2e320e..08ff972 100755
--- a/build.cabal.sh
+++ b/build.cabal.sh
@@ -43,5 +43,4 @@ fi
 cabal run hadrian --               \
     --lint                         \
     --directory "$absoluteRoot/.." \
-    --colour                       \
     "$@"
diff --git a/build.sh b/build.sh
index fff8df4..24fdc2f 100755
--- a/build.sh
+++ b/build.sh
@@ -49,5 +49,4 @@ ghc                                      \
 "$root/hadrian"            \
     --lint                 \
     --directory "$root/.." \
-    --colour               \
     "$@"
diff --git a/build.stack.sh b/build.stack.sh
index b5607b1..23f4833 100755
--- a/build.stack.sh
+++ b/build.stack.sh
@@ -36,5 +36,4 @@ stack build --no-library-profiling
 stack exec hadrian --              \
     --lint                         \
     --directory "$absoluteRoot/.." \
-    --colour                       \
     "$@"
diff --git a/src/Base.hs b/src/Base.hs
index bd80f47..488be04 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -38,6 +38,7 @@ import Development.Shake hiding (parallel, unit, (*>), Normal)
 import Development.Shake.Classes
 import Development.Shake.FilePath
 import System.Console.ANSI
+import qualified System.Info as Info
 import System.IO
 
 -- TODO: reexport Stage, etc.?
@@ -96,10 +97,17 @@ infixr 6 -/-
 -- | A more colourful version of Shake's putNormal
 putColoured :: Color -> String -> Action ()
 putColoured colour msg = do
-    liftIO $ setSGR [SetColor Foreground Vivid colour]
+    liftIO $ set [SetColor Foreground Vivid colour]
     putNormal msg
-    liftIO $ setSGR []
+    liftIO $ set []
     liftIO $ hFlush stdout
+  where
+    set a = do
+        supported <- hSupportsANSI stdout
+        when (win || supported) $ setSGR a
+    -- An ugly hack to always try to print colours when on mingw and cygwin.
+    -- See: https://github.com/snowleopard/hadrian/pull/253
+    win = "mingw" `isPrefixOf` Info.os || "cygwin" `isPrefixOf` Info.os
 
 -- | Make oracle output more distinguishable
 putOracle :: String -> Action ()



More information about the ghc-commits mailing list