Modifying the implementation as per issue haskell#7405

Cabal/src/Distribution/Simple/Setup.hs

@@ -201,6 +201,11 @@ data ConfigFlags = ConfigFlags {
     configPrograms_     :: Option' (Last' ProgramDb), -- ^All programs that
                                                       -- @cabal@ may run
 
+    configAppend        :: Flag Bool, -- ^specifies whether or not the @configure@
+                                      -- command should overwrite or append flags
+    configOverwrite     :: Flag Bool, -- ^specifies whether or not the @configure@
+                                      -- command should backup the configuration
+
     configProgramPaths  :: [(String, FilePath)], -- ^user specified programs paths
     configProgramArgs   :: [(String, [String])], -- ^user specified programs args
     configProgramPathExtra :: NubList FilePath,  -- ^Extend the $PATH
@@ -294,6 +299,8 @@ instance Eq ConfigFlags where
   (==) a b =
     -- configPrograms skipped: not user specified, has no Eq instance
     equal configProgramPaths
+    && equal configAppend
+    && equal configOverwrite
     && equal configProgramArgs
     && equal configProgramPathExtra
     && equal configHcFlavor
@@ -353,6 +360,8 @@ defaultConfigFlags :: ProgramDb -> ConfigFlags
 defaultConfigFlags progDb = emptyConfigFlags {
     configArgs         = [],
     configPrograms_    = Option' (Just (Last' progDb)),
+    configAppend       = NoFlag,
+    configOverwrite    = NoFlag,
     configHcFlavor     = maybe NoFlag Flag defaultCompilerFlavor,
     configVanillaLib   = Flag True,
     configProfLib      = NoFlag,
@@ -462,7 +471,17 @@ configureOptions showOrParseArgs =
          (reqArgFlag "PATH")
       ]
    ++ map liftInstallDirs installDirsOptions
-   ++ [option "" ["program-prefix"]
+   ++ [option "" ["append"]
+          "appending the new config to the old config file"
+          configAppend (\v flags -> flags { configAppend = v })
+          (boolOpt [] [])
+
+      ,option "" ["overwrite"]
+          "the backup of the config file before any alterations"
+          configOverwrite (\v flags -> flags { configOverwrite = v })
+          (boolOpt [] [])
+
+      ,option "" ["program-prefix"]
           "prefix to be applied to installed executables"
           configProgPrefix
           (\v flags -> flags { configProgPrefix = v })

cabal-install/main/Main.hs

@@ -248,7 +248,6 @@ mainWorker args = do
 
       ] ++ concat
       [ newCmd  CmdConfigure.configureCommand   CmdConfigure.configureAction
-      , newCmd  CmdConfigure.reconfigureCommand CmdConfigure.reconfigureAction
       , newCmd  CmdUpdate.updateCommand         CmdUpdate.updateAction
       , newCmd  CmdBuild.buildCommand           CmdBuild.buildAction
       , newCmd  CmdRepl.replCommand             CmdRepl.replAction

cabal-install/src/Distribution/Client/CmdConfigure.hs

@@ -5,18 +5,15 @@ module Distribution.Client.CmdConfigure (
     configureCommand,
     configureAction,
     configureAction',
-    reconfigureCommand,
-    reconfigureAction,
-    reconfigureAction'
   ) where
 
 import Distribution.Client.Compat.Prelude
 import Prelude ()
 
 import System.Directory
 import System.FilePath
-import qualified Data.Map as Map
 
+import Distribution.Simple.Flag
 import Distribution.Client.ProjectOrchestration
 import Distribution.Client.ProjectConfig
          ( writeProjectLocalExtraConfig, readProjectLocalExtraConfig )
@@ -25,8 +22,6 @@ import Distribution.Client.NixStyleOptions
          ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
 import Distribution.Client.Setup
          ( GlobalFlags, ConfigFlags(..) )
-import Distribution.Simple.Flag
-         ( fromFlagOrDefault )
 import Distribution.Verbosity
          ( normal )
 
@@ -101,142 +96,32 @@ configureAction flags extraArgs globalFlags = do
 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
 
-    baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
-
-    -- Write out the @cabal.project.local@ so it gets picked up by the
-    -- planning phase. If old config exists, then print the contents
-    -- before overwriting
-
-    let localFile = distProjectFile (distDirLayout baseCtx) "local"
-        -- | Chooses cabal.project.local~, or if it already exists
-        -- cabal.project.local~0, cabal.project.local~1 etc.
-        firstFreeBackup = firstFreeBackup' (0 :: Int)
-        firstFreeBackup' i = do
-          let backup = localFile <> "~" <> (if i <= 0 then "" else show (i - 1))
-          exists <- doesFileExist backup
-          if exists
-            then firstFreeBackup' (i + 1)
-            else return backup
-
-    -- If cabal.project.local already exists, back up to cabal.project.local~[n]
+    let localFile  = distProjectFile (distDirLayout baseCtx) "local"
+    -- If cabal.project.local already exists, and the flags allow, back up to cabal.project.local~
     exists <- doesFileExist localFile
-    when exists $ do
-        backup <- firstFreeBackup
-        notice verbosity $
-          quote (takeFileName localFile) <> " already exists, backing it up to "
-          <> quote (takeFileName backup) <> "."
-        copyFile localFile backup
-
-    buildCtx <-
-      runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan ->
-
-            -- TODO: Select the same subset of targets as 'CmdBuild' would
-            -- pick (ignoring, for example, executables in libraries
-            -- we depend on). But we don't want it to fail, so actually we
-            -- have to do it slightly differently from build.
-            return (elaboratedPlan, Map.empty)
-
-    let baseCtx' = baseCtx {
-                      buildSettings = (buildSettings baseCtx) {
-                        buildSettingDryRun = True
-                      }
-                    }
-
-    -- TODO: Hmm, but we don't have any targets. Currently this prints
-    -- what we would build if we were to build everything. Could pick
-    -- implicit target like "."
-    --
-    -- TODO: should we say what's in the project (+deps) as a whole?
-    printPlan verbosity baseCtx' buildCtx
-
-    return (baseCtx, cliConfig)
-  where
-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
-    cliConfig = commandLineFlagsToProjectConfig globalFlags flags
-                  mempty -- ClientInstallFlags, not needed here
-    quote s = "'" <> s <> "'"
+    let overwrites = fromFlagOrDefault False $ configOverwrite configFlags
+        appends    = fromFlagOrDefault False $ configAppend    configFlags
+        backup     = localFile ++ "~"
 
-reconfigureCommand :: CommandUI (NixStyleFlags ())
-reconfigureCommand = CommandUI {
-  commandName         = "v2-reconfigure",
-  commandSynopsis     = "Add extra project configuration",
-  commandUsage        = usageAlternatives "v2-reconfigure" [ "[FLAGS]" ],
-  commandDescription  = Just $ \_ -> wrapText $
-        "Adjust how the project is built by setting additional package flags "
-     ++ "and other flags.\n\n"
-
-     ++ "The reconfiguration options are written to the 'cabal.project.local' "
-     ++ "file (or '$project_file.local', if '--project-file' is specified) "
-     ++ "which extends the configuration from the 'cabal.project' file "
-     ++ "(if any).\n\n"
-
-     ++ "The v2-reconfigure command also checks that the project configuration "
-     ++ "will work. In particular it checks that there is a consistent set of "
-     ++ "dependencies for the project as a whole.\n\n"
-
-     ++ "It is never necessary to use the 'v2-reconfigure' command. It is "
-     ++ "merely a convenience in cases where you do not want to specify flags "
-     ++ "to 'v2-build' (and other commands) every time and yet do not want "
-     ++ "to alter the 'cabal.project' persistently.",
-  commandNotes        = Just $ \pname ->
-        "Examples:\n"
-     ++ "  " ++ pname ++ " v2-reconfigure --with-compiler ghc-7.10.3\n"
-     ++ "    Adjust the project configuration to use the given compiler\n"
-     ++ "    program and check the resulting configuration works.\n"
-     ++ "  " ++ pname ++ " v2-reconfigure\n"
-     ++ "    Reset the local configuration to empty and check the overall\n"
-     ++ "    project configuration works.\n"
-
-  , commandDefaultFlags = defaultNixStyleFlags ()
-  , commandOptions      = filter (\o -> optionName o /= "ignore-project")
-                        . nixStyleOptions (const [])
-  }
-
-reconfigureAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
-reconfigureAction flags extraArgs globalFlags = do
-  reconf <- reconfigureAction' flags extraArgs globalFlags
-  let go (baseCtx, projConfig) = 
-        writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig
-
-  either go go reconf
-
-reconfigureAction' 
-    :: NixStyleFlags () 
-    -> [String] 
-    -> GlobalFlags 
-    -> IO (Either (ProjectBaseContext, ProjectConfig) (ProjectBaseContext, ProjectConfig))
-reconfigureAction' flags@NixStyleFlags {..} extraArgs globalFlags = do
-  baseCtx <- establishProjectBaseContext v cliConfig OtherCommand
-
-  let localFile = distProjectFile (distDirLayout baseCtx) "local"
-
-  exists <- doesFileExist localFile
-  if not exists
-    then do
+    when (exists && not overwrites) $ do
       notice v $
-        quote (takeFileName localFile)
-        <> " doesn't exist, calling configure instead."
-
-      -- @configureAction'@ is called, as opposed to @configureAction@, to avoid
-      -- calling on the writing function for configure, thusly maintaining the 
-      -- separation on the behaviour that modify files
-      Left <$> configureAction' flags extraArgs globalFlags
-
-    else do
-      conf <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $
-        readProjectLocalExtraConfig v (distDirLayout baseCtx)
-
-      buildCtx <- runProjectPreBuildPhase v baseCtx $ \plan -> 
-        return (plan, Map.empty)
-
-      printPlan v 
-        (baseCtx {buildSettings = (buildSettings baseCtx) {buildSettingDryRun = True}})
-        buildCtx
-
-      return $ Right (baseCtx, conf <> cliConfig)
-
+        quote (takeFileName localFile) <> " already exists, backing it up to "
+        <> quote (takeFileName backup) <> "."
+      copyFile localFile backup
+
+    -- 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)
   where
     v = fromFlagOrDefault normal (configVerbosity configFlags)
-    cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty
+    cliConfig = commandLineFlagsToProjectConfig globalFlags flags
+                  mempty -- ClientInstallFlags, not needed here
     quote s = "'" <> s <> "'"

cabal-install/src/Distribution/Client/Config.hs

@@ -343,6 +343,8 @@ instance Semigroup SavedConfig where
       combinedSavedConfigureFlags = ConfigFlags {
         configArgs                = lastNonEmpty configArgs,
         configPrograms_           = configPrograms_ . savedConfigureFlags $ b,
+        configAppend              = combine configAppend,
+        configOverwrite           = combine configOverwrite,
         -- TODO: NubListify
         configProgramPaths        = lastNonEmpty configProgramPaths,
         -- TODO: NubListify

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -669,6 +669,8 @@ convertToLegacyAllPackageConfig
     configFlags = ConfigFlags {
       configArgs                = mempty,
       configPrograms_           = mempty,
+      configAppend              = mempty,
+      configOverwrite           = mempty,
       configProgramPaths        = mempty,
       configProgramArgs         = mempty,
       configProgramPathExtra    = mempty,
@@ -741,6 +743,8 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
     configFlags = ConfigFlags {
       configArgs                = mempty,
       configPrograms_           = configPrograms_ mempty,
+      configAppend              = mempty,
+      configOverwrite           = mempty,
       configProgramPaths        = Map.toList (getMapLast packageConfigProgramPaths),
       configProgramArgs         = Map.toList (getMapMappend packageConfigProgramArgs),
       configProgramPathExtra    = packageConfigProgramPathExtra,

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -3316,6 +3316,8 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
     configArgs                = mempty -- unused, passed via args
     configDistPref            = toFlag builddir
     configCabalFilePath       = mempty
+    configAppend              = mempty 
+    configOverwrite           = mempty
     configVerbosity           = toFlag verbosity
 
     configInstantiateWith     = Map.toList elabInstantiatedWith