Increase purview of --dry-run and --only-download flags (#7379)

Changes the behavior of the following commands under the `--dry-run` and `--only-download` flags - `v2-configure` and `v2-freeze` do not write their respective files - `v2-exec` and `v2-run` do not run the target executable Adds package tests for the configure and freeze commands. (cherry picked from commit 84884bb) # Conflicts: # cabal-install/src/Distribution/Client/CmdConfigure.hs # cabal-install/src/Distribution/Client/CmdRun.hs
haskell · Jun 5, 2021 · 5e06d7d · 5e06d7d
1 parent 11915ab
commit 5e06d7d
Show file tree

Hide file tree

Showing 13 changed files with 136 additions and 16 deletions.
diff --git a/cabal-install/src/Distribution/Client/CmdConfigure.hs b/cabal-install/src/Distribution/Client/CmdConfigure.hs
@@ -88,6 +88,7 @@ configureCommand = CommandUI {
 -- "Distribution.Client.ProjectOrchestration"
 --
 configureAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
+<<<<<<< HEAD
 configureAction flags@NixStyleFlags {..} _extraArgs globalFlags = do
     --TODO: deal with _extraArgs, since flags with wrong syntax end up there
 
@@ -140,9 +141,59 @@ configureAction flags@NixStyleFlags {..} _extraArgs globalFlags = do
     --
     -- TODO: should we say what's in the project (+deps) as a whole?
     printPlan verbosity baseCtx' buildCtx
+=======
+configureAction flags@NixStyleFlags {..} extraArgs globalFlags = do
+    (baseCtx, projConfig) <- configureAction' flags extraArgs globalFlags
+
+    if shouldNotWriteFile baseCtx
+      then notice v "Config file not written due to flag(s)."
+      else writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig
+  where
+    v = fromFlagOrDefault normal (configVerbosity configFlags)
+
+configureAction' :: NixStyleFlags () -> [String] -> GlobalFlags -> IO (ProjectBaseContext, ProjectConfig)
+configureAction' flags@NixStyleFlags {..} _extraArgs globalFlags = do
+    --TODO: deal with _extraArgs, since flags with wrong syntax end up there
+
+    baseCtx <- establishProjectBaseContext v cliConfig OtherCommand
+
+    let localFile  = distProjectFile (distDirLayout baseCtx) "local"
+    -- If cabal.project.local already exists, and the flags allow, back up to cabal.project.local~
+    let backups = fromFlagOrDefault True  $ configBackup configExFlags
+        appends = fromFlagOrDefault False $ configAppend configExFlags
+        backupFile = localFile <> "~"
+
+    if shouldNotWriteFile baseCtx
+      then
+        return (baseCtx, cliConfig)
+      else do
+        exists <- doesFileExist localFile
+        when (exists && backups) $ do
+          notice v $
+            quote (takeFileName localFile) <> " already exists, backing it up to "
+            <> quote (takeFileName backupFile) <> "."
+          copyFile localFile backupFile
+
+         -- If the flag @configAppend@ is set to true, append and do not overwrite
+        if exists && appends
+          then do
+            conf <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $
+              readProjectLocalExtraConfig v (distDirLayout baseCtx)
+            return (baseCtx, conf <> cliConfig)
+          else
+            return (baseCtx, cliConfig)
+>>>>>>> 84884bbc2 (Increase purview of --dry-run and --only-download flags (#7379))
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
     cliConfig = commandLineFlagsToProjectConfig globalFlags flags
                   mempty -- ClientInstallFlags, not needed here
     quote s = "'" <> s <> "'"
 
+<<<<<<< HEAD
+=======
+-- Config file should not be written when certain flags are present
+shouldNotWriteFile :: ProjectBaseContext -> Bool
+shouldNotWriteFile baseCtx =
+     buildSettingDryRun (buildSettings baseCtx)
+  || buildSettingOnlyDownload (buildSettings baseCtx)
+>>>>>>> 84884bbc2 (Increase purview of --dry-run and --only-download flags (#7379))
diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs
@@ -35,6 +35,7 @@ import Distribution.Client.ProjectOrchestration
   , distDirLayout
   , commandLineFlagsToProjectConfig
   , ProjectBaseContext(..)
+  , BuildTimeSettings(..)
   )
 import Distribution.Client.ProjectPlanOutput
   ( updatePostBuildProjectStatus
@@ -81,6 +82,7 @@ import Distribution.Simple.Utils
   , createDirectoryIfMissingVerbose
   , withTempDirectory
   , wrapText
+  , notice
   )
 import Distribution.Verbosity
   ( normal
@@ -185,7 +187,12 @@ execAction flags@NixStyleFlags {..} extraArgs globalFlags = do
                            argOverrides'
                            program
             invocation = programInvocation program' args
-        runProgramInvocation verbosity invocation
+            dryRun = buildSettingDryRun (buildSettings baseCtx)
+                  || buildSettingOnlyDownload (buildSettings baseCtx)
+
+        if dryRun
+           then notice verbosity "Running of executable suppressed by flag(s)"
+           else runProgramInvocation verbosity invocation
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
     cliConfig = commandLineFlagsToProjectConfig globalFlags flags

diff --git a/cabal-install/src/Distribution/Client/CmdFreeze.hs b/cabal-install/src/Distribution/Client/CmdFreeze.hs
@@ -106,7 +106,8 @@ freezeAction flags@NixStyleFlags {..} extraArgs globalFlags = do
       distDirLayout,
       cabalDirLayout,
       projectConfig,
-      localPackages
+      localPackages,
+      buildSettings
     } <- establishProjectBaseContext verbosity cliConfig OtherCommand
 
     (_, elaboratedPlan, _, totalIndexState, activeRepos) <-
@@ -116,17 +117,21 @@ freezeAction flags@NixStyleFlags {..} extraArgs globalFlags = do
                          localPackages
 
     let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState activeRepos
-    writeProjectLocalFreezeConfig distDirLayout freezeConfig
-    notice verbosity $
-      "Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"
+        dryRun = buildSettingDryRun buildSettings
+              || buildSettingOnlyDownload buildSettings
+
+    if dryRun
+       then notice verbosity "Freeze file not written due to flag(s)"
+       else do
+         writeProjectLocalFreezeConfig distDirLayout freezeConfig
+         notice verbosity $
+           "Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"
 
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
     cliConfig = commandLineFlagsToProjectConfig globalFlags flags
                   mempty -- ClientInstallFlags, not needed here
 
-
-
 -- | Given the install plan, produce a config value with constraints that
 -- freezes the versions of packages used in the plan.
 --

diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs
@@ -46,7 +46,11 @@ import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest)
 import Distribution.Verbosity
          ( normal )
 import Distribution.Simple.Utils
+<<<<<<< HEAD
          ( wrapText, warn, die', ordNub, info
+=======
+         ( wrapText, warn, die', info, notice
+>>>>>>> 84884bbc2 (Increase purview of --dry-run and --only-download flags (#7379))
          , createTempDirectory, handleDoesNotExist )
 import Distribution.Client.ProjectConfig
          ( ProjectConfig(..), ProjectConfigShared(..)
@@ -284,15 +288,21 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do
                                   exeName
                </> exeName
     let args = drop 1 targetStrings
-    runProgramInvocation
-      verbosity
-      emptyProgramInvocation {
-        progInvokePath  = exePath,
-        progInvokeArgs  = args,
-        progInvokeEnv   = dataDirsEnvironmentForPlan
-                            (distDirLayout baseCtx)
-                            elaboratedPlan
-      }
+        dryRun = buildSettingDryRun (buildSettings baseCtx)
+              || buildSettingOnlyDownload (buildSettings baseCtx)
+
+    if dryRun
+       then notice verbosity "Running of executable suppressed by flag(s)"
+       else
+         runProgramInvocation
+           verbosity
+           emptyProgramInvocation {
+             progInvokePath  = exePath,
+             progInvokeArgs  = args,
+             progInvokeEnv   = dataDirsEnvironmentForPlan
+                                 (distDirLayout baseCtx)
+                                 elaboratedPlan
+           }
 
     handleDoesNotExist () (removeDirectoryRecursive tmpDir)
   where

diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -28,6 +28,7 @@ module Distribution.Client.ProjectConfig (
     readProjectConfig,
     readGlobalConfig,
     readProjectLocalFreezeConfig,
+    showProjectConfig,
     withProjectOrGlobalConfig,
     writeProjectLocalExtraConfig,
     writeProjectLocalFreezeConfig,

diff --git a/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/ConfigFile.cabal b/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/ConfigFile.cabal
@@ -0,0 +1,7 @@
+name:                ConfigFile
+version:             0.1.0.0
+author:              Foo Bar
+maintainer:          cabal-dev@haskell.org
+build-type:          Simple
+cabal-version:       >=1.10
+
diff --git a/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/Setup.hs b/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.out b/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.out
@@ -0,0 +1,5 @@
+# cabal v2-configure
+Config file not written due to flag(s).
+# cabal v2-configure
+Config file not written due to flag(s).
+# cabal v2-configure
diff --git a/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.project b/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.test.hs b/cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.test.hs
@@ -0,0 +1,18 @@
+import Test.Cabal.Prelude
+
+-- Test that 'cabal v2-configure' generates the config file appropriately
+main = withShorterPathForNewBuildStore $ \storeDir ->
+  cabalTest . withSourceCopy $ do
+    cwd <- fmap testCurrentDir getTestEnv
+    let configFile = cwd </> "cabal.project.local"
+
+    shouldNotExist configFile
+
+    -- should not create config file with --dry-run or --only-download
+    cabalG ["--store-dir=" ++ storeDir] "v2-configure" ["--dry-run"]
+    cabalG ["--store-dir=" ++ storeDir] "v2-configure" ["--only-download"]
+    shouldNotExist configFile
+
+    -- should create the config file
+    cabalG ["--store-dir=" ++ storeDir] "v2-configure" []
+    shouldExist configFile
diff --git a/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out b/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out
@@ -7,6 +7,10 @@ In order, the following would be built:
  - my-library-dep-2.0 (lib) (requires build)
  - my-local-package-1.0 (exe:my-exe) (first run)
 # cabal v2-freeze
+Freeze file not written due to flag(s)
+# cabal v2-freeze
+Freeze file not written due to flag(s)
+# cabal v2-freeze
 Resolving dependencies...
 Wrote freeze file: <ROOT>/new_freeze.dist/source/cabal.project.freeze
 # cabal v2-build

diff --git a/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs b/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs
@@ -16,6 +16,11 @@ main = withShorterPathForNewBuildStore $ \storeDir ->
       -- v2-build should choose the latest version for the dependency.
       cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["--dry-run"] >>= assertUsesLatestDependency
 
+      -- should not create freeze file with --dry-run or --only-download flags
+      cabalG' ["--store-dir=" ++ storeDir] "v2-freeze" ["--dry-run"]
+      cabalG' ["--store-dir=" ++ storeDir] "v2-freeze" ["--only-download"]
+      shouldNotExist freezeFile
+
       -- Freeze a dependency on the older version.
       cabalG ["--store-dir=" ++ storeDir] "v2-freeze" ["--constraint=my-library-dep==1.0"]
 

diff --git a/changelog.d/pr-7407 b/changelog.d/pr-7407
@@ -0,0 +1,4 @@
+synopsis: --dry-run and --only-download effect v2-configure, v2-freeze, v2-run, and v2-exec
+pr: #7407
+issues: #7379
+decription: { v2-configure, v2-freeze, v2-run, and v2-exec now behave expectedly under the --dry-run and --only-download flags }