[commit: ghc] wip/nfs-locking: Drops dot, adds none; renames pony to unicorn (da96a23)

[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/da96a236f4678b2e64535bfe7a57928275d5aca1/ghc

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

commit da96a236f4678b2e64535bfe7a57928275d5aca1
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Fri Jan 15 15:22:17 2016 +0800

    Drops dot, adds none; renames pony to unicorn


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

da96a236f4678b2e64535bfe7a57928275d5aca1
 shaking-up-ghc.cabal              |  2 --
 src/Base.hs                       | 23 ++++++++++-------------
 src/Main.hs                       | 27 ---------------------------
 src/Oracles/Config/CmdLineFlag.hs | 14 +++++++-------
 4 files changed, 17 insertions(+), 49 deletions(-)

diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal
index 123870d..b38feac 100644
--- a/shaking-up-ghc.cabal
+++ b/shaking-up-ghc.cabal
@@ -116,7 +116,6 @@ executable ghc-shake
                        , ScopedTypeVariables
     build-depends:       base
                        , ansi-terminal >= 0.6
-                       , bytestring >= 0.10.6
                        , Cabal >= 1.22
                        , containers >= 0.5
                        , directory >= 1.2
@@ -126,6 +125,5 @@ 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/Base.hs b/src/Base.hs
index b9c7f72..07b21e4 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -115,16 +115,11 @@ a -/- b = unifyPath $ a </> b
 
 infixr 6 -/-
 
--- | A wrapper around shakes @putNormal@ that substitutes
--- any message for a fullstop if @buildInfo@ is @Dot at .
-putNormal' :: String -> Action ()
-putNormal' = if buildInfo == Dot then putNormal . const "." else putNormal
-
 -- | A more colourful version of Shake's putNormal
 putColoured :: Color -> String -> Action ()
 putColoured colour msg = do
     liftIO $ setSGR [SetColor Foreground Vivid colour]
-    putNormal' msg
+    putNormal msg
     liftIO $ setSGR []
     liftIO $ hFlush stdout
 
@@ -134,7 +129,9 @@ putOracle = putColoured Blue
 
 -- | Make build output more distinguishable
 putBuild :: String -> Action ()
-putBuild = putColoured White
+putBuild = if buildInfo /= None
+    then putColoured White
+    else const (pure ())
 
 -- | A more colourful version of success message
 putSuccess :: String -> Action ()
@@ -149,14 +146,14 @@ putError msg = do
 -- | Render an action.
 renderAction :: String -> String -> String -> String
 renderAction what input output = case buildInfo of
-    Normal -> renderBox [ what
-                        , "     input:" ++ input
-                        , " => output:" ++ output ]
-    Brief  -> "> " ++ what ++ ": " ++ input ++ " => " ++ output
-    Pony   -> renderPony [ what
+    Normal  -> renderBox [ what
                          , "     input:" ++ input
                          , " => output:" ++ output ]
-    Dot    -> "."
+    Brief   -> "> " ++ what ++ ": " ++ input ++ " => " ++ output
+    Unicorn -> renderPony [ what
+                          , "     input:" ++ input
+                          , " => output:" ++ output ]
+    None    -> ""
 
 -- | Render the successful build of a program
 renderProgram :: String -> String -> String -> String
diff --git a/src/Main.hs b/src/Main.hs
index 14f3554..e9d1e56 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,10 +14,6 @@ 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
@@ -41,27 +37,4 @@ main = shakeArgsWith options flags $ \cmdLineFlags targets -> do
         { shakeFiles    = Base.shakeFilesPath
         , shakeProgress = progressSimple
         , shakeTimings  = True
-        , shakeOutput   = const putMsg
         }
-
--- | Dynamic switch for @putStr@ and @putStrLn@ depending on the @msg at .
-putMsg :: String -> IO ()
-putMsg msg | dropEscSequence msg == "." = BS.putStr . UTF8.fromString $ msg
-putMsg msg                              = BS.putStrLn . UTF8.fromString $ msg
-
--- | Drops ANSI Escape sequences from a string.
-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
diff --git a/src/Oracles/Config/CmdLineFlag.hs b/src/Oracles/Config/CmdLineFlag.hs
index 47dbbbc..4b97c72 100644
--- a/src/Oracles/Config/CmdLineFlag.hs
+++ b/src/Oracles/Config/CmdLineFlag.hs
@@ -8,7 +8,7 @@ import Data.IORef
 
 -- Flags
 
-data BuildInfoFlag = Normal | Brief | Pony | Dot deriving (Eq, Show)
+data BuildInfoFlag = None | Brief | Normal | Unicorn deriving (Eq, Show)
 
 data CmdLineOptions = CmdLineOptions {
     flagBuildInfo :: BuildInfoFlag
@@ -25,16 +25,16 @@ readBuildInfoFlag ms =
         (go =<< fmap (map toLower) ms)
   where
     go :: String -> Maybe BuildInfoFlag
-    go "normal" = Just Normal
-    go "brief"  = Just Brief
-    go "pony"   = Just Pony
-    go "dot"    = Just Dot
-    go _        = Nothing -- Left "no parse"
+    go "none"    = Just None
+    go "brief"   = Just Brief
+    go "normal"  = Just Normal
+    go "unicorn" = Just Unicorn
+    go _         = Nothing -- Left "no parse"
     mkClosure :: BuildInfoFlag -> CmdLineOptions -> CmdLineOptions
     mkClosure flag opts = opts { flagBuildInfo = flag }
 
 flags :: [OptDescr (Either String (CmdLineOptions -> CmdLineOptions))]
-flags = [Option [] ["build-info"] (OptArg readBuildInfoFlag "") "Build Info Style (Normal, Brief, Pony, Dot, or None)"]
+flags = [Option [] ["progress-info"] (OptArg readBuildInfoFlag "") "Build Info Style (None, Brief, Normal, or Unicorn)"]
 
 -- IO -- We use IO here instead of Oracles, as Oracles form part of shakes cache
 -- hence, changing command line arguments, would cause a full rebuild.  And we