Implement +nowrap verbosity flag to suppress log-msg line-wrapping

Cabal/Distribution/Simple/Utils.hs

@@ -326,12 +326,13 @@ hPutCallStackPrefix h verbosity = withFrozenCallStack $ do
 -- produce the desired output.
 --
 -- Like 'die', these messages are always displayed on @stderr@, irrespective
--- of the 'Verbosity' level.
+-- of the 'Verbosity' level. The 'Verbosity' parameter is needed though to
+-- decide how to format the output (e.g. line-wrapping).
 --
-dieMsg :: String -> NoCallStackIO ()
-dieMsg msg = do
+dieMsg :: Verbosity -> String -> NoCallStackIO ()
+dieMsg verbosity msg = do
     hFlush stdout
-    hPutStr stderr (wrapText msg)
+    hPutStr stderr (wrapTextVerbosity verbosity msg)
 
 -- | As 'dieMsg' but with pre-formatted text.
 --
@@ -349,7 +350,7 @@ warn verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
     hFlush stdout
     hPutCallStackPrefix stderr verbosity
-    hPutStr stderr (wrapText ("Warning: " ++ msg))
+    hPutStr stderr (wrapTextVerbosity verbosity ("Warning: " ++ msg))
 
 -- | Useful status messages.
 --
@@ -362,7 +363,7 @@ notice :: Verbosity -> String -> IO ()
 notice verbosity msg = withFrozenCallStack $ do
   when (verbosity >= normal) $ do
     hPutCallStackPrefix stdout verbosity
-    putStr (wrapText msg)
+    putStr (wrapTextVerbosity verbosity msg)
 
 noticeNoWrap :: Verbosity -> String -> IO ()
 noticeNoWrap verbosity msg = withFrozenCallStack $ do
@@ -382,7 +383,7 @@ info :: Verbosity -> String -> IO ()
 info verbosity msg = withFrozenCallStack $
   when (verbosity >= verbose) $ do
     hPutCallStackPrefix stdout verbosity
-    putStr (wrapText msg)
+    putStr (wrapTextVerbosity verbosity msg)
 
 -- | Detailed internal debugging information
 --
@@ -392,7 +393,7 @@ debug :: Verbosity -> String -> IO ()
 debug verbosity msg = withFrozenCallStack $
   when (verbosity >= deafening) $ do
     hPutCallStackPrefix stdout verbosity
-    putStr (wrapText msg)
+    putStr (wrapTextVerbosity verbosity msg)
     hFlush stdout
 
 -- | A variant of 'debug' that doesn't perform the automatic line
@@ -433,6 +434,12 @@ wrapText = unlines
               . words)
          . lines
 
+-- | Wraps text unless the @+nowrap@ verbosity flag is active
+wrapTextVerbosity :: Verbosity -> String -> String
+wrapTextVerbosity verb
+  | isVerboseNoWrap verb = unlines . lines -- makes sure there's a trailing LF
+  | otherwise            = wrapText
+
 -- | Wraps a list of words to a list of lines of words of a particular width.
 wrapLine :: Int -> [String] -> [[String]]
 wrapLine width = wrap 0 []

Cabal/Distribution/Verbosity.hs

@@ -34,6 +34,9 @@ module Distribution.Verbosity (
   -- * Call stacks
   verboseCallSite, verboseCallStack,
   isVerboseCallSite, isVerboseCallStack,
+
+  -- * line-wrapping
+  verboseNoWrap, isVerboseNoWrap,
  ) where
 
 import Prelude ()
@@ -140,6 +143,7 @@ parseVerbosity = parseIntVerbosity <++ parseStringVerbosity
     parseExtra = char '+' >> choice
         [ string "callsite"  >> return verboseCallSite
         , string "callstack" >> return verboseCallStack
+        , string "nowrap"    >> return verboseNoWrap
         ]
 
 flagToVerbosity :: ReadE Verbosity
@@ -164,6 +168,7 @@ showForGHC   v = maybe (error "unknown verbosity") show $
 data VerbosityFlag
     = VCallStack
     | VCallSite
+    | VNoWrap
     deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
 
 instance Binary VerbosityFlag
@@ -183,3 +188,11 @@ isVerboseCallSite = (Set.member VCallSite) . vFlags
 -- | Test if we should output call stacks when we log.
 isVerboseCallStack :: Verbosity -> Bool
 isVerboseCallStack = (Set.member VCallStack) . vFlags
+
+-- | Disable line-wrapping for log messages.
+verboseNoWrap :: Verbosity -> Verbosity
+verboseNoWrap v = v { vFlags = Set.insert VNoWrap (vFlags v) }
+
+-- | Test if line-wrapping is disabled for log messages.
+isVerboseNoWrap :: Verbosity -> Bool
+isVerboseNoWrap = (Set.member VNoWrap) . vFlags

cabal-install/Distribution/Client/ProjectOrchestration.hs

@@ -636,7 +636,7 @@ dieOnBuildFailures verbosity plan buildOutcomes
   | otherwise = do
       -- For failures where we have a build log, print the log plus a header
        sequence_
-         [ do dieMsg $
+         [ do dieMsg verbosity $
                 '\n' : renderFailureDetail False pkg reason
                     ++ "\nBuild log ( " ++ logfile ++ " ):"
               readFile logfile >>= dieMsgNoWrap