GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

42549222

by sheaf at 2026-04-27T09:33:50-04:00

Hadrian: add --keep-response-files

This commit adds a Hadrian flag that allows response files to be
retained. This is useful for debugging a failing Hadrian command line.

5 changed files:

+ changelog.d/hadrian-response-files.md
hadrian/src/Builder.hs
hadrian/src/CommandLine.hs
hadrian/src/Hadrian/Builder/Ar.hs
hadrian/src/Hadrian/Utilities.hs

Changes:

changelog.d/hadrian-response-files.md

 +section: packaging
 +synopsis: Add a flag to tell Hadrian to keep response files
 +issues: #27184
 +mrs: !15906
 +description:
 +  Hadrian can now be instructed to keep response files with the new
 +  --keep-response-files command line flag. This is helpful when debugging a
 +  build failure, as it allows re-running the failing command line invocation
 +  without an error due to a missing response file.

hadrian/src/Builder.hs

@@ -389,15 +389,13 @@ runHaddock :: FilePath    -- ^ path to @haddock@
        -> [String]
        -> [FilePath]  -- ^ input file paths
        -> Action ()
 -runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do
 +runHaddock haddockPath flagArgs fileInputs = withResponseFile $ \tmp -> do
      writeFile' tmp $ escapeArgs fileInputs
      cmd [haddockPath] flagArgs ('@' : tmp)
  runGhcWithResponse :: FilePath -> [String] -> [FilePath] -> Action ()
 -runGhcWithResponse ghcPath flagArgs fileInputs = withTempFile $ \tmp -> do
+-
 +runGhcWithResponse ghcPath flagArgs fileInputs = withResponseFile $ \tmp -> do
      writeFile' tmp $ escapeArgs fileInputs
+-
      -- We can't put the flags in a response file, because some flags
      -- require empty arguments (such as the -dep-suffix flag), but
      -- that isn't supported yet due to #26560.

hadrian/src/CommandLine.hs

@@ -3,7 +3,8 @@ module CommandLine (
      lookupBignum,
      cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdCompleteSetting,
      cmdDocsArgs, cmdUnitIdHash, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
 -    cmdPrefix, cmdChangelogVersion, DocArgs(..), defaultDocArgs
 +    cmdPrefix, cmdChangelogVersion, DocArgs(..), defaultDocArgs,
 +    cmdKeepResponseFiles
      ) where
  import Data.Either
@@ -11,7 +12,7 @@ import qualified Data.HashMap.Strict as Map
  import Data.List.Extra
  import Development.Shake hiding (Normal)
  import Flavour (DocTargets, DocTarget(..))
 -import Hadrian.Utilities hiding (buildRoot)
 +import Hadrian.Utilities hiding (buildRoot, keepResponseFiles)
  import Settings.Parser
  import System.Console.GetOpt
  import System.Environment
@@ -37,6 +38,7 @@ data CommandLineArgs = CommandLineArgs
      , testArgs       :: TestArgs
      , docsArgs       :: DocArgs
      , docTargets     :: DocTargets
 +    , keepResponseFiles :: Bool
      , prefix           :: Maybe FilePath
      , changelogVersion :: Maybe String
      , completeStg      :: Maybe String }
@@ -58,6 +60,7 @@ defaultCommandLineArgs = CommandLineArgs
      , testArgs       = defaultTestArgs
      , docsArgs       = defaultDocArgs
      , docTargets     = Set.fromList [minBound..maxBound]
 +    , keepResponseFiles    = False
      , prefix           = Nothing
      , changelogVersion = Nothing
      , completeStg      = Nothing }
@@ -143,6 +146,9 @@ readFreeze1 = Right $ \flags -> flags { freeze1 = True }
  readFreeze2 = Right $ \flags -> flags { freeze1 = True, freeze2 = True }
  readSkipDepends = Right $ \flags -> flags { skipDepends = True }
 +readKeepResponseFiles :: Either String (CommandLineArgs -> CommandLineArgs)
 +readKeepResponseFiles = Right $ \flags -> flags { keepResponseFiles = True }
++
  readUnitIdHash :: Either String (CommandLineArgs -> CommandLineArgs)
  readUnitIdHash = Right $ \flags ->
    trace "--hash-unit-ids is deprecated. It is enabled by release flavour or +hash_unit_ids flavour transformer" $
@@ -301,6 +307,8 @@ optDescrs =
        "Progress info style (None, Brief, Normal or Unicorn)."
      , Option [] ["docs"] (ReqArg readDocsArg "TARGET")
        "Strip down docs targets (none, no-haddocks, no-sphinx[-{html, pdfs, man}]."
 +    , Option ['r'] ["keep-response-files"] (NoArg readKeepResponseFiles)
 +      "Keep response files created during the build (for debugging)."
      , Option ['k'] ["keep-test-files"] (NoArg readTestKeepFiles)
        "Keep all the files generated when running the testsuite."
      , Option [] ["test-compiler"] (ReqArg readTestCompiler "TEST_COMPILER")
@@ -377,11 +385,12 @@ cmdLineArgsMap = do
          else return []
      let allSettings = cliSettings ++ fileSettings
 -    return $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
 -           $ insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities
 -           $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
 -           $ insertExtra (docsArgs       args) -- Accessed by Rules.Documentation
 -           $ insertExtra allSettings           -- Accessed by Settings
 +    return $ insertExtra (progressInfo               args) -- Accessed by Hadrian.Utilities
 +           $ insertExtra (buildRoot                  args) -- Accessed by Hadrian.Utilities
 +           $ insertExtra (KeepResponseFiles $ keepResponseFiles args) -- Accessed by Hadrian.Utilities
 +           $ insertExtra (testArgs                   args) -- Accessed by Settings.Builders.RunTest
 +           $ insertExtra (docsArgs                   args) -- Accessed by Rules.Documentation
 +           $ insertExtra allSettings                       -- Accessed by Settings
             $ insertExtra args Map.empty
  cmdLineArgs :: Action CommandLineArgs
@@ -423,6 +432,9 @@ cmdBignum = bignum <$> cmdLineArgs
  cmdBignumCheck :: Action Bool
  cmdBignumCheck = bignumCheck <$> cmdLineArgs
 +cmdKeepResponseFiles :: Action Bool
 +cmdKeepResponseFiles = keepResponseFiles <$> cmdLineArgs
++
  cmdProgressInfo :: Action ProgressInfo
  cmdProgressInfo = progressInfo <$> cmdLineArgs

hadrian/src/Hadrian/Builder/Ar.hs

@@ -40,7 +40,7 @@ runAr :: FilePath    -- ^ path to @ar@
        -> [FilePath]  -- ^ input file paths
        -> [CmdOption] -- ^ Additional options
        -> Action ()
 -runAr arPath flagArgs fileArgs buildOptions = withTempFile $ \tmp -> do
 +runAr arPath flagArgs fileArgs buildOptions = withResponseFile $ \tmp -> do
      writeFile' tmp $ unwords fileArgs
      cmd [arPath] flagArgs ('@' : tmp) buildOptions

hadrian/src/Hadrian/Utilities.hs

@@ -14,6 +14,7 @@ module Hadrian.Utilities (
      -- * Paths
      BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
 +    KeepResponseFiles (..), keepResponseFiles, withResponseFile,
      -- * File system operations
      copyFile, copyFileUntracked, createFileLink, fixFile,
@@ -48,6 +49,7 @@ import Development.Shake hiding (Normal)
  import Development.Shake.Classes
  import Development.Shake.FilePath
  import System.Environment (lookupEnv)
 +import System.IO (hClose, openTempFile)
  import qualified Data.ByteString        as BS
  import qualified Control.Exception.Base as IO
@@ -317,6 +319,29 @@ buildRootRules = do
  isGeneratedSource :: FilePath -> Action Bool
  isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
 +newtype KeepResponseFiles = KeepResponseFiles Bool deriving (Eq, Show)
++
 +-- | Whether to retain response files after the build action that created them
 +-- completes. Mainly useful for debugging.
 +keepResponseFiles :: Action Bool
 +keepResponseFiles = do
 +    KeepResponseFiles keep <- userSetting (KeepResponseFiles False)
 +    return keep
++
 +-- | Run an action with a response file path.
 +--
 +-- With @--keep-response-files@, the file is left on disk.
 +withResponseFile :: (FilePath -> Action a) -> Action a
 +withResponseFile action = do
 +    keep <- keepResponseFiles
 +    if keep
 +        then do
 +            (tmp, h) <- liftIO $ openTempFile "." "hadrian-rsp"
 +            liftIO $ hClose h
 +            putInfo $ "Keeping response file: " ++ tmp
 +            action tmp
 +        else withTempFile action
++
  -- | Link a file tracking the link target. Create the target directory if
  -- missing.
  createFileLink :: FilePath -> FilePath -> Action ()