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

1 files changed, 26 insertions, 1 deletions

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
+