Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ce3da6fead1f898f4f406c871f19b7e0f2d3f87c >--------------------------------------------------------------- commit ce3da6fead1f898f4f406c871f19b7e0f2d3f87c Author: Duncan Coutts <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
