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

3 files changed, 28 insertions, 3 deletions

diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index 2661ba7df6..58a8dbc350 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -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]
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 8bcfa6f974..3777b9ea05 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -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,
 
diff --git a/hadrian/src/Main.hs b/hadrian/src/Main.hs
index 25ea219404..78c5a385ca 100644
--- a/hadrian/src/Main.hs
+++ b/hadrian/src/Main.hs
@@ -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
+