Commit f8b6d010 authored by Duncan Coutts's avatar Duncan Coutts

Add initial implementation of cabal info

It provides more detailed information on a particular package.
Still a few TODOs. Fixes #361, #449 and #456.
parent b02da8c0
This diff is collapsed.
......@@ -17,7 +17,7 @@ module Distribution.Client.Setup
, listCommand, ListFlags(..)
, updateCommand
, upgradeCommand
, infoCommand
, infoCommand, InfoFlags(..)
, fetchCommand
, checkCommand
, uploadCommand, UploadFlags(..)
......@@ -244,16 +244,6 @@ cleanCommand = makeCommand name shortDesc longDesc emptyFlags options
options _ = []
-}
infoCommand :: CommandUI (Flag Verbosity)
infoCommand = CommandUI {
commandName = "info",
commandSynopsis = "Emit some info about dependency resolution",
commandDescription = Nothing,
commandUsage = usagePackages "info",
commandDefaultFlags = toFlag normal,
commandOptions = \_ -> [optionVerbosity id const]
}
checkCommand :: CommandUI (Flag Verbosity)
checkCommand = CommandUI {
commandName = "check",
......@@ -334,7 +324,7 @@ defaultListFlags = ListFlags {
listCommand :: CommandUI ListFlags
listCommand = CommandUI {
commandName = "list",
commandSynopsis = "List available packages on the server (cached).",
commandSynopsis = "List packages matching a search string.",
commandDescription = Nothing,
commandUsage = usagePackages "list",
commandDefaultFlags = defaultListFlags,
......@@ -363,6 +353,38 @@ instance Monoid ListFlags where
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * Info flags
-- ------------------------------------------------------------
data InfoFlags = InfoFlags {
infoVerbosity :: Flag Verbosity
}
defaultInfoFlags :: InfoFlags
defaultInfoFlags = InfoFlags {
infoVerbosity = toFlag normal
}
infoCommand :: CommandUI InfoFlags
infoCommand = CommandUI {
commandName = "info",
commandSynopsis = "Display detailed information about a particular package.",
commandDescription = Nothing,
commandUsage = usagePackages "info",
commandDefaultFlags = defaultInfoFlags,
commandOptions = \_ -> [
optionVerbosity infoVerbosity (\v flags -> flags { infoVerbosity = v })
]
}
instance Monoid InfoFlags where
mempty = defaultInfoFlags
mappend a b = InfoFlags {
infoVerbosity = combine infoVerbosity
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * Install flags
-- ------------------------------------------------------------
......
......@@ -20,6 +20,7 @@ import Distribution.Client.Setup
, fetchCommand, checkCommand
, updateCommand
, ListFlags(..), listCommand
, InfoFlags(..), infoCommand
, UploadFlags(..), uploadCommand
, reportCommand
, unpackCommand, UnpackFlags(..)
......@@ -41,7 +42,7 @@ import Distribution.Client.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Distribution.Client.Config
( SavedConfig(..), loadConfig, defaultConfigFile )
import Distribution.Client.List (list)
import Distribution.Client.List (list, info)
import Distribution.Client.Install (install, upgrade)
import Distribution.Client.Update (update)
import Distribution.Client.Fetch (fetch)
......@@ -117,6 +118,7 @@ mainWorker args =
[configureCommand `commandAddAction` configureAction
,installCommand `commandAddAction` installAction
,listCommand `commandAddAction` listAction
,infoCommand `commandAddAction` infoAction
,updateCommand `commandAddAction` updateAction
,upgradeCommand `commandAddAction` upgradeAction
,fetchCommand `commandAddAction` fetchAction
......@@ -212,6 +214,22 @@ listAction listFlags extraArgs globalFlags = do
listFlags
extraArgs
infoAction :: InfoFlags -> [String] -> GlobalFlags -> IO ()
infoAction infoFlags extraArgs globalFlags = do
pkgs <- either die return (parsePackageArgs extraArgs)
let verbosity = fromFlag (infoVerbosity infoFlags)
config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, conf) <- configCompilerAux configFlags
info verbosity
(configPackageDB' configFlags)
(globalRepos globalFlags')
comp
conf
infoFlags
[ UnresolvedDependency pkg [] | pkg <- pkgs ]
updateAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
updateAction verbosityFlag extraArgs globalFlags = do
unless (null 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