Fix broken colours with `-j` (#484)

* Fix colours

* Simplify data types

* Fix doc typo

README.md

@@ -43,7 +43,7 @@ on Cabal sandboxes (`build.cabal.*`), Stack (`build.stack.*`) or the global pack
 (`build.global-db.*`). Also see [instructions for building GHC on Windows using Stack][windows-build].
 
 * Hadrian is written in Haskell and depends on `shake` (plus a few packages that `shake` depends on),
-`ansi-terminal`, `mtl`, `quickcheck`, and GHC core libraries.
+`mtl`, `quickcheck`, and GHC core libraries.
 
 * If you have never built GHC before, start with the [preparation guide][ghc-preparation].
 

circle.yml

@@ -9,7 +9,7 @@ dependencies:
     - brew update
     - brew install ghc cabal-install python3
     - cabal update
-    - cabal install alex happy ansi-terminal mtl shake quickcheck
+    - cabal install alex happy mtl shake quickcheck
   cache_directories:
     - $HOME/.cabal
     - $HOME/.ghc

doc/user-settings.md

@@ -204,9 +204,20 @@ used by default by overriding `buildProgressColour` and `successColour`:
 ```haskell
 -- | Set colour for build progress messages (e.g. executing a build command).
 buildProgressColour :: BuildProgressColour
-buildProgressColour = BuildProgressColour (Dull, Magenta)
+buildProgressColour = mkBuildProgressColour (Dull Magenta)
 
 -- | Set colour for success messages (e.g. a package is built successfully).
 successColour :: SuccessColour
-successColour = SuccessColour (Dull, Green)
+successColour = mkSuccessColour (Dull Green)
+```
+
+Your options are `Dull Colour`, `Vivid Colour`, or `Extended Code`. `Dull`
+colours are the ANSI 8-bit colours, `Vivid` correspond to the 16-bit codes that
+end with ";1", and `Extended` let's you enter a manual code for the 256 colour
+set. E.g.
+
+```
+Dull Blue
+Vivid Cyan
+Extended "203"
 ```

hadrian.cabal

@@ -117,7 +117,6 @@ executable hadrian
     other-extensions:    MultiParamTypeClasses
                        , TypeFamilies
     build-depends:       base                 >= 4.8     && < 5
-                       , ansi-terminal        == 0.6.*
                        , Cabal                >= 2.0.0.2 && < 2.2
                        , containers           == 0.5.*
                        , directory            >= 1.2     && < 1.4

src/Hadrian/Utilities.hs

@@ -20,10 +20,12 @@ module Hadrian.Utilities (
     createDirectory, copyDirectory, moveDirectory, removeDirectory,
 
     -- * Diagnostic info
-    UseColour (..), putColoured, BuildProgressColour (..), putBuild,
-    SuccessColour (..), putSuccess, ProgressInfo (..),
-    putProgressInfo, renderAction, renderProgram, renderLibrary, renderBox,
-    renderUnicorn,
+    UseColour (..), Colour (..), ANSIColour (..), putColoured,
+    BuildProgressColour, mkBuildProgressColour, putBuild,
+    SuccessColour, mkSuccessColour, putSuccess,
+    ProgressInfo (..), putProgressInfo,
+    renderAction, renderProgram, renderLibrary, renderBox, renderUnicorn,
+
 
     -- * Miscellaneous
     (<&>), (%%>), cmdLineLengthLimit,
@@ -42,7 +44,7 @@ import Data.Typeable (TypeRep, typeOf)
 import Development.Shake hiding (Normal)
 import Development.Shake.Classes
 import Development.Shake.FilePath
-import System.Console.ANSI
+import System.Environment (lookupEnv)
 import System.Info.Extra
 
 import qualified Control.Exception.Base as IO
@@ -264,43 +266,90 @@ removeDirectory dir = do
 
 data UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)
 
+-- | Terminal output colours
+data Colour
+    = Dull ANSIColour   -- ^ 8-bit ANSI colours
+    | Vivid ANSIColour  -- ^ 16-bit vivid ANSI colours
+    | Extended String   -- ^ Extended 256-bit colours, manual code stored
+
+-- | ANSI terminal colours
+data ANSIColour
+    = Black     -- ^ ANSI code: 30
+    | Red       -- ^ 31
+    | Green     -- ^ 32
+    | Yellow    -- ^ 33
+    | Blue      -- ^ 34
+    | Magenta   -- ^ 35
+    | Cyan      -- ^ 36
+    | White     -- ^ 37
+    | Reset     -- ^ 0
+
+-- | Convert ANSI colour names into their associated codes
+colourCode :: ANSIColour -> String
+colourCode Black = "30"
+colourCode Red = "31"
+colourCode Green = "32"
+colourCode Yellow = "33"
+colourCode Blue = "34"
+colourCode Magenta = "35"
+colourCode Cyan = "36"
+colourCode White = "37"
+colourCode Reset = "0"
+
+-- | Create the final ANSI code.
+mkColour :: Colour -> String
+mkColour (Dull c) = colourCode c
+mkColour (Vivid c) = colourCode c ++ ";1"
+mkColour (Extended code) = "38;5;" ++ code
+
 -- | A more colourful version of Shake's 'putNormal'.
-putColoured :: ColorIntensity -> Color -> String -> Action ()
-putColoured intensity colour msg = do
+putColoured :: String -> String -> Action ()
+putColoured code msg = do
     useColour <- userSetting Never
-    supported <- liftIO $ hSupportsANSI IO.stdout
+    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
-    when (c useColour) . liftIO $ setSGR [SetColor Foreground intensity colour]
-    putNormal msg
-    when (c useColour) . liftIO $ setSGR [] >> IO.hFlush IO.stdout
+    if c useColour
+        then putNormal $ "\ESC[" ++ code ++ "m" ++ msg ++ "\ESC[0m"
+        else putNormal msg
+  where
+    isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"
 
-newtype BuildProgressColour = BuildProgressColour (ColorIntensity, Color)
+newtype BuildProgressColour = BuildProgressColour String
     deriving Typeable
 
+-- | Generate an encoded colour for progress output from names.
+mkBuildProgressColour :: Colour -> BuildProgressColour
+mkBuildProgressColour c = BuildProgressColour $ mkColour c
+
 -- | Default 'BuildProgressColour'.
 magenta :: BuildProgressColour
-magenta = BuildProgressColour (Dull, Magenta)
+magenta = mkBuildProgressColour (Dull Magenta)
 
 -- | Print a build progress message (e.g. executing a build command).
 putBuild :: String -> Action ()
 putBuild msg = do
-    BuildProgressColour (intensity, colour) <- userSetting magenta
-    putColoured intensity colour msg
+    BuildProgressColour code <- userSetting magenta
+    putColoured code msg
 
-newtype SuccessColour = SuccessColour (ColorIntensity, Color)
+newtype SuccessColour = SuccessColour String
     deriving Typeable
 
+-- | Generate an encoded colour for successful output from names
+mkSuccessColour :: Colour -> SuccessColour
+mkSuccessColour c = SuccessColour $ mkColour c
+
 -- | Default 'SuccessColour'.
 green :: SuccessColour
-green = SuccessColour (Dull, Green)
+green = mkSuccessColour (Dull Green)
 
 -- | Print a success message (e.g. a package is built successfully).
 putSuccess :: String -> Action ()
 putSuccess msg = do
-    SuccessColour (intensity, colour) <- userSetting green
-    putColoured intensity colour msg
+    SuccessColour code <- userSetting green
+    putColoured code msg
 
 data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show, Typeable)
 

src/UserSettings.hs

@@ -8,7 +8,6 @@ module UserSettings (
     ) where
 
 import Hadrian.Utilities
-import System.Console.ANSI
 
 import Flavour
 import Expression
@@ -46,11 +45,11 @@ verboseCommand = do
 
 -- | Set colour for build progress messages (e.g. executing a build command).
 buildProgressColour :: BuildProgressColour
-buildProgressColour = BuildProgressColour (Dull, Magenta)
+buildProgressColour = mkBuildProgressColour (Dull Magenta)
 
 -- | Set colour for success messages (e.g. a package is built successfully).
 successColour :: SuccessColour
-successColour = SuccessColour (Dull, Green)
+successColour = mkSuccessColour (Dull Green)
 
 -- TODO: Set this flag from the command line.
 -- | Set this flag to 'True' to disable building Stage2 GHC (i.e. the @ghc-stage2@