Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cfcdcd7f8650a2617bb5bfee0d3c97df60f82774 >--------------------------------------------------------------- commit cfcdcd7f8650a2617bb5bfee0d3c97df60f82774 Author: Lennart Kolmodin <[email protected]> Date: Sat Mar 1 22:27:04 2008 +0000 Implement --installed to 'cabal list' Adding --installed to 'cabal list' will make it print only packages that are installed. >--------------------------------------------------------------- cabal-install/Hackage/List.hs | 35 +++++++++++++++++++------- cabal-install/Hackage/Setup.hs | 53 +++++++++++++++++++++++++++++++-------- cabal-install/Main.hs | 14 +++++++--- 3 files changed, 77 insertions(+), 25 deletions(-) diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs index c800785..9210352 100644 --- a/cabal-install/Hackage/List.hs +++ b/cabal-install/Hackage/List.hs @@ -27,17 +27,26 @@ import Distribution.Version (Version,showVersion) import Distribution.Verbosity (Verbosity) import qualified Hackage.IndexUtils as IndexUtils +import Hackage.Setup (ListFlags(..)) import Hackage.Types (PkgInfo(..), Repo) import Distribution.Simple.Configure as Cabal (getInstalledPackages) import Distribution.Simple.Compiler as Cabal (Compiler,PackageDB) import Distribution.Simple.PackageIndex as Installed import Distribution.Simple.Program as Cabal (ProgramConfiguration) import Distribution.Simple.Utils (equating, comparing, lowercase, notice) +import Distribution.Simple.Setup (fromFlag) import Distribution.InstalledPackageInfo as Installed -- |Show information about packages -list :: Verbosity -> PackageDB -> [Repo] -> Compiler -> ProgramConfiguration -> [String] -> IO () -list verbosity packageDB repos comp conf pats = do +list :: Verbosity + -> PackageDB + -> [Repo] + -> Compiler + -> ProgramConfiguration + -> ListFlags + -> [String] + -> IO () +list verbosity packageDB repos comp conf listFlags pats = do indexes <- mapM (IndexUtils.readRepoIndex verbosity) repos let index = mconcat indexes pkgs | null pats = PackageIndex.allPackages index @@ -63,18 +72,24 @@ list verbosity packageDB repos comp conf pats = do | i <- installed ] ] - putStr - . unlines - . map (showPkgVersions instPkgs) - . groupBy (equating (pkgName . packageId)) - . sortBy (comparing nameAndVersion) - $ pkgs + let matches = + installedFilter instPkgs + . groupBy (equating (pkgName . packageId)) + . sortBy (comparing nameAndVersion) + $ pkgs - where + if null matches + then notice verbosity "No mathes found." + else putStr . unlines . map (showPkgVersions instPkgs) $ matches + + where nameAndVersion p = (lowercase name, name, version) where name = pkgName (packageId p) version = pkgVersion (packageId p) - + installedFilter pkgs + | fromFlag (listInstalled listFlags) = + filter (\p -> Map.member (pkgName . packageId . head $ p) pkgs) + | otherwise = id showPkgVersions :: Map String Version -> [PkgInfo] -> String showPkgVersions installedPkgs pkgs = unlines $ diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs index 38ea40e..d44e8e8 100644 --- a/cabal-install/Hackage/Setup.hs +++ b/cabal-install/Hackage/Setup.hs @@ -14,7 +14,7 @@ module Hackage.Setup ( globalCommand, Cabal.GlobalFlags(..) , configureCommand , installCommand, InstallFlags(..) - , listCommand + , listCommand, ListFlags(..) , updateCommand , upgradeCommand , infoCommand @@ -80,16 +80,6 @@ fetchCommand = CommandUI { commandOptions = \_ -> [optionVerbose id const] } -listCommand :: CommandUI (Flag Verbosity) -listCommand = CommandUI { - commandName = "list", - commandSynopsis = "List available packages on the server (cached).", - commandDescription = Nothing, - commandUsage = usagePackages "list", - commandDefaultFlags = toFlag normal, - commandOptions = \_ -> [optionVerbose id const] - } - updateCommand :: CommandUI (Flag Verbosity) updateCommand = CommandUI { commandName = "update", @@ -144,6 +134,47 @@ checkCommand = CommandUI { } -- ------------------------------------------------------------ +-- * List flags +-- ------------------------------------------------------------ + +data ListFlags = ListFlags { + listInstalled :: Flag Bool, + listVerbosity :: Flag Verbosity + } + +defaultListFlags :: ListFlags +defaultListFlags = ListFlags { + listInstalled = Flag False, + listVerbosity = toFlag normal + } + +listCommand :: CommandUI ListFlags +listCommand = CommandUI { + commandName = "list", + commandSynopsis = "List available packages on the server (cached).", + commandDescription = Nothing, + commandUsage = usagePackages "list", + commandDefaultFlags = mempty, + commandOptions = \_ -> [ + optionVerbose listVerbosity (\v flags -> flags { listVerbosity = v }), + + option "I" ["installed"] + "Only print installed packages" + listInstalled (\v flags -> flags { listInstalled = v }) + trueArg + + ] + } + +instance Monoid ListFlags where + mempty = defaultListFlags + mappend a b = ListFlags { + listInstalled = combine listInstalled, + listVerbosity = combine listVerbosity + } + where combine field = field a `mappend` field b + +-- ------------------------------------------------------------ -- * Install flags -- ------------------------------------------------------------ diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index c6b176e..a5656b9 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -130,14 +130,20 @@ installAction (cflags,iflags) extraArgs = do (fromFlag $ Cabal.configPackageDB cflags') (configRepos config) comp conf cflags' iflags pkgs -listAction :: Cabal.Flag Verbosity -> [String] -> IO () -listAction verbosityFlag extraArgs = do +listAction :: ListFlags -> [String] -> IO () +listAction listFlags extraArgs = do configFile <- defaultConfigFile --FIXME - let verbosity = fromFlag verbosityFlag + let verbosity = fromFlag (listVerbosity listFlags) config <- loadConfig verbosity configFile let flags = savedConfigToConfigFlags (configPackageDB config) config (comp, conf) <- configCompilerAux flags - list verbosity (fromFlag $ Cabal.configPackageDB flags) (configRepos config) comp conf extraArgs + list verbosity + (fromFlag $ Cabal.configPackageDB flags) + (configRepos config) + comp + conf + listFlags + extraArgs updateAction :: Flag Verbosity -> [String] -> IO () updateAction verbosityFlag _extraArgs = do _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
