[commit: ghc] wip/nfs-locking: Add putColoured. (63d4481)

[git at git.haskell.org]

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

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

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

commit 63d4481898a503c5532e39f3b18a60c3518cad57
Author: Andrey Mokhov <andrey.mokhov at ncl.ac.uk>
Date:   Thu Jan 15 18:42:54 2015 +0000

    Add putColoured.


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

63d4481898a503c5532e39f3b18a60c3518cad57
 src/Oracles/Builder.hs |  9 ++++++---
 src/Util.hs            | 13 ++++++++++++-
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/src/Oracles/Builder.hs b/src/Oracles/Builder.hs
index b1aca5d..88f9649 100644
--- a/src/Oracles/Builder.hs
+++ b/src/Oracles/Builder.hs
@@ -7,6 +7,7 @@ module Oracles.Builder (
 
 import Data.Char
 import Base
+import Util
 import Oracles.Base
 import Oracles.Flag
 import Oracles.Option
@@ -108,9 +109,11 @@ run builder as = do
 terseRun :: ShowArgs a => Builder -> a -> Action ()
 terseRun builder as = do
     args <- showArgs as
-    putNormal $ "/--------\n| Running " ++ show builder ++ " with arguments:"
-    mapM_ (putNormal . ("|   " ++)) $ interestingInfo builder args
-    putNormal "\\--------"
+    putColoured Vivid White $ "/--------\n" ++
+        "| Running " ++ show builder ++ " with arguments:"
+    mapM_ (putColoured Vivid White . ("|   " ++)) $
+        interestingInfo builder args
+    putColoured Vivid White $ "\\--------"
     quietly $ run builder as
 
 interestingInfo :: Builder -> [String] -> [String]
diff --git a/src/Util.hs b/src/Util.hs
index b1ff9e5..e0524df 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -1,11 +1,15 @@
 module Util (
     module Data.Char,
+    module System.Console.ANSI,
     replaceIf, replaceEq, replaceSeparators,
-    chunksOfSize
+    chunksOfSize,
+    putColoured
     ) where
 
 import Base
 import Data.Char
+import System.Console.ANSI
+import System.IO
 
 replaceIf :: (a -> Bool) -> a -> [a] -> [a]
 replaceIf p to = map (\from -> if p from then to else from)
@@ -30,3 +34,10 @@ chunksOfSize size ss = reverse chunk : chunksOfSize size rest
                                 if newSize > size
                                 then (chunk   , s:ss)
                                 else (newChunk, rest)
+
+putColoured :: ColorIntensity -> Color -> String -> Action ()
+putColoured intensity colour msg = do
+    liftIO $ setSGR [SetColor Foreground intensity colour]
+    putNormal msg
+    liftIO $ setSGR []
+    liftIO $ hFlush stdout