Commit ce3da6fe authored by Duncan Coutts's avatar Duncan Coutts

Add --dry-run to upgrade, replacing existing info message

Also adjust the default for --dry-run to be false rather than empty.
parent c76d7fc3
......@@ -62,7 +62,7 @@ install :: Verbosity
-> [UnresolvedDependency]
-> IO ()
install verbosity packageDB repos comp conf configFlags installFlags deps = do
let dryRun = Cabal.fromFlagOrDefault False (installDryRun installFlags)
let dryRun = Cabal.fromFlag (installDryRun installFlags)
buildResults <- if null deps
then installLocalPackage verbosity packageDB repos comp conf configFlags dryRun
else installRepoPackages verbosity packageDB repos comp conf configFlags dryRun deps
......
......@@ -41,7 +41,7 @@ import qualified Distribution.Simple.Setup as Cabal
RegisterFlags(..), emptyRegisterFlags, registerCommand, unregisterCommand,
SDistFlags(..), emptySDistFlags, sdistCommand,
testCommand-})
import Distribution.Simple.Setup (Flag, toFlag, fromFlagOrDefault, flagToList)
import Distribution.Simple.Setup (Flag(..), toFlag, flagToList)
import Distribution.Verbosity (Verbosity, normal, flagToVerbosity, showForCabal)
import Hackage.Types (UnresolvedDependency(..), Username, Password)
......@@ -100,13 +100,16 @@ updateCommand = CommandUI {
commandOptions = \_ -> [optionVerbose id const]
}
upgradeCommand :: CommandUI Cabal.ConfigFlags
upgradeCommand = (Cabal.configureCommand defaultProgramConfiguration) {
upgradeCommand :: CommandUI (Cabal.ConfigFlags, InstallFlags)
upgradeCommand = cabalConfigureCommand {
commandName = "upgrade",
commandSynopsis = "Upgrades installed packages to the latest available version",
commandDescription = Nothing,
commandUsage = usagePackages "upgrade",
commandDefaultFlags = mempty
commandDefaultFlags = (mempty, defaultInstallFlags),
commandOptions = \showOrParseArgs ->
liftOptionsFst (commandOptions cabalConfigureCommand showOrParseArgs)
++ liftOptionsSnd [optionDryRun]
}
{-
......@@ -153,7 +156,7 @@ data InstallFlags = InstallFlags {
defaultInstallFlags :: InstallFlags
defaultInstallFlags = InstallFlags {
installDryRun = mempty
installDryRun = Flag False
}
installCommand :: CommandUI (Cabal.ConfigFlags, InstallFlags)
......@@ -161,19 +164,19 @@ installCommand = cabalConfigureCommand {
commandName = "install",
commandSynopsis = "Installs a list of packages.",
commandUsage = usagePackages "install",
commandDefaultFlags = mempty,
commandDefaultFlags = (mempty, defaultInstallFlags),
commandOptions = \showOrParseArgs ->
liftOptionsFst (commandOptions cabalConfigureCommand showOrParseArgs)
++ liftOptionsSnd [
option [] ["dry-run"]
"Do not install anything, only print what would be installed."
installDryRun (\v flags -> flags { installDryRun = v })
(noArg (toFlag True) (fromFlagOrDefault False))
]
++ liftOptionsSnd [optionDryRun]
}
optionDryRun :: Option InstallFlags
optionDryRun =
option [] ["dry-run"]
"Do not install anything, only print what would be installed."
installDryRun (\v flags -> flags { installDryRun = v })
trueArg
instance Monoid InstallFlags where
mempty = defaultInstallFlags
mappend a b = InstallFlags {
......@@ -217,7 +220,7 @@ uploadCommand = CommandUI {
,option ['c'] ["check"]
"Do not upload, just do QA checks."
uploadCheck (\v flags -> flags { uploadCheck = v })
(noArg (toFlag True) (fromFlagOrDefault False))
trueArg
,option ['u'] ["username"]
"Hackage username."
......@@ -256,6 +259,10 @@ liftOptionsFst = map (liftOption fst (\a (_,b) -> (a,b)))
liftOptionsSnd :: [Option b] -> [Option (a,b)]
liftOptionsSnd = map (liftOption snd (\b (a,_) -> (a,b)))
trueArg {-, falseArg-} :: (b -> Flag Bool) -> (Flag Bool -> b -> b) -> ArgDescr b
trueArg = noArg (Flag True) (\f -> case f of Flag True -> True; _ -> False)
--falseArg = noArg (Flag False) (\f -> case f of Flag False -> True; _ -> False)
optionVerbose :: (flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags)
-> Option flags
......
......@@ -20,10 +20,12 @@ import qualified Hackage.IndexUtils as IndexUtils
import Hackage.Dependency (getUpgradableDeps)
import Hackage.Install (install)
import Hackage.Types (UnresolvedDependency(..), Repo)
import Hackage.Setup (InstallFlags(..))
import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.Simple.Compiler (Compiler, PackageDB)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Package (showPackageId, PackageIdentifier(..), Package(..))
import Distribution.Package (PackageIdentifier(..), Package(..))
import Distribution.Version (VersionRange(..), Dependency(..))
import Distribution.Verbosity (Verbosity)
import qualified Distribution.Simple.Setup as Cabal
......@@ -35,15 +37,13 @@ upgrade :: Verbosity
-> Compiler
-> ProgramConfiguration
-> Cabal.ConfigFlags
-> InstallFlags
-> IO ()
upgrade verbosity packageDB repos comp conf configFlags = do
upgrade verbosity packageDB repos comp conf configFlags installFlags = do
Just installed <- getInstalledPackages verbosity comp packageDB conf
available <- fmap mconcat (mapM (IndexUtils.readRepoIndex verbosity) repos)
let upgradable = getUpgradableDeps installed available
putStrLn "Upgrading the following packages: "
--FIXME: check if upgradable is null
mapM_ putStrLn [showPackageId (packageId x) | x <- upgradable]
install verbosity packageDB repos comp conf configFlags mempty
install verbosity packageDB repos comp conf configFlags installFlags
[UnresolvedDependency (identifierToDependency $ packageId x) []
| x <- upgradable]
......
......@@ -158,17 +158,17 @@ updateAction verbosityFlag _extraArgs = do
config <- loadConfig verbosity configFile
update verbosity (configRepos config)
upgradeAction :: Cabal.ConfigFlags -> [String] -> IO ()
upgradeAction flags _extraArgs = do
upgradeAction :: (Cabal.ConfigFlags, InstallFlags) -> [String] -> IO ()
upgradeAction (cflags,iflags) _extraArgs = do
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlagOrDefault normal (Cabal.configVerbose flags)
let verbosity = fromFlagOrDefault normal (Cabal.configVerbose cflags)
config <- loadConfig verbosity configFile
let flags' = savedConfigToConfigFlags (Cabal.configPackageDB flags) config
`mappend` flags
(comp, conf) <- configCompilerAux flags'
let cflags' = savedConfigToConfigFlags (Cabal.configPackageDB cflags) config
`mappend` cflags
(comp, conf) <- configCompilerAux cflags'
upgrade verbosity
(fromFlag $ Cabal.configPackageDB flags') (configRepos config)
comp conf flags'
(fromFlag $ Cabal.configPackageDB cflags') (configRepos config)
comp conf cflags' iflags
fetchAction :: Flag Verbosity -> [String] -> IO ()
fetchAction verbosityFlag extraArgs = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment