hadrian: Suggest to the user to run ./configure if missing a settingwip/hadrian-config

If a setting is missing from the configuration file it's likely the user
needs to reconfigure.

Fixes #20476

5 files changed, 31 insertions, 24 deletions

diff --git a/hadrian/src/Hadrian/Oracles/TextFile.hs b/hadrian/src/Hadrian/Oracles/TextFile.hs
index c36b3977bc..a95758117f 100644
--- a/hadrian/src/Hadrian/Oracles/TextFile.hs
+++ b/hadrian/src/Hadrian/Oracles/TextFile.hs
@@ -11,7 +11,7 @@
 -- to read configuration or package metadata files and cache the parsing.
 -----------------------------------------------------------------------------
 module Hadrian.Oracles.TextFile (
-    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
+    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupSystemConfig, lookupValues,
     lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle
     ) where
 
@@ -22,6 +22,7 @@ import Data.List
 import Development.Shake
 import Development.Shake.Classes
 import Development.Shake.Config
+import Base
 
 import Hadrian.Utilities
 
@@ -35,10 +36,16 @@ lookupValueOrEmpty :: FilePath -> String -> Action String
 lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
 
 -- | Like 'lookupValue' but raises an error if the key is not found.
-lookupValueOrError :: FilePath -> String -> Action String
-lookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key
+lookupValueOrError :: Maybe String -> FilePath -> String -> Action String
+lookupValueOrError helper file key = fromMaybe (error msg) <$> lookupValue file key
   where
-    msg = "Key " ++ quote key ++ " not found in file " ++ quote file
+    msg = unlines $ ["Key " ++ quote key ++ " not found in file " ++ quote file]
+                    ++ maybeToList helper
+
+lookupSystemConfig :: String -> Action String
+lookupSystemConfig = lookupValueOrError (Just configError) configFile
+  where
+    configError = "Perhaps you need to rerun ./configure"
 
 -- | Lookup a list of values in a text file, tracking the result. Each line of
 -- the file is expected to have @key value1 value2 ...@ format.
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs
index 22da18f134..7da72546e3 100644
--- a/hadrian/src/Oracles/Flag.hs
+++ b/hadrian/src/Oracles/Flag.hs
@@ -49,7 +49,7 @@ flag f = do
             BootstrapThreadedRts -> "bootstrap-threaded-rts"
             BootstrapEventLoggingRts -> "bootstrap-event-logging-rts"
             UseLibffiForAdjustors -> "use-libffi-for-adjustors"
-    value <- lookupValueOrError configFile key
+    value <- lookupSystemConfig key
     when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
         ++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
     return $ value == "YES"
diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs
index 0931c6f99f..775786b43a 100644
--- a/hadrian/src/Oracles/Setting.hs
+++ b/hadrian/src/Oracles/Setting.hs
@@ -132,7 +132,7 @@ data SettingsFileSetting
 -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
 -- result.
 setting :: Setting -> Action String
-setting key = lookupValueOrError configFile $ case key of
+setting key = lookupSystemConfig $ case key of
     BuildArch          -> "build-arch"
     BuildOs            -> "build-os"
     BuildPlatform      -> "build-platform"
@@ -185,7 +185,7 @@ setting key = lookupValueOrError configFile $ case key of
 -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
 -- result.
 settingList :: SettingList -> Action [String]
-settingList key = fmap words $ lookupValueOrError configFile $ case key of
+settingList key = fmap words $ lookupSystemConfig $ case key of
     ConfCcArgs        stage -> "conf-cc-args-"         ++ stageString stage
     ConfCppArgs       stage -> "conf-cpp-args-"        ++ stageString stage
     ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage
@@ -197,7 +197,7 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of
 -- result.
 -- See Note [tooldir: How GHC finds mingw on Windows]
 settingsFileSetting :: SettingsFileSetting -> Action String
-settingsFileSetting key = lookupValueOrError configFile $ case key of
+settingsFileSetting key = lookupSystemConfig $ case key of
     SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command"
     SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command"
     SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags"
diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs
index dec7097d25..7956491414 100644
--- a/hadrian/src/Oracles/TestSettings.hs
+++ b/hadrian/src/Oracles/TestSettings.hs
@@ -49,7 +49,7 @@ data TestSetting = TestHostOS
 testSetting :: TestSetting -> Action String
 testSetting key = do
     file <- testConfigFile
-    lookupValueOrError file $ case key of
+    lookupValueOrError Nothing file $ case key of
         TestHostOS                -> "HostOS"
         TestWORDSIZE              -> "WORDSIZE"
         TestTARGETPLATFORM        -> "TARGETPLATFORM"
@@ -77,7 +77,7 @@ testSetting key = do
 testRTSSettings :: Action [String]
 testRTSSettings = do
     file <- testConfigFile
-    words <$> lookupValueOrError file "GhcRTSWays"
+    words <$> lookupValueOrError Nothing file "GhcRTSWays"
 
 absoluteBuildRoot :: Action FilePath
 absoluteBuildRoot = (fixAbsolutePathOnWindows  =<< liftIO . makeAbsolute =<< buildRoot)
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index e19d058425..9350b1b2ca 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -7,7 +7,7 @@ module Rules.Generate (
 import Base
 import qualified Context
 import Expression
-import Hadrian.Oracles.TextFile (lookupValueOrError)
+import Hadrian.Oracles.TextFile (lookupSystemConfig)
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
@@ -292,7 +292,7 @@ generateSettings :: Expr String
 generateSettings = do
     ctx <- getContext
     settings <- traverse sequence $
-        [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts")
+        [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts")
         , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand)
         , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags)
         , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags)
@@ -302,14 +302,14 @@ generateSettings = do
         , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
         , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand)
         , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags)
-        , ("ld supports compact unwind", expr $ lookupValueOrError configFile "ld-has-no-compact-unwind")
-        , ("ld supports build-id", expr $ lookupValueOrError configFile "ld-has-build-id")
-        , ("ld supports filelist", expr $ lookupValueOrError configFile "ld-has-filelist")
-        , ("ld is GNU ld", expr $ lookupValueOrError configFile "ld-is-gnu-ld")
+        , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind")
+        , ("ld supports build-id", expr $ lookupSystemConfig "ld-has-build-id")
+        , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist")
+        , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld")
         , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand)
         , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags)
         , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand)
-        , ("ar flags", expr $ lookupValueOrError configFile "ar-args")
+        , ("ar flags", expr $ lookupSystemConfig "ar-args")
         , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile)
         , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand)
         , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand)
@@ -323,13 +323,13 @@ generateSettings = do
         , ("target platform string", getSetting TargetPlatform)
         , ("target os", getSetting TargetOsHaskell)
         , ("target arch", getSetting TargetArchHaskell)
-        , ("target word size", expr $ lookupValueOrError configFile "target-word-size")
-        , ("target word big endian", expr $ lookupValueOrError configFile "target-word-big-endian")
-        , ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "target-has-gnu-nonexec-stack")
-        , ("target has .ident directive", expr $ lookupValueOrError configFile "target-has-ident-directive")
-        , ("target has subsections via symbols", expr $ lookupValueOrError configFile "target-has-subsections-via-symbols")
-        , ("target has RTS linker", expr $ lookupValueOrError configFile "target-has-rts-linker")
-        , ("target has libm", expr $  lookupValueOrError configFile "target-has-libm")
+        , ("target word size", expr $ lookupSystemConfig "target-word-size")
+        , ("target word big endian", expr $ lookupSystemConfig "target-word-big-endian")
+        , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack")
+        , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive")
+        , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols")
+        , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker")
+        , ("target has libm", expr $  lookupSystemConfig "target-has-libm")
         , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised)
         , ("LLVM target", getSetting LlvmTarget)
         , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand)