Use response files for ghc invocations

Before this change, `cabal` could fail with the following error message
when building very large Haskell packages:

```
ghc: createProcess: posix_spawnp: resource exhausted (Argument list too long)
```

This is because when the number of modules or dependencies grows large
enough, then the `ghc` command line can potentially exceed the
`ARG_MAX` command line length limit.

However, `ghc` supports response files in order to work around these
sorts of command line length limitations, so this change enables the
use of those response files.

Note that this requires taking a special precaution to not pass RTS
options to the response file because there's no way that `ghc` can
support RTS options via the response file.  The reason why is because
the Haskell runtime processes these options (not `ghc`), so if you
store the RTS options in the response file then `ghc`'s command line
parser won't know what to do with them.

This means that `ghc` commands can still potentially fail if the RTS
options get long enough, but this is less likely to occur in practice
since RTS options tend to be significantly smaller than non-RTS
options.

This also requires skipping the response file if the first argument
is `--interactive`.  See the corresponding code comment which explains
why in more detail.

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -40,8 +40,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
-#if MIN_VERSION_base(4,19,0)
-    0x1be858ee00c3e2d4be5331d5f07bfdf7
-#else
-    0x8a5431ab053f8f48c15b303444fa2c39
-#endif
+    0xff829d7b383bcccb8192c5a61176c2e0

Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs

@@ -159,7 +159,15 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
       isGhcDynamic = isDynamic comp
       doingTH = usesTemplateHaskellOrQQ bi
       forceSharedLib = doingTH && isGhcDynamic
-      runGhcProg = runGHC verbosity ghcProg comp platform
+      runGhcProg =
+        runGHCWithResponseFile
+          "ghc.rsp"
+          Nothing
+          buildTargetDir
+          verbosity
+          ghcProg
+          comp
+          platform
 
       buildAction sourceFile = do
         let baseSrcOpts =

Cabal/src/Distribution/Simple/GHC/Build/Link.hs

@@ -77,6 +77,7 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
     lbi = localBuildInfo pbci
     bi = buildBI pbci
     clbi = buildCLBI pbci
+    responseFileDir = buildTargetDir
 
   -- ensure extra lib dirs exist before passing to ghc
   cleanedExtraLibDirs <- liftIO $ filterM doesDirectoryExist (extraLibDirs bi)
@@ -152,10 +153,25 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
       -- exports.
       when (case component of CLib lib -> null (allLibModules lib clbi); _ -> False) $
         warn verbosity "No exposed modules"
-      runReplOrWriteFlags ghcProg lbi replFlags replOpts (pkgName (PD.package pkg_descr)) target
+      runReplOrWriteFlags
+        ghcProg
+        lbi
+        replFlags
+        replOpts
+        (pkgName (PD.package pkg_descr))
+        target
+        responseFileDir
     _otherwise ->
       let
-        runGhcProg = runGHC verbosity ghcProg comp platform
+        runGhcProg =
+          runGHCWithResponseFile
+            "ghc.rsp"
+            Nothing
+            responseFileDir
+            verbosity
+            ghcProg
+            comp
+            platform
         platform = hostPlatform lbi
         comp = compiler lbi
        in
@@ -622,14 +638,24 @@ runReplOrWriteFlags
   -> GhcOptions
   -> PackageName
   -> TargetInfo
+  -> FilePath
   -> IO ()
-runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
+runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target responseFileDir =
   let bi = componentBuildInfo $ targetComponent target
       clbi = targetCLBI target
       comp = compiler lbi
       platform = hostPlatform lbi
    in case replOptionsFlagOutput (replReplOptions rflags) of
-        NoFlag -> runGHC (fromFlag $ replVerbosity rflags) ghcProg comp platform ghcOpts
+        NoFlag ->
+          runGHCWithResponseFile
+            "ghc.rsp"
+            Nothing
+            responseFileDir
+            (fromFlag $ replVerbosity rflags)
+            ghcProg
+            comp
+            platform
+            ghcOpts
         Flag out_dir -> do
           src_dir <- getCurrentDirectory
           let uid = componentUnitId clbi

Cabal/src/Distribution/Simple/GHC/Build/Modules.hs

@@ -139,7 +139,15 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = d
   (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
 
   let
-    runGhcProg = runGHC verbosity ghcProg comp platform
+    runGhcProg =
+      runGHCWithResponseFile
+        "ghc.rsp"
+        Nothing
+        buildTargetDir
+        verbosity
+        ghcProg
+        comp
+        platform
     platform = hostPlatform lbi
 
     -- See Note [Building Haskell Modules accounting for TH]

Cabal/src/Distribution/Simple/Program/GHC.hs

@@ -14,6 +14,7 @@ module Distribution.Simple.Program.GHC
   , ghcInvocation
   , renderGhcOptions
   , runGHC
+  , runGHCWithResponseFile
   , packageDbArgsDb
   , normaliseGhcArgs
   ) where
@@ -30,25 +31,29 @@ import Distribution.Simple.Compiler
 import Distribution.Simple.Flag
 import Distribution.Simple.GHC.ImplInfo
 import Distribution.Simple.Program.Find (getExtraPathEnv)
+import Distribution.Simple.Program.ResponseFile
 import Distribution.Simple.Program.Run
 import Distribution.Simple.Program.Types
+import Distribution.Simple.Utils (defaultTempFileOptions, infoNoWrap)
 import Distribution.System
 import Distribution.Types.ComponentId
 import Distribution.Utils.NubList
 import Distribution.Verbosity
 import Distribution.Version
+import GHC.IO.Encoding (TextEncoding)
 import Language.Haskell.Extension
 
 import Data.List (stripPrefix)
 import qualified Data.Map as Map
 import Data.Monoid (All (..), Any (..), Endo (..))
 import qualified Data.Set as Set
 import Distribution.Types.ParStrat
+import qualified System.Process as Process
 
 normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
 normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs
   | ghcVersion `withinRange` supportedGHCVersions =
-      argumentFilters . filter simpleFilters . filterRtsOpts $ ghcArgs
+      argumentFilters . filter simpleFilters . filterRtsArgs $ ghcArgs
   where
     supportedGHCVersions :: VersionRange
     supportedGHCVersions = orLaterVersion (mkVersion [8, 0])
@@ -158,18 +163,9 @@ normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs
       flagArgumentFilter
         ["-ghci-script", "-H", "-interactive-print"]
 
-    filterRtsOpts :: [String] -> [String]
-    filterRtsOpts = go False
-      where
-        go :: Bool -> [String] -> [String]
-        go _ [] = []
-        go _ ("+RTS" : opts) = go True opts
-        go _ ("-RTS" : opts) = go False opts
-        go isRTSopts (opt : opts) = addOpt $ go isRTSopts opts
-          where
-            addOpt
-              | isRTSopts = id
-              | otherwise = (opt :)
+    -- \| Remove RTS arguments from a list.
+    filterRtsArgs :: [String] -> [String]
+    filterRtsArgs = snd . splitRTSArgs
 
     simpleFilters :: String -> Bool
     simpleFilters =
@@ -638,6 +634,67 @@ runGHC
 runGHC verbosity ghcProg comp platform opts = do
   runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform opts
 
+runGHCWithResponseFile
+  :: FilePath
+  -> Maybe TextEncoding
+  -> FilePath
+  -> Verbosity
+  -> ConfiguredProgram
+  -> Compiler
+  -> Platform
+  -> GhcOptions
+  -> IO ()
+runGHCWithResponseFile fileNameTemplate encoding responseFileDir verbosity ghcProg comp platform opts = do
+  invocation <- ghcInvocation verbosity ghcProg comp platform opts
+
+  -- Don't use response files if the first argument is `--interactive`, for
+  -- two related reasons.
+  --
+  -- `hie-bios` relies on a hack to intercept the command-line that `Cabal`
+  -- supplies to `ghc`.  Specifically, `hie-bios` creates a script around
+  -- `ghc` that detects if the first option is `--interactive` and if so then
+  -- instead of running `ghc` it prints the command-line that `ghc` was given
+  -- instead of running the command:
+  --
+  -- https://github.com/haskell/hie-bios/blob/ce863dba7b57ded20160b4f11a487e4ff8372c08/wrappers/cabal#L7
+  --
+  -- … so we can't store that flag in the response file, otherwise that will
+  -- break.  However, even if we were to add a special-case to keep that flag
+  -- out of the response file things would still break because `hie-bios`
+  -- stores the arguments to `ghc` that the wrapper script outputs and reuses
+  -- them later.  That breaks if you use a response file because it will
+  -- store an argument like `@…/ghc36000-0.rsp` which is a temporary path
+  -- that no longer exists after the wrapper script completes.
+  --
+  -- The work-around here is that we don't use a response file at all if the
+  -- first argument (and only the first argument) to `ghc` is
+  -- `--interactive`.  This ensures that `hie-bios` and all downstream
+  -- utilities (e.g. `haskell-language-server`) continue working.
+  case progInvokeArgs invocation of
+    "--interactive" : _ ->
+      runProgramInvocation verbosity invocation
+    args -> do
+      let (rtsArgs, otherArgs) = splitRTSArgs args
+
+      withResponseFile
+        verbosity
+        defaultTempFileOptions
+        responseFileDir
+        fileNameTemplate
+        encoding
+        otherArgs
+        $ \responseFile -> do
+          let newInvocation =
+                invocation{progInvokeArgs = ('@' : responseFile) : rtsArgs}
+
+          infoNoWrap verbosity $
+            "GHC response file arguments: "
+            <> case otherArgs of
+                 [] -> ""
+                 arg : args' -> Process.showCommandForUser arg args'
+
+          runProgramInvocation verbosity newInvocation
+
 ghcInvocation
   :: Verbosity
   -> ConfiguredProgram
@@ -939,6 +996,26 @@ packageDbArgs implInfo
   | flagPackageConf implInfo = packageDbArgsConf
   | otherwise = packageDbArgsDb
 
+-- | Split a list of command-line arguments into RTS arguments and non-RTS
+-- arguments.
+splitRTSArgs :: [String] -> ([String], [String])
+splitRTSArgs args =
+  let addRTSArg arg ~(rtsArgs, nonRTSArgs) = (arg : rtsArgs, nonRTSArgs)
+      addNonRTSArg arg ~(rtsArgs, nonRTSArgs) = (rtsArgs, arg : nonRTSArgs)
+
+      go _ [] = ([], [])
+      go isRTSArg (arg : rest) =
+        case arg of
+          "+RTS" -> addRTSArg arg $ go True rest
+          "-RTS" -> addRTSArg arg $ go False rest
+          "--RTS" -> (arg : rest, [])
+          "--" -> (arg : rest, [])
+          _ ->
+            if isRTSArg
+              then addRTSArg arg $ go isRTSArg rest
+              else addNonRTSArg arg $ go isRTSArg rest
+   in go False args
+
 -- -----------------------------------------------------------------------------
 -- Boilerplate Monoid instance for GhcOptions