Check if the output supports colors (fixes #244)
authorMichal Terepeta <michal.terepeta@gmail.com>
Sun, 15 May 2016 15:31:30 +0000 (17:31 +0200)
committerMichal Terepeta <michal.terepeta@gmail.com>
Mon, 16 May 2016 11:19:34 +0000 (13:19 +0200)
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@gmail.com>
build.cabal-new.sh
build.cabal.sh
build.sh
build.stack.sh
src/Base.hs

index bca8c7c..65e222a 100755 (executable)
@@ -55,5 +55,4 @@ popd
 "$root/.shake/build"       \
     --lint                 \
     --directory "$root/.." \
-    --colour               \
     "$@"
index f2e320e..08ff972 100755 (executable)
@@ -43,5 +43,4 @@ fi
 cabal run hadrian --               \
     --lint                         \
     --directory "$absoluteRoot/.." \
-    --colour                       \
     "$@"
index fff8df4..24fdc2f 100755 (executable)
--- a/build.sh
+++ b/build.sh
@@ -49,5 +49,4 @@ ghc                                      \
 "$root/hadrian"            \
     --lint                 \
     --directory "$root/.." \
-    --colour               \
     "$@"
index b5607b1..23f4833 100755 (executable)
@@ -36,5 +36,4 @@ stack build --no-library-profiling
 stack exec hadrian --              \
     --lint                         \
     --directory "$absoluteRoot/.." \
-    --colour                       \
     "$@"
index bd80f47..488be04 100644 (file)
@@ -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 ()