Skip to content
Snippets Groups Projects
Commit 1935c42f authored by Matthew Pickering's avatar Matthew Pickering Committed by Marge Bot
Browse files

hadrian: Reduce default verbosity

This change reduces the default verbosity of error messages to omit the
stack trace information from the printed output.

For example, before all errors would have a long call trace:

```
Error when running Shake build system:
  at action, called at src/Rules.hs:39:19 in main:Rules
  at need, called at src/Rules.hs:61:5 in main:Rules
* Depends on: _build/stage1/lib/package.conf.d/ghc-9.3.conf
* Depends on: _build/stage1/compiler/build/libHSghc-9.3.a
* Depends on: _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.o
* Depends on: _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.o _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.hi
  at cmd', called at src/Builder.hs:330:23 in main:Builder
  at cmd, called at src/Builder.hs:432:8 in main:Builder
* Raised the exception:
```

Which can be useful but it confusing for GHC rather than hadrian
developers.

Ticket #20386
parent 45a674aa
No related branches found
No related tags found
No related merge requests found
......@@ -429,4 +429,4 @@ applyPatch dir patch = do
-- | Wrapper for 'cmd' that makes sure we include both stdout and stderr in
-- Shake's output when any of our builder commands fail.
cmd' :: (Partial, CmdArguments args) => args :-> Action r
cmd' = cmd [WithStderr True, WithStdout True]
cmd' = cmd [WithStderr False, WithStdout False]
......@@ -24,7 +24,7 @@ module Hadrian.Utilities (
Colour (..), ANSIColour (..), putColoured, shouldUseColor,
BuildProgressColour, mkBuildProgressColour, putBuild,
SuccessColour, mkSuccessColour, putSuccess,
FailureColour, mkFailureColour, putFailure,
FailureColour(..), red, mkFailureColour, putFailure,
ProgressInfo (..), putProgressInfo,
renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn,
......
......@@ -5,6 +5,10 @@ import Hadrian.Expression
import Hadrian.Utilities
import Settings.Parser
import System.Directory (getCurrentDirectory)
import System.IO
import System.Exit
import System.Environment
import Control.Exception
import qualified Base
import qualified CommandLine
......@@ -96,9 +100,30 @@ main = do
Rules.topLevelTargets
Rules.toolArgsTarget
shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
handleShakeException options $ shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
let targets' = filter (not . null) $ removeKVs targets
Environment.setupEnvironment
return . Just $ if null targets'
then rules
else want targets' >> withoutActions rules
handleShakeException :: ShakeOptions -> IO a -> IO a
handleShakeException opts shake_run = do
args <- getArgs
catch (withArgs ("--exception" : args) $ shake_run) $ \(_e :: ShakeException) -> do
hPrint stderr (shakeExceptionInner _e)
hPutStrLn stderr (esc "Build failed.")
exitFailure
where
FailureColour col = lookupExtra red (shakeExtra opts)
esc = if shakeColor opts then escape col else id
escForeground :: String -> String
escForeground code = "\ESC[" ++ code ++ "m"
escNormal :: String
escNormal = "\ESC[0m"
escape :: String -> String -> String
escape code x = escForeground code ++ x ++ escNormal
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment