Commit b6782d85 authored by Duncan Coutts's avatar Duncan Coutts

Adjust the amount of output for the -v verbosity level in a few places

For several commands, including install the -v verbosity level had
far too much useless internall stuff in it. Reduced the amount of
output from configuring the compiler, getting installed package and
the dependency planner. The extra detail is still available via -v3.
parent f17d4bdd
......@@ -43,7 +43,7 @@ import Distribution.PackageDescription.Configuration
import Distribution.Version
( anyVersion, thisVersion )
import Distribution.Simple.Utils as Utils
( notice, info, die )
( notice, info, debug, die )
import Distribution.System
( Platform, buildPlatform )
import Distribution.Verbosity as Verbosity
......@@ -69,8 +69,8 @@ configure verbosity packageDBs repos comp conf
installed available
notice verbosity "Resolving dependencies..."
maybePlan <- foldProgress (\message rest -> info verbosity message >> rest)
(return . Left) (return . Right) progress
maybePlan <- foldProgress logMsg (return . Left) (return . Right)
progress
case maybePlan of
Left message -> do
info verbosity message
......@@ -110,6 +110,8 @@ configure verbosity packageDBs repos comp conf
useWorkingDir = Nothing
}
logMsg message rest = debug verbosity message >> rest
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
......
......@@ -35,7 +35,7 @@ import Distribution.Simple.Program
import Distribution.Simple.Setup
( fromFlag )
import Distribution.Simple.Utils
( die, notice, info )
( die, notice, debug )
import Distribution.System
( buildPlatform )
import Distribution.Text
......@@ -147,7 +147,7 @@ planPackages verbosity comp fetchFlags
$ standardInstallPolicy installed availableDb pkgSpecifiers
includeDependencies = fromFlag (fetchDeps fetchFlags)
logMsg message rest = info verbosity message >> rest
logMsg message rest = debug verbosity message >> rest
checkTarget :: UserTarget -> IO ()
......
......@@ -44,7 +44,8 @@ import Distribution.Version
( Version(Version), intersectVersionRanges )
import Distribution.Text
( simpleParse )
import Distribution.Verbosity (Verbosity)
import Distribution.Verbosity
( Verbosity, lessVerbose )
import Distribution.Simple.Utils
( warn, info, fromUTF8 )
......@@ -71,8 +72,12 @@ getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramConfiguration
-> IO (PackageIndex InstalledPackage)
getInstalledPackages verbosity comp packageDbs conf =
fmap convert (Configure.getInstalledPackages verbosity comp packageDbs conf)
fmap convert (Configure.getInstalledPackages verbosity'
comp packageDbs conf)
where
--FIXME: make getInstalledPackages use sensible verbosity in the first place
verbosity' = lessVerbose verbosity
convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage
convert index = PackageIndex.fromList $
reverse -- because later ones mask earlier ones, but
......
......@@ -106,7 +106,7 @@ import Distribution.PackageDescription.Configuration
import Distribution.Version
( Version, anyVersion, thisVersion )
import Distribution.Simple.Utils as Utils
( notice, info, warn, die, intercalate, withTempDirectory )
( notice, info, debug, warn, die, intercalate, withTempDirectory )
import Distribution.Client.Utils
( inDir, mergeBy, MergeResult(..) )
import Distribution.System
......@@ -180,7 +180,7 @@ install verbosity packageDBs repos comp conf
globalFlags, configFlags, configExFlags, installFlags)
dryRun = fromFlag (installDryRun installFlags)
logMsg message rest = info verbosity message >> rest
logMsg message rest = debug verbosity message >> rest
upgrade _ _ _ _ _ _ _ _ _ _ = die $
......
......@@ -61,8 +61,9 @@ import Distribution.Client.Init (initCabal)
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
import Distribution.Simple.Compiler
( PackageDB(..), PackageDBStack )
import Distribution.Simple.Program (defaultProgramConfiguration)
( Compiler, PackageDB(..), PackageDBStack )
import Distribution.Simple.Program
( ProgramConfiguration, defaultProgramConfiguration )
import Distribution.Simple.Command
import Distribution.Simple.Configure (configCompilerAux)
import Distribution.Simple.Utils
......@@ -70,7 +71,7 @@ import Distribution.Simple.Utils
import Distribution.Text
( display )
import Distribution.Verbosity as Verbosity
( Verbosity, normal, intToVerbosity )
( Verbosity, normal, intToVerbosity, lessVerbose )
import qualified Paths_cabal_install (version)
import System.Environment (getArgs, getProgName)
......@@ -202,7 +203,7 @@ installAction (configFlags, configExFlags, installFlags)
installFlags' = defaultInstallFlags `mappend`
savedInstallFlags config `mappend` installFlags
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, conf) <- configCompilerAux configFlags'
(comp, conf) <- configCompilerAux' configFlags'
install verbosity
(configPackageDB' configFlags') (globalRepos globalFlags')
comp conf globalFlags' configFlags' configExFlags' installFlags'
......@@ -214,7 +215,7 @@ listAction listFlags extraArgs globalFlags = do
config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, conf) <- configCompilerAux configFlags
(comp, conf) <- configCompilerAux' configFlags
list verbosity
(configPackageDB' configFlags)
(globalRepos globalFlags')
......@@ -262,7 +263,7 @@ upgradeAction (configFlags, configExFlags, installFlags)
installFlags' = defaultInstallFlags `mappend`
savedInstallFlags config `mappend` installFlags
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, conf) <- configCompilerAux configFlags'
(comp, conf) <- configCompilerAux' configFlags'
upgrade verbosity
(configPackageDB' configFlags') (globalRepos globalFlags')
comp conf globalFlags' configFlags' configExFlags' installFlags'
......@@ -275,7 +276,7 @@ fetchAction fetchFlags extraArgs globalFlags = do
config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, conf) <- configCompilerAux configFlags
(comp, conf) <- configCompilerAux' configFlags
fetch verbosity
(configPackageDB' configFlags) (globalRepos globalFlags')
comp conf globalFlags' fetchFlags
......@@ -393,3 +394,10 @@ configPackageDB' cfg =
implicitPackageDbStack userInstall (flagToMaybe (configPackageDB cfg))
where
userInstall = fromFlagOrDefault True (configUserInstall cfg)
configCompilerAux' :: ConfigFlags
-> IO (Compiler, ProgramConfiguration)
configCompilerAux' configFlags =
configCompilerAux configFlags
--FIXME: make configCompilerAux use a sensible verbosity
{ configVerbosity = fmap lessVerbose (configVerbosity configFlags) }
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