Suppress marking when we lessVerbose.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Cabal/Distribution/Simple/Utils.hs

@@ -333,7 +333,7 @@ dieWithLocation' :: Verbosity -> FilePath -> Maybe Int -> String -> IO a
 dieWithLocation' verbosity filename mb_lineno msg = withFrozenCallStack $ do
     pname <- getProgName
     ioError . verbatimUserError
-            . withMetadata True verbosity
+            . withMetadata AlwaysMark verbosity
             . wrapTextVerbosity verbosity
             $ pname ++ ": " ++
               filename ++ (case mb_lineno of
@@ -345,15 +345,15 @@ die' :: Verbosity -> String -> IO a
 die' verbosity msg = withFrozenCallStack $ do
     pname <- getProgName
     ioError . verbatimUserError
-            . withMetadata True verbosity
+            . withMetadata AlwaysMark verbosity
             . wrapTextVerbosity verbosity
             $ pname ++ ": " ++ msg
 
 dieNoWrap :: Verbosity -> String -> IO a
 dieNoWrap verbosity msg = withFrozenCallStack $ do
     -- TODO: should this have program name or not?
     ioError . verbatimUserError
-            . withMetadata True verbosity
+            . withMetadata AlwaysMark verbosity
             $ msg
 
 topHandlerWith :: forall a. (Exception.SomeException -> IO a) -> IO a -> IO a
@@ -416,7 +416,7 @@ warn :: Verbosity -> String -> IO ()
 warn verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
     hFlush stdout
-    hPutStr stderr . withMetadata True verbosity
+    hPutStr stderr . withMetadata NormalMark verbosity
                    . wrapTextVerbosity verbosity
                    $ "Warning: " ++ msg
 
@@ -430,7 +430,7 @@ warn verbosity msg = withFrozenCallStack $ do
 notice :: Verbosity -> String -> IO ()
 notice verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
-    hPutStr stdout . withMetadata True verbosity
+    hPutStr stdout . withMetadata NormalMark verbosity
                    . wrapTextVerbosity verbosity
                    $ msg
 
@@ -440,15 +440,15 @@ notice verbosity msg = withFrozenCallStack $ do
 noticeNoWrap :: Verbosity -> String -> IO ()
 noticeNoWrap verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
-    hPutStr stdout . withMetadata True verbosity $ msg
+    hPutStr stdout . withMetadata NormalMark verbosity $ msg
 
 -- | Pretty-print a 'Disp.Doc' status message at 'normal' verbosity
 -- level.  Use this if you need fancy formatting.
 --
 noticeDoc :: Verbosity -> Disp.Doc -> IO ()
 noticeDoc verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
-    hPutStr stdout . withMetadata True verbosity
+    hPutStr stdout . withMetadata NormalMark verbosity
                    . Disp.renderStyle defaultStyle $ msg
 
 -- | Display a "setup status message".  Prefer using setupMessage'
@@ -465,14 +465,14 @@ setupMessage verbosity msg pkgid = withFrozenCallStack $ do
 info :: Verbosity -> String -> IO ()
 info verbosity msg = withFrozenCallStack $
   when (verbosity >= verbose) $ do
-    hPutStr stdout . withMetadata False verbosity
+    hPutStr stdout . withMetadata NeverMark verbosity
                    . wrapTextVerbosity verbosity
                    $ msg
 
 infoNoWrap :: Verbosity -> String -> IO ()
 infoNoWrap verbosity msg = withFrozenCallStack $
   when (verbosity >= verbose) $ do
-    hPutStr stdout . withMetadata False verbosity
+    hPutStr stdout . withMetadata NeverMark verbosity
                    $ msg
 
 -- | Detailed internal debugging information
@@ -482,7 +482,7 @@ infoNoWrap verbosity msg = withFrozenCallStack $
 debug :: Verbosity -> String -> IO ()
 debug verbosity msg = withFrozenCallStack $
   when (verbosity >= deafening) $ do
-    hPutStr stdout . withMetadata False verbosity
+    hPutStr stdout . withMetadata NeverMark verbosity
                    . wrapTextVerbosity verbosity
                    $ msg
     -- ensure that we don't lose output if we segfault/infinite loop
@@ -493,7 +493,7 @@ debug verbosity msg = withFrozenCallStack $
 debugNoWrap :: Verbosity -> String -> IO ()
 debugNoWrap verbosity msg = withFrozenCallStack $
   when (verbosity >= deafening) $ do
-    hPutStr stdout . withMetadata False verbosity
+    hPutStr stdout . withMetadata NeverMark verbosity
                    $ msg
     -- ensure that we don't lose output if we segfault/infinite loop
     hFlush stdout
@@ -569,15 +569,27 @@ withCallStackPrefix verbosity s = withFrozenCallStack $
         else "") ++
     s
 
+-- | When should we output the marker?  Things like 'die'
+-- always get marked, but a 'NormalMark' will only be
+-- output if we're not a quiet verbosity.
+--
+data MarkWhen = AlwaysMark | NormalMark | NeverMark
+
 -- | Add all necessary metadata to a logging message
 --
-withMetadata :: Bool -> Verbosity -> String -> String
+withMetadata :: MarkWhen -> Verbosity -> String -> String
 withMetadata marker verbosity x = withFrozenCallStack $
     -- NB: order matters.  Output marker first because we
     -- don't want to capture call stacks.
       withTrailingNewline
     . withCallStackPrefix verbosity
-    . (if marker then withOutputMarker verbosity else id)
+    . (case marker of
+        AlwaysMark -> withOutputMarker verbosity
+        NormalMark | not (isVerboseQuiet verbosity)
+                   -> withOutputMarker verbosity
+                   | otherwise
+                   -> id
+        NeverMark  -> id)
     $ x
 
 -- -----------------------------------------------------------------------------

Cabal/Distribution/Verbosity.hs

@@ -27,7 +27,7 @@ module Distribution.Verbosity (
   -- * Verbosity
   Verbosity,
   silent, normal, verbose, deafening,
-  moreVerbose, lessVerbose,
+  moreVerbose, lessVerbose, isVerboseQuiet,
   intToVerbosity, flagToVerbosity,
   showForCabal, showForGHC,
   verboseNoFlags, verboseHasFlags,
@@ -116,6 +116,7 @@ moreVerbose v =
 
 lessVerbose :: Verbosity -> Verbosity
 lessVerbose v =
+    verboseQuiet $
     case vLevel v of
         Deafening -> v -- deafening stays deafening
         Verbose   -> v { vLevel = Normal }
@@ -175,12 +176,13 @@ showForCabal v
                     Normal -> "normal"
                     Verbose -> "verbose"
                     Deafening -> "debug")
-              : map showFlag (Set.toList (vFlags v))
+              : concatMap showFlag (Set.toList (vFlags v))
   where
-    showFlag VCallSite   = "+callsite"
-    showFlag VCallStack  = "+callstack"
-    showFlag VNoWrap     = "+nowrap"
-    showFlag VMarkOutput = "+markoutput"
+    showFlag VCallSite   = ["+callsite"]
+    showFlag VCallStack  = ["+callstack"]
+    showFlag VNoWrap     = ["+nowrap"]
+    showFlag VMarkOutput = ["+markoutput"]
+    showFlag VQuiet      = []
 showForGHC   v = maybe (error "unknown verbosity") show $
     elemIndex v [silent,normal,__,verbose,deafening]
         where __ = silent -- this will be always ignored by elemIndex
@@ -190,6 +192,9 @@ data VerbosityFlag
     | VCallSite
     | VNoWrap
     | VMarkOutput
+    -- | 'VQuiet' gets set when 'lessVerbose' is called on
+    -- a 'Verbosity'.  It is not user toggleable.
+    | VQuiet
     deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
 
 instance Binary VerbosityFlag
@@ -215,6 +220,10 @@ verboseUnmarkOutput v = v { vFlags = Set.delete VMarkOutput (vFlags v) }
 verboseNoWrap :: Verbosity -> Verbosity
 verboseNoWrap = verboseFlag VNoWrap
 
+-- | Mark the verbosity as quiet
+verboseQuiet :: Verbosity -> Verbosity
+verboseQuiet = verboseFlag VQuiet
+
 -- | Helper function for flag toggling functions
 verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
 verboseFlag flag v = v { vFlags = Set.insert flag (vFlags v) }
@@ -241,6 +250,10 @@ isVerboseMarkOutput = isVerboseFlag VMarkOutput
 isVerboseNoWrap :: Verbosity -> Bool
 isVerboseNoWrap = isVerboseFlag VNoWrap
 
+-- | Test if we had called 'lessVerbose' on the verbosity
+isVerboseQuiet :: Verbosity -> Bool
+isVerboseQuiet = isVerboseFlag VQuiet
+
 -- | Helper function for flag testing functions.
 isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
 isVerboseFlag flag = (Set.member flag) . vFlags