Expand --keep-temp-files

Currently, `cabal repl` has a `--keep-temp-files` option, and `cabal.project` has a `keep-temp-files` option but it only effects Haddock builds. This patch adds `--keep-temp-files` to `CommonSetupFlags`, making it available to all commands. The expanded `--keep-temp-files` flag is used for the `cabal repl` command and Haddock builds (retaining compatibility with the previous behavior) but is also used to determine when to keep response files.
MercuryTechnologies · Sep 3, 2024 · 6d2f9f3 · 6d2f9f3
1 parent b65eba1
commit 6d2f9f3
Show file tree

Hide file tree

Showing 18 changed files with 235 additions and 205 deletions.
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -23,6 +23,7 @@ import Distribution.Simple.GHC.Build.Modules
 import Distribution.Simple.GHC.Build.Utils
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program.Types
+import Distribution.Simple.Setup.Common (commonSetupTempFileOptions)
 import Distribution.System (Arch (JavaScript), Platform (..))
 import Distribution.Types.ComponentLocalBuildInfo
 import Distribution.Utils.Path
@@ -177,11 +178,13 @@ buildExtraSources
         comp = compiler lbi
         platform = hostPlatform lbi
         responseFileDir = coerceSymbolicPath buildTargetDir
+        tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags buildingWhat
         runGhcProg =
           runGHCWithResponseFile
             "ghc.rsp"
             Nothing
             responseFileDir
+            tempFileOptions
             verbosity
             ghcProg
             comp

diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -99,6 +99,7 @@ linkOrLoadComponent
       isIndef = componentIsIndefinite clbi
       mbWorkDir = mbWorkDirLBI lbi
       responseFileDir = coerceSymbolicPath buildTargetDir
+      tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags what
 
       -- See Note [Symbolic paths] in Distribution.Utils.Path
       i = interpretSymbolicPathLBI lbi
@@ -204,6 +205,7 @@ linkOrLoadComponent
               "ghc.rsp"
               Nothing
               responseFileDir
+              tempFileOptions
               verbosity
               ghcProg
               comp
@@ -748,12 +750,14 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target responseFileDir =
       common = configCommonFlags $ configFlags lbi
       mbWorkDir = mbWorkDirLBI lbi
       verbosity = fromFlag $ setupVerbosity common
+      tempFileOptions = commonSetupTempFileOptions common
    in case replOptionsFlagOutput (replReplOptions rflags) of
         NoFlag ->
           runGHCWithResponseFile
             "ghc.rsp"
             Nothing
             responseFileDir
+            tempFileOptions
             verbosity
             ghcProg
             comp

diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
@@ -150,11 +150,13 @@ buildHaskellModules numJobs ghcProg mbMainFile inputModules buildTargetDir neede
 
     mbWorkDir = mbWorkDirLBI lbi
     responseFileDir = coerceSymbolicPath buildTargetDir
+    tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags what
     runGhcProg =
       runGHCWithResponseFile
         "ghc.rsp"
         Nothing
         responseFileDir
+        tempFileOptions
         verbosity
         ghcProg
         comp

diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -67,12 +67,9 @@ import Distribution.Simple.Program.GHC
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 import Distribution.Simple.Program.ResponseFile
 import Distribution.Simple.Register
-import Distribution.Simple.Setup.Common
-import Distribution.Simple.Setup.Haddock
-import Distribution.Simple.Setup.Hscolour
+import Distribution.Simple.Setup
 import Distribution.Simple.SetupHooks.Internal
   ( BuildHooks (..)
-  , BuildingWhat (..)
   , noBuildHooks
   )
 import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks
@@ -265,6 +262,7 @@ haddock_setupHooks
         mbWorkDir = flagToMaybe $ haddockWorkingDir flags
         comp = compiler lbi
         platform = hostPlatform lbi
+        config = configFlags lbi
 
         quickJmpFlag = haddockQuickJump flags'
         flags = case haddockTarget of
@@ -282,9 +280,7 @@ haddock_setupHooks
         flag f = fromFlag $ f flags
 
         tmpFileOpts =
-          defaultTempFileOptions
-            { optKeepTempFiles = flag haddockKeepTempFiles
-            }
+          commonSetupTempFileOptions $ configCommonFlags config
         htmlTemplate =
           fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $
             flags

diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs
@@ -36,7 +36,7 @@ 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)
+import Distribution.Simple.Utils (TempFileOptions)
 import Distribution.System
 import Distribution.Types.ComponentId
 import Distribution.Types.ParStrat
@@ -645,14 +645,15 @@ runGHCWithResponseFile
   :: FilePath
   -> Maybe TextEncoding
   -> SymbolicPath Pkg (Dir Response)
+  -> TempFileOptions
   -> Verbosity
   -> ConfiguredProgram
   -> Compiler
   -> Platform
   -> Maybe (SymbolicPath CWD (Dir Pkg))
   -> GhcOptions
   -> IO ()
-runGHCWithResponseFile fileNameTemplate encoding responseFileDir verbosity ghcProg comp platform maybeWorkDir opts = do
+runGHCWithResponseFile fileNameTemplate encoding responseFileDir tempFileOptions verbosity ghcProg comp platform maybeWorkDir opts = do
   invocation <- ghcInvocation verbosity ghcProg comp platform maybeWorkDir opts
 
   -- Don't use response files if the first argument is `--interactive`, for
@@ -686,7 +687,7 @@ runGHCWithResponseFile fileNameTemplate encoding responseFileDir verbosity ghcPr
 
       withResponseFile
         verbosity
-        defaultTempFileOptions
+        tempFileOptions
         maybeWorkDir
         responseFileDir
         fileNameTemplate

diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs
@@ -41,6 +41,7 @@ module Distribution.Simple.Setup
   , globalCommand
   , CommonSetupFlags (..)
   , defaultCommonSetupFlags
+  , commonSetupTempFileOptions
   , ConfigFlags (..)
   , emptyConfigFlags
   , defaultConfigFlags

diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs
@@ -23,6 +23,7 @@ module Distribution.Simple.Setup.Common
   ( CommonSetupFlags (..)
   , defaultCommonSetupFlags
   , withCommonSetupOptions
+  , commonSetupTempFileOptions
   , CopyDest (..)
   , configureCCompiler
   , configureLinker
@@ -85,6 +86,13 @@ data CommonSetupFlags = CommonSetupFlags
   --
   -- TODO: this one should not be here, it's just that the silly
   -- UserHooks stop us from passing extra info in other ways
+  , setupKeepTempFiles :: Flag Bool
+  -- ^ When this flag is set, temporary files will be kept after building.
+  --
+  -- Note: Keeping temporary files is important functionality for HLS, which
+  -- runs @cabal repl@ with a fake GHC to get CLI arguments. It will need the
+  -- temporary files (including multi unit repl response files) to stay, even
+  -- after the @cabal repl@ command exits.
   }
   deriving (Eq, Show, Read, Generic)
 
@@ -106,6 +114,15 @@ defaultCommonSetupFlags =
     , setupDistPref = NoFlag
     , setupCabalFilePath = NoFlag
     , setupTargets = []
+    , setupKeepTempFiles = NoFlag
+    }
+
+-- | Get `TempFileOptions` that respect the `setupKeepTempFiles` flag.
+commonSetupTempFileOptions :: CommonSetupFlags -> TempFileOptions
+commonSetupTempFileOptions options =
+  TempFileOptions
+    { optKeepTempFiles =
+        fromFlagOrDefault False (setupKeepTempFiles options)
     }
 
 commonSetupOptions :: ShowOrParseArgs -> [OptionField CommonSetupFlags]
@@ -124,8 +141,16 @@ commonSetupOptions showOrParseArgs =
       setupCabalFilePath
       (\v flags -> flags{setupCabalFilePath = v})
       (reqSymbolicPathArgFlag "PATH")
-      -- NB: no --working-dir flag, as that value is populated using the
-      -- global flag (see Distribution.Simple.Setup.Global.globalCommand).
+  , -- NB: no --working-dir flag, as that value is populated using the
+    -- global flag (see Distribution.Simple.Setup.Global.globalCommand).
+    option
+      ""
+      ["keep-temp-files"]
+      ( "Keep temporary files."
+      )
+      setupKeepTempFiles
+      (\v flags -> flags{setupKeepTempFiles = v})
+      trueArg
   ]
 
 withCommonSetupOptions