[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 00:14:04 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