[commit: Cabal] master: Add --dry-run to upgrade, replacing existing info message (db70834)
Ian Lynagh
igloo at earth.li
Fri Jun 24 01:51:02 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/db70834bcf5ce6b95c4ce41ff616c607bb956567
>---------------------------------------------------------------
commit db70834bcf5ce6b95c4ce41ff616c607bb956567
Author: Duncan Coutts <duncan at haskell.org>
Date: Fri Feb 29 11:07:10 2008 +0000
Add --dry-run to upgrade, replacing existing info message
Also adjust the default for --dry-run to be false rather than empty.
>---------------------------------------------------------------
cabal-install/Hackage/Install.hs | 2 +-
cabal-install/Hackage/Setup.hs | 37 ++++++++++++++++++++++---------------
cabal-install/Hackage/Upgrade.hs | 12 ++++++------
cabal-install/Main.hs | 16 ++++++++--------
4 files changed, 37 insertions(+), 30 deletions(-)
diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs
index 1fbd31d..6047d51 100644
--- a/cabal-install/Hackage/Install.hs
+++ b/cabal-install/Hackage/Install.hs
@@ -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
diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs
index 1c1c7f7..38ea40e 100644
--- a/cabal-install/Hackage/Setup.hs
+++ b/cabal-install/Hackage/Setup.hs
@@ -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
diff --git a/cabal-install/Hackage/Upgrade.hs b/cabal-install/Hackage/Upgrade.hs
index 20a9a32..99e981a 100644
--- a/cabal-install/Hackage/Upgrade.hs
+++ b/cabal-install/Hackage/Upgrade.hs
@@ -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]
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 795a8bc..cf40443 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -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
More information about the Cvs-libraries
mailing list