Commit cfcdcd7f authored by Lennart Kolmodin's avatar Lennart Kolmodin

Implement --installed to 'cabal list'

Adding --installed to 'cabal list' will make it print only packages that are
installed.
parent 3e892f21
......@@ -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 $
......
......@@ -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",
......@@ -143,6 +133,47 @@ checkCommand = CommandUI {
commandOptions = mempty
}
-- ------------------------------------------------------------
-- * 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
-- ------------------------------------------------------------
......
......@@ -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
......
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