Correctly propagate --keep-temp-files to old Cabal library versions

This lets the `--keep-temp-files` options to `cabal haddock` and `cabal repl` work with an older Cabal version. Pointed out by @mpickering: haskell#10292 (comment)
MercuryTechnologies · Sep 27, 2024 · 8cefa2c · 8cefa2c
1 parent 5eda50b
commit 8cefa2c
Show file tree

Hide file tree

Showing 3 changed files with 145 additions and 39 deletions.
diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -549,9 +549,11 @@ createHaddockIndex
   -> IO ()
 createHaddockIndex verbosity programDb comp platform mbWorkDir flags = do
   let args = fromHaddockProjectFlags flags
+      tmpFileOpts =
+        commonSetupTempFileOptions $ haddockProjectCommonFlags $ flags
   (haddockProg, _version) <-
     getHaddockProg verbosity programDb comp args (Flag True)
-  runHaddock verbosity mbWorkDir defaultTempFileOptions comp platform haddockProg False args
+  runHaddock verbosity mbWorkDir tmpFileOpts comp platform haddockProg False args
 
 -- ------------------------------------------------------------------------------
 -- Contributions to HaddockArgs (see also Doctest.hs for very similar code).

diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -44,10 +44,14 @@ import Distribution.Client.FileMonitor
 import Distribution.Client.JobControl
 import Distribution.Client.Setup
   ( CommonSetupFlags
-  , filterCommonFlags
+  , filterBenchmarkFlags
+  , filterBuildFlags
   , filterConfigureFlags
+  , filterCopyFlags
   , filterHaddockArgs
   , filterHaddockFlags
+  , filterRegisterFlags
+  , filterReplFlags
   , filterTestFlags
   )
 import Distribution.Client.SetupWrapper
@@ -272,9 +276,7 @@ buildAndRegisterUnpackedPackage
         | otherwise = return ()
 
       mbWorkDir = useWorkingDir scriptOptions
-      commonFlags v =
-        flip filterCommonFlags v $
-          setupHsCommonFlags verbosity mbWorkDir builddir buildSettingKeepTempFiles
+      commonFlags = setupHsCommonFlags verbosity mbWorkDir builddir buildSettingKeepTempFiles
 
       configureCommand = Cabal.configureCommand defaultProgramDb
       configureFlags v =
@@ -284,19 +286,26 @@ buildAndRegisterUnpackedPackage
             plan
             rpkg
             pkgshared
-            (commonFlags v)
+            commonFlags
       configureArgs _ = setupHsConfigureArgs pkg
 
       buildCommand = Cabal.buildCommand defaultProgramDb
-      buildFlags v = setupHsBuildFlags comp_par_strat pkg pkgshared $ commonFlags v
+      buildFlags v =
+        flip filterBuildFlags v $
+          setupHsBuildFlags
+            comp_par_strat
+            pkg
+            pkgshared
+            commonFlags
       buildArgs _ = setupHsBuildArgs pkg
 
       copyFlags destdir v =
-        setupHsCopyFlags
-          pkg
-          pkgshared
-          (commonFlags v)
-          destdir
+        flip filterCopyFlags v $
+          setupHsCopyFlags
+            pkg
+            pkgshared
+            commonFlags
+            destdir
       -- In theory, we could want to copy less things than those that were
       -- built, but instead, we simply copy the targets that were built.
       copyArgs = buildArgs
@@ -306,23 +315,25 @@ buildAndRegisterUnpackedPackage
         flip filterTestFlags v $
           setupHsTestFlags
             pkg
-            (commonFlags v)
+            commonFlags
       testArgs _ = setupHsTestArgs pkg
 
       benchCommand = Cabal.benchmarkCommand
       benchFlags v =
-        setupHsBenchFlags
-          pkg
-          pkgshared
-          (commonFlags v)
+        flip filterBenchmarkFlags v $
+          setupHsBenchFlags
+            pkg
+            pkgshared
+            commonFlags
       benchArgs _ = setupHsBenchArgs pkg
 
       replCommand = Cabal.replCommand defaultProgramDb
       replFlags v =
-        setupHsReplFlags
-          pkg
-          pkgshared
-          (commonFlags v)
+        flip filterReplFlags v $
+          setupHsReplFlags
+            pkg
+            pkgshared
+            commonFlags
       replArgs _ = setupHsReplArgs pkg
 
       haddockCommand = Cabal.haddockCommand
@@ -332,7 +343,7 @@ buildAndRegisterUnpackedPackage
             pkg
             pkgshared
             buildTimeSettings
-            (commonFlags v)
+            commonFlags
       haddockArgs v =
         flip filterHaddockArgs v $
           setupHsHaddockArgs pkg
@@ -394,11 +405,12 @@ buildAndRegisterUnpackedPackage
           distTempDirectory
           $ \pkgConfDest -> do
             let registerFlags v =
-                  setupHsRegisterFlags
-                    pkg
-                    pkgshared
-                    (commonFlags v)
-                    pkgConfDest
+                  flip filterRegisterFlags v $
+                    setupHsRegisterFlags
+                      pkg
+                      pkgshared
+                      commonFlags
+                      pkgConfDest
             setup (Cabal.registerCommand) Cabal.registerCommonFlags (\v -> return (registerFlags v)) (const [])
 
       withLogging :: (Maybe Handle -> IO r) -> IO r

diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
@@ -35,12 +35,15 @@ module Distribution.Client.Setup
   , defaultConfigExFlags
   , buildCommand
   , BuildFlags (..)
+  , filterBuildFlags
   , filterTestFlags
   , replCommand
+  , filterReplFlags
   , testCommand
   , benchmarkCommand
   , testOptions
   , benchmarkOptions
+  , filterBenchmarkFlags
   , configureExOptions
   , reconfigureCommand
   , installCommand
@@ -87,7 +90,9 @@ module Distribution.Client.Setup
   , haddockCommand
   , cleanCommand
   , copyCommand
+  , filterCopyFlags
   , registerCommand
+  , filterRegisterFlags
   , liftOptions
   , yesNoOpt
   ) where
@@ -183,7 +188,7 @@ import Distribution.Simple.InstallDirs
   )
 import Distribution.Simple.Program (ProgramDb, defaultProgramDb)
 import Distribution.Simple.Setup
-  ( BenchmarkFlags
+  ( BenchmarkFlags (benchmarkCommonFlags)
   , BooleanFlag (..)
   , BuildFlags (..)
   , CleanFlags (..)
@@ -192,7 +197,7 @@ import Distribution.Simple.Setup
   , CopyFlags (..)
   , HaddockFlags (..)
   , RegisterFlags (..)
-  , ReplFlags
+  , ReplFlags (..)
   , TestFlags
   , boolOpt
   , boolOpt'
@@ -1146,6 +1151,21 @@ buildCommand =
   where
     parent = Cabal.buildCommand defaultProgramDb
 
+-- | Given some 'BuildFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
+filterBuildFlags :: BuildFlags -> Version -> BuildFlags
+filterBuildFlags flags cabalLibVersion =
+  flags
+    { buildCommonFlags =
+        filterCommonFlags (buildCommonFlags flags) cabalLibVersion
+    }
+
 -- ------------------------------------------------------------
 
 -- * Test flags
@@ -1238,6 +1258,24 @@ replCommand =
   where
     parent = Cabal.replCommand defaultProgramDb
 
+-- | Given some 'ReplFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
+filterReplFlags :: ReplFlags -> Version -> ReplFlags
+filterReplFlags flags cabalLibVersion =
+  flags
+    { replCommonFlags =
+        (filterCommonFlags (replCommonFlags flags) cabalLibVersion)
+          { -- `cabal repl` knew about `--keep-temp-files` before other commands did.
+            setupKeepTempFiles = setupKeepTempFiles (replCommonFlags flags)
+          }
+    }
+
 -- ------------------------------------------------------------
 
 -- * Test command
@@ -1333,6 +1371,21 @@ benchmarkCommand =
     parent = Cabal.benchmarkCommand
     progDb = defaultProgramDb
 
+-- | Given some 'BenchmarkFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
+filterBenchmarkFlags :: BenchmarkFlags -> Version -> BenchmarkFlags
+filterBenchmarkFlags flags cabalLibVersion =
+  flags
+    { benchmarkCommonFlags =
+        filterCommonFlags (benchmarkCommonFlags flags) cabalLibVersion
+    }
+
 -- ------------------------------------------------------------
 
 -- * Fetch command
@@ -2406,21 +2459,28 @@ filterHaddockArgs args cabalLibVersion
     -- Cabal < 2.3 doesn't know about per-component haddock
     args_2_3_0 = []
 
+-- | Given some 'HaddockFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
 filterHaddockFlags :: HaddockFlags -> Version -> HaddockFlags
-filterHaddockFlags flags cabalLibVersion =
-  let flags' = filterHaddockFlags' flags cabalLibVersion
-   in flags'
-        { haddockCommonFlags =
-            filterCommonFlags (haddockCommonFlags flags') cabalLibVersion
-        }
-
-filterHaddockFlags' :: HaddockFlags -> Version -> HaddockFlags
-filterHaddockFlags' flags cabalLibVersion
+filterHaddockFlags flags cabalLibVersion
   | cabalLibVersion >= mkVersion [2, 3, 0] = flags_latest
   | cabalLibVersion < mkVersion [2, 3, 0] = flags_2_3_0
   | otherwise = flags_latest
   where
-    flags_latest = flags
+    flags_latest =
+      flags
+        { haddockCommonFlags =
+            (filterCommonFlags (haddockCommonFlags flags) cabalLibVersion)
+              { -- `cabal haddock` knew about `--keep-temp-files` before other commands did.
+                setupKeepTempFiles = setupKeepTempFiles (haddockCommonFlags flags)
+              }
+        }
 
     flags_2_3_0 =
       flags_latest
@@ -2492,6 +2552,9 @@ testOptions showOrParseArgs =
       | "test-" `isPrefixOf` name = name
       | otherwise = "test-" ++ name
 
+-- | Options for the @bench@ command.
+--
+-- Not to be confused with the @benchmarkOptions@ field of the `BenchmarkFlags` record!
 benchmarkOptions :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
 benchmarkOptions showOrParseArgs =
   [ opt
@@ -3319,6 +3382,35 @@ registerCommand =
     { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-register [FLAGS]\n"
     }
 
+-- | Given some 'RegisterFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
+filterRegisterFlags :: RegisterFlags -> Version -> RegisterFlags
+filterRegisterFlags flags cabalLibVersion =
+  flags
+    { registerCommonFlags =
+        filterCommonFlags (registerCommonFlags flags) cabalLibVersion
+    }
+
+-- | Given some 'CopyFlags' for the version of @Cabal@ that
+-- @cabal-install@ was built with, and a target older 'Version' of
+-- @Cabal@ that we want to pass these flags to, convert the
+-- flags into a form that will be accepted by the older
+-- @Setup@ script.  Generally speaking, this just means filtering
+-- out flags that the old @Cabal@ library doesn't understand, but
+-- in some cases it may also mean "emulating" a feature using
+-- some more legacy flags.
+filterCopyFlags :: CopyFlags -> Version -> CopyFlags
+filterCopyFlags flags cabalLibVersion =
+  flags
+    { copyCommonFlags = filterCommonFlags (copyCommonFlags flags) cabalLibVersion
+    }
+
 -- ------------------------------------------------------------
 
 -- * ActAsSetup flags