diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 9ec4a104596..eada213fb2f 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/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 }) diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 9db89d67eb2..cbc2a345c90 100644 --- a/cabal-install/main/Main.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/CmdConfigure.hs b/cabal-install/src/Distribution/Client/CmdConfigure.hs index c0366fb1a7c..8dccef515b9 100644 --- a/cabal-install/src/Distribution/Client/CmdConfigure.hs +++ b/cabal-install/src/Distribution/Client/CmdConfigure.hs @@ -5,9 +5,6 @@ module Distribution.Client.CmdConfigure ( configureCommand, configureAction, configureAction', - reconfigureCommand, - reconfigureAction, - reconfigureAction' ) where import Distribution.Client.Compat.Prelude @@ -15,8 +12,8 @@ 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 <> "'" diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index e7277535587..57fac020ccb 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 07f37937524..ec873844b52 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/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, diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 445bf48e42d..2afb210b19c 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/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