diff --git a/hadrian/README.md b/hadrian/README.md
index f3dcdfde0e16163e079720d13bc69c5690419122..113aa9ebe1ec298028bda386974289c59f878001 100644
--- a/hadrian/README.md
+++ b/hadrian/README.md
@@ -104,10 +104,9 @@ simply drop the `--freeze1` flag and Hadrian will rebuild all out-of-date files.
* `--integer-simple`: build GHC using the `integer-simple` integer library
(instead of `integer-gmp`).
-* `--progress-colour=MODE`: choose whether to use colours when printing build
-progress info. There are three settings: `never` (do not use colours), `auto`
-(attempt to detect whether the console supports colours; this is the default
-setting), and `always` (use colours).
+* `--color` and `--no-color`: choose whether to use colors when printing build
+progress info. By default, Hadrian tries to determine if the terminal supports
+colored ouput, and proceeds accordingly.
* `--progress-info=STYLE`: choose how build progress info is printed. There are
four settings: `none`, `brief` (one line per build command; this is the default
diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index aad616f40a9b98a9c721cbe9200dcbfab1812bba..a62062130b3f908be156a103563a6d86bd26b017 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -1,6 +1,6 @@
module CommandLine (
optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
- cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdCompleteSetting,
+ cmdProgressInfo, cmdConfigure, cmdCompleteSetting,
cmdDocsArgs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs
) where
@@ -25,7 +25,6 @@ data CommandLineArgs = CommandLineArgs
, flavour :: Maybe String
, freeze1 :: Bool
, integerSimple :: Bool
- , progressColour :: UseColour
, progressInfo :: ProgressInfo
, buildRoot :: BuildRoot
, testArgs :: TestArgs
@@ -40,7 +39,6 @@ defaultCommandLineArgs = CommandLineArgs
, flavour = Nothing
, freeze1 = False
, integerSimple = False
- , progressColour = Auto
, progressInfo = Brief
, buildRoot = BuildRoot "_build"
, testArgs = defaultTestArgs
@@ -104,18 +102,6 @@ readFreeze1 = Right $ \flags -> flags { freeze1 = True }
readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
-readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readProgressColour ms =
- maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
- where
- go :: String -> Maybe UseColour
- go "never" = Just Never
- go "auto" = Just Auto
- go "always" = Just Always
- go _ = Nothing
- set :: UseColour -> CommandLineArgs -> CommandLineArgs
- set flag flags = flags { progressColour = flag }
-
readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readProgressInfo ms =
maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
@@ -238,8 +224,6 @@ optDescrs =
"Freeze Stage1 GHC."
, Option [] ["integer-simple"] (NoArg readIntegerSimple)
"Build GHC with integer-simple library."
- , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
- "Use colours in progress info (Never, Auto or Always)."
, Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal or Unicorn)."
, Option [] ["docs"] (OptArg readDocsArg "TARGET")
@@ -307,8 +291,7 @@ cmdLineArgsMap = do
else return []
let allSettings = cliSettings ++ fileSettings
- return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
- $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
+ return $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
$ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities
$ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest
$ insertExtra allSettings -- Accessed by Settings
@@ -335,9 +318,6 @@ lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
cmdIntegerSimple :: Action Bool
cmdIntegerSimple = integerSimple <$> cmdLineArgs
-cmdProgressColour :: Action UseColour
-cmdProgressColour = progressColour <$> cmdLineArgs
-
cmdProgressInfo :: Action ProgressInfo
cmdProgressInfo = progressInfo <$> cmdLineArgs
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 4a4061157b5ff91b9749fdc29f9c6077c0ebacd5..521d2bc946565a278490d3b78095dd646eb69188 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -21,7 +21,7 @@ module Hadrian.Utilities (
moveDirectory, removeDirectory,
-- * Diagnostic info
- UseColour (..), Colour (..), ANSIColour (..), putColoured,
+ Colour (..), ANSIColour (..), putColoured, shouldUseColor,
BuildProgressColour, mkBuildProgressColour, putBuild,
SuccessColour, mkSuccessColour, putSuccess,
ProgressInfo (..), putProgressInfo,
@@ -390,8 +390,6 @@ removeDirectory dir = do
putProgressInfo $ "| Remove directory " ++ dir
liftIO . whenM (IO.doesDirectoryExist dir) $ IO.removeDirectoryRecursive dir
-data UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)
-
-- | Terminal output colours
data Colour
= Dull ANSIColour -- ^ 8-bit ANSI colours
@@ -431,21 +429,24 @@ mkColour (Extended code) = "38;5;" ++ code
-- | A more colourful version of Shake's 'putNormal'.
putColoured :: String -> String -> Action ()
putColoured code msg = do
- useColour <- userSetting Never
- supported <- liftIO $ (&&) <$> IO.hIsTerminalDevice IO.stdout
- <*> (not <$> isDumb)
- let c Never = False
- c Auto = supported || IO.isWindows -- Colours do work on Windows
- c Always = True
- if c useColour
+ useColour <- shakeColor <$> getShakeOptions
+ if useColour
then putNormal $ "\ESC[" ++ code ++ "m" ++ msg ++ "\ESC[0m"
else putNormal msg
- where
- isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"
newtype BuildProgressColour = BuildProgressColour String
deriving Typeable
+-- | By default, Hadrian tries to figure out if the current terminal
+-- supports colors using this function. The default can be overriden
+-- by suppling @--[no-]color@.
+shouldUseColor :: IO Bool
+shouldUseColor =
+ (&&) <$> IO.hIsTerminalDevice IO.stdout
+ <*> (not <$> isDumb)
+ where
+ isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"
+
-- | Generate an encoded colour for progress output from names.
mkBuildProgressColour :: Colour -> BuildProgressColour
mkBuildProgressColour c = BuildProgressColour $ mkColour c
diff --git a/hadrian/src/Main.hs b/hadrian/src/Main.hs
index 804144aeb1efb19b76496d235cf53851fae3d525..36920473177b8b3ad54317f268118702777525ac 100644
--- a/hadrian/src/Main.hs
+++ b/hadrian/src/Main.hs
@@ -33,6 +33,7 @@ main = do
| CommandLine.lookupFreeze1 argsMap ]
cwd <- getCurrentDirectory
+ shakeColor <- shouldUseColor
let options :: ShakeOptions
options = shakeOptions
{ shakeChange = ChangeModtimeAndDigest
@@ -40,6 +41,7 @@ main = do
, shakeProgress = progressSimple
, shakeRebuild = rebuild
, shakeTimings = True
+ , shakeColor = shakeColor
, shakeExtra = extra
-- Setting shakeSymlink to False ensures files are copied out of