Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8e3d326a86b3eabde15b54db7e71670d1c8e35ae >--------------------------------------------------------------- commit 8e3d326a86b3eabde15b54db7e71670d1c8e35ae Author: Duncan Coutts <[email protected]> Date: Mon Jan 26 01:09:18 2009 +0000 Add ConfigExFlags into the configure, install and upgrade commands Not yet passed all the way through. >--------------------------------------------------------------- cabal-install/Distribution/Client/Setup.hs | 25 ++++++++++++------------- cabal-install/Main.hs | 24 +++++++++++++++--------- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index d64aa92..87be689 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -285,13 +285,13 @@ updateCommand = CommandUI { commandOptions = \_ -> [optionVerbosity id const] } -upgradeCommand :: CommandUI (ConfigFlags, InstallFlags) +upgradeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags) upgradeCommand = configureCommand { commandName = "upgrade", commandSynopsis = "Upgrades installed packages to the latest available version", commandDescription = Nothing, commandUsage = usagePackages "upgrade", - commandDefaultFlags = (mempty, defaultInstallFlags), + commandDefaultFlags = (mempty, mempty, mempty), commandOptions = commandOptions installCommand } @@ -480,8 +480,8 @@ defaultInstallFlags = InstallFlags { installPreferences = mempty } -installCommand :: CommandUI (ConfigFlags, InstallFlags) -installCommand = configureCommand { +installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags) +installCommand = CommandUI { commandName = "install", commandSynopsis = "Installs a list of packages.", commandUsage = usagePackages "install", @@ -499,11 +499,16 @@ installCommand = configureCommand { ++ " Specific version of a package\n" ++ " " ++ pname ++ " install 'foo < 2' " ++ " Constrained package version\n", - commandDefaultFlags = (mempty, mempty), + commandDefaultFlags = (mempty, mempty, mempty), commandOptions = \showOrParseArgs -> - liftOptionsFst (commandOptions configureCommand showOrParseArgs) ++ - liftOptionsSnd (installOptions showOrParseArgs) + liftOptions get1 set1 (configureOptions showOrParseArgs) + ++ liftOptions get2 set2 (configureExOptions showOrParseArgs) + ++ liftOptions get3 set3 (installOptions showOrParseArgs) } + where + get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c) + get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c) + get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c) installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] installOptions showOrParseArgs = @@ -670,12 +675,6 @@ reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description -> (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList -liftOptionsFst :: [OptionField a] -> [OptionField (a,b)] -liftOptionsFst = map (liftOption fst (\a (_,b) -> (a,b))) - -liftOptionsSnd :: [OptionField b] -> [OptionField (a,b)] -liftOptionsSnd = map (liftOption snd (\b (a,_) -> (a,b))) - liftOptions :: (b -> a) -> (a -> b -> b) -> [OptionField a] -> [OptionField b] liftOptions get set = map (liftOption get set) diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 555be3d..b839e47 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -15,7 +15,8 @@ module Main where import Distribution.Client.Setup ( GlobalFlags(..), globalCommand, globalRepos - , ConfigFlags(..), configureCommand + , ConfigFlags(..) + , ConfigExFlags(..), configureExCommand , InstallFlags(..), installCommand, upgradeCommand , fetchCommand, checkCommand , updateCommand @@ -116,7 +117,7 @@ mainWorker args = ++ " of the Cabal library " commands = - [configureCommand `commandAddAction` configureAction + [configureExCommand `commandAddAction` configureAction ,installCommand `commandAddAction` installAction ,listCommand `commandAddAction` listAction ,infoCommand `commandAddAction` infoAction @@ -161,8 +162,9 @@ wrapperAction command verbosityFlag distPrefFlag = setupWrapper verbosity setupScriptOptions Nothing command (const flags) extraArgs -configureAction :: ConfigFlags -> [String] -> GlobalFlags -> IO () -configureAction configFlags extraArgs globalFlags = do +configureAction :: (ConfigFlags, ConfigExFlags) + -> [String] -> GlobalFlags -> IO () +configureAction (configFlags, configExFlags) extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) config <- loadConfig verbosity (globalConfigFile globalFlags) (configUserInstall configFlags) @@ -174,14 +176,16 @@ configureAction configFlags extraArgs globalFlags = do (configPackageDB' configFlags') (globalRepos globalFlags') comp conf configFlags' installFlags' extraArgs -installAction :: (ConfigFlags, InstallFlags) -> [String] -> GlobalFlags -> IO () -installAction (configFlags, installFlags) _ _globalFlags +installAction :: (ConfigFlags, ConfigExFlags, InstallFlags) + -> [String] -> GlobalFlags -> IO () +installAction (configFlags, _, installFlags) _ _globalFlags | fromFlagOrDefault False (installOnly installFlags) = let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) in setupWrapper verbosity defaultSetupScriptOptions Nothing installCommand (const mempty) [] -installAction (configFlags, installFlags) extraArgs globalFlags = do +installAction (configFlags, configExFlags, installFlags) + extraArgs globalFlags = do pkgs <- either die return (parsePackageArgs extraArgs) let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) config <- loadConfig verbosity (globalConfigFile globalFlags) @@ -236,8 +240,10 @@ updateAction verbosityFlag extraArgs globalFlags = do let globalFlags' = savedGlobalFlags config `mappend` globalFlags update verbosity (globalRepos globalFlags') -upgradeAction :: (ConfigFlags, InstallFlags) -> [String] -> GlobalFlags -> IO () -upgradeAction (configFlags, installFlags) extraArgs globalFlags = do +upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags) + -> [String] -> GlobalFlags -> IO () +upgradeAction (configFlags, configExFlags, installFlags) + extraArgs globalFlags = do pkgs <- either die return (parsePackageArgs extraArgs) let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) config <- loadConfig verbosity (globalConfigFile globalFlags) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
