[commit: ghc] wip/nfs-locking: Proper support for `dot` (46bf4bc)

[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/46bf4bcb391b6008d39aa2c334ec265141fd6a80/ghc

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

commit 46bf4bcb391b6008d39aa2c334ec265141fd6a80
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Thu Jan 14 14:03:05 2016 +0800

    Proper support for `dot`
    
    Adds support for `dot`, by conditionally switching between `BS.putStr`
    and `BS.putStrLn` depending on the msg.
    
    The additional imports are part of shake anyway.
    
    Fixes #134, dot support for good :)


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

46bf4bcb391b6008d39aa2c334ec265141fd6a80
 shaking-up-ghc.cabal |  2 ++
 src/Main.hs          | 29 ++++++++++++++++++++++++++++-
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal
index b38feac..123870d 100644
--- a/shaking-up-ghc.cabal
+++ b/shaking-up-ghc.cabal
@@ -116,6 +116,7 @@ executable ghc-shake
                        , ScopedTypeVariables
     build-depends:       base
                        , ansi-terminal >= 0.6
+                       , bytestring >= 0.10.6
                        , Cabal >= 1.22
                        , containers >= 0.5
                        , directory >= 1.2
@@ -125,5 +126,6 @@ executable ghc-shake
                        , shake >= 0.15
                        , transformers >= 0.4
                        , unordered-containers >= 0.2
+                       , utf8-string >= 1.0.1
     default-language:    Haskell2010
     ghc-options:         -Wall -fno-warn-name-shadowing -rtsopts -with-rtsopts=-I0 -j
diff --git a/src/Main.hs b/src/Main.hs
index e3f1a34..6ec93429 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,6 +14,10 @@ import qualified Rules.Perl
 import qualified Test
 import Oracles.Config.CmdLineFlag (putOptions, flags)
 
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.UTF8 as UTF8
+import Data.Char (chr)
+
 main :: IO ()
 main = shakeArgsWith options flags $ \cmdLineFlags targets -> do
     putOptions cmdLineFlags
@@ -36,4 +40,27 @@ main = shakeArgsWith options flags $ \cmdLineFlags targets -> do
     options = shakeOptions
         { shakeFiles    = Base.shakeFilesPath
         , shakeProgress = progressSimple
-        , shakeTimings  = True }
+        , shakeTimings  = True
+        , shakeOutput   = const showMsg
+        }
+
+showMsg :: String -> IO ()
+showMsg msg | dropEscSequence msg == "." = BS.putStr . UTF8.fromString $ msg
+showMsg msg | dropEscSequence msg == ""  = return ()
+showMsg msg                              = BS.putStrLn . UTF8.fromString $ msg
+
+dropEscSequence :: String -> String
+dropEscSequence = go
+  where
+    esc :: Char
+    esc = Data.Char.chr 27
+    go :: String -> String
+    go []     = []
+    go [x]    = [x]
+    go (x:xs) | x == esc  = skip xs
+    go (x:xs) | otherwise = x:go xs
+    skip :: String -> String
+    skip []    = []
+    skip ['m'] = []
+    skip ('m':xs) = go xs
+    skip (_  :xs) = skip xs