From e51cff090ed03265984a2d38b9aa42961e78ec40 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 24 Feb 2016 15:55:35 +0100 Subject: [PATCH 1/8] Add a 'status' command. The 'status' command prints a summary over several aspects of a cabal environment, such as the Cabal and GHC versions, the package and its components, the package-databases, the sandbox etc. --- .../Distribution/PackageDescription/Parse.hs | 2 +- .../PackageDescription/PrettyPrint.hs | 2 +- Cabal/Distribution/ParseUtils.hs | 2 +- Cabal/Distribution/Simple/Configure.hs | 24 + Cabal/Distribution/Simple/GHC.hs | 12 + Cabal/Distribution/Simple/Program/HcPkg.hs | 20 + Cabal/Distribution/Simple/Utils.hs | 38 +- Cabal/Distribution/Text.hs | 13 + Cabal/doc/installing-packages.rst | 28 ++ cabal-install/Distribution/Client/Freeze.hs | 3 +- cabal-install/Distribution/Client/Sandbox.hs | 1 + cabal-install/Distribution/Client/Setup.hs | 103 +++++ cabal-install/Distribution/Client/Status.hs | 417 ++++++++++++++++++ cabal-install/Main.hs | 8 + cabal-install/cabal-install.cabal | 1 + cabal-install/changelog | 1 + 16 files changed, 656 insertions(+), 19 deletions(-) create mode 100644 cabal-install/Distribution/Client/Status.hs diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 75bdf20753e..de207c21191 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -63,7 +63,7 @@ import System.Directory (doesFileExist) import Control.Monad (mapM) import Text.PrettyPrint - (vcat, ($$), (<+>), text, render, + (vcat, ($$), (<+>), text, comma, fsep, nest, ($+$), punctuate) diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index 6ca72685dd3..60d4bbd56e8 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -39,7 +39,7 @@ import Distribution.ModuleName import Text.PrettyPrint (hsep, space, parens, char, nest, isEmpty, ($$), (<+>), - colon, text, vcat, ($+$), Doc, render) + colon, text, vcat, ($+$), Doc) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 diff --git a/Cabal/Distribution/ParseUtils.hs b/Cabal/Distribution/ParseUtils.hs index 9c8a72f019a..bcdf499faad 100644 --- a/Cabal/Distribution/ParseUtils.hs +++ b/Cabal/Distribution/ParseUtils.hs @@ -56,7 +56,7 @@ import Distribution.PrettyUtils import Language.Haskell.Extension import Text.PrettyPrint - ( Doc, render, style, renderStyle + ( Doc, style, renderStyle , text, colon, nest, punctuate, comma, sep , fsep, hsep, isEmpty, vcat, mode, Mode (..) , ($+$), (<+>) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 8cd5c161eb2..af90eec1866 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -44,6 +44,7 @@ module Distribution.Simple.Configure (configure, getInstalledPackages, getInstalledPackagesMonitorFiles, getPackageDBContents, + checkPackageDBs, configCompiler, configCompilerAux, configCompilerEx, configCompilerAuxEx, ccLdOptionsBuildInfo, @@ -1269,6 +1270,29 @@ getInstalledPackages verbosity comp packageDBs progdb = do flv -> die $ "don't know how to find the installed packages for " ++ display flv +-- | Check the consistency of the given package databases. +checkPackageDBs :: Verbosity -> Compiler + -> PackageDBStack -- ^ The stack of package databases. + -> ProgramConfiguration + -> IO [(PackageDB, [String])] +checkPackageDBs verbosity comp packageDBs progconf = do + when (null packageDBs) $ + die $ "No package databases have been specified. If you use " + ++ "--package-db=clear, you must follow it with --package-db= " + ++ "with 'global', 'user' or a specific file." + + debug verbosity "checking package-db..." + case compilerFlavor comp of + GHC -> GHC.checkPackageDBs verbosity comp packageDBs progconf + -- GHCJS -> GHCJS.checkPackageDBs verbosity packageDBs progconf + -- JHC -> JHC.checkPackageDBs verbosity packageDBs progconf + -- LHC -> LHC.checkPackageDBs verbosity packageDBs progconf + -- UHC -> UHC.checkPackageDBs verbosity comp packageDBs progconf + -- HaskellSuite {} -> + -- HaskellSuite.checkPackageDBs verbosity packageDBs progconf + flv -> die $ "don't know how to check the packages database for " + ++ display flv + -- | Like 'getInstalledPackages', but for a single package DB. -- -- NB: Why isn't this always a fall through to 'getInstalledPackages'? diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index ac3d815c982..bbbfc302471 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -36,6 +36,7 @@ module Distribution.Simple.GHC ( getGhcInfo, configure, getInstalledPackages, + checkPackageDBs, getInstalledPackagesMonitorFiles, getPackageDBContents, buildLib, buildExe, @@ -300,6 +301,17 @@ getInstalledPackages verbosity comp packagedbs progdb = do _ -> index -- No (or multiple) ghc rts package is registered!! -- Feh, whatever, the ghc test suite does some crazy stuff. +-- | Check the consistency of the given package databases. +checkPackageDBs :: Verbosity -> Compiler -> PackageDBStack + -> ProgramConfiguration + -> IO [(PackageDB, [String])] +checkPackageDBs verbosity comp packagedbs conf = do + checkPackageDbStack comp packagedbs + sequenceA + [ do strs <- HcPkg.check (hcPkgInfo conf) verbosity packagedb + return (packagedb, strs) + | packagedb <- packagedbs ] + -- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a -- @PackageIndex@. Helper function used by 'getPackageDBContents' and -- 'getInstalledPackages'. diff --git a/Cabal/Distribution/Simple/Program/HcPkg.hs b/Cabal/Distribution/Simple/Program/HcPkg.hs index 868e1474372..e397e521335 100644 --- a/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -24,6 +24,7 @@ module Distribution.Simple.Program.HcPkg ( hide, dump, describe, + check, list, -- * Program invocations @@ -269,6 +270,14 @@ splitPkgs = checkEmpty . map unlines . splitWith ("---" ==) . lines _:ws -> splitWith p ws where (ys,zs) = break p xs +-- | Call @hc-pkg@ to check the consistency of the specified package db. +check :: HcPkgInfo -> Verbosity -> PackageDB -> IO [String] +check hpi verbosity packagedb = do + fmap lines $ getProgramInvocationOutput + verbosity + (checkInvocation hpi verbosity packagedb) + `catchExit` \_ -> die $ programId (hcPkgProgram hpi) ++ " dump failed" + mungePackagePaths :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html) @@ -437,6 +446,17 @@ dumpInvocation hpi _verbosity packagedb = -- We use verbosity level 'silent' because it is important that we -- do not contaminate the output with info/debug messages. +checkInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation +checkInvocation hpi _verbosity packagedb = + (programInvocation (hcPkgProgram hpi) args) { + progInvokeOutputEncoding = IOEncodingUTF8 + } + where + args = ["check", packageDbOpts hpi packagedb] + ++ verbosityOpts hpi silent + -- We use verbosity level 'silent' because it is important that we + -- do not contaminate the output with info/debug messages. + listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation listInvocation hpi _verbosity packagedb = (programInvocation (hcPkgProgram hpi) args) { diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index 070c4283a22..ece37fd3333 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -105,6 +105,7 @@ module Distribution.Simple.Utils ( -- * .cabal and .buildinfo files defaultPackageDesc, findPackageDesc, + listPackageDescs, tryFindPackageDesc, defaultHookedPackageDesc, findHookedPackageDesc, @@ -1270,30 +1271,37 @@ defaultPackageDesc _verbosity = tryFindPackageDesc currentDir -- @.cabal@ files. findPackageDesc :: FilePath -- ^Where to look -> NoCallStackIO (Either String FilePath) -- ^.cabal -findPackageDesc dir - = do files <- getDirectoryContents dir - -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal - -- file we filter to exclude dirs and null base file names: - cabalFiles <- filterM doesFileExist - [ dir file - | file <- files - , let (name, ext) = splitExtension file - , not (null name) && ext == ".cabal" ] - case cabalFiles of - [] -> return (Left noDesc) - [cabalFile] -> return (Right cabalFile) - multiple -> return (Left $ multiDesc multiple) - +findPackageDesc dir = do + cabalFiles <- listPackageDescs dir + case cabalFiles of + [] -> return (Left noDesc) + [cabalFile] -> return (Right cabalFile) + multiple -> return (Left $ multiDesc multiple) where noDesc :: String noDesc = "No cabal file found.\n" ++ "Please create a package description file .cabal" - multiDesc :: [String] -> String multiDesc l = "Multiple cabal files found.\n" ++ "Please use only one of: " ++ intercalate ", " l +-- | List all package descriptions in the given directory. +-- +-- In contrast to 'findPackageDesc', finding more than one +-- package description is possible and does not lead +-- to an error/'Left' value. +listPackageDescs :: FilePath -> IO [FilePath] +listPackageDescs dir = do + files <- getDirectoryContents dir + -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal + -- file we filter to exclude dirs and null base file names: + filterM doesFileExist + [ dir file + | file <- files + , let (name, ext) = splitExtension file + , not (null name) && ext == ".cabal" ] + -- |Like 'findPackageDesc', but calls 'die' in case of error. tryFindPackageDesc :: FilePath -> IO FilePath tryFindPackageDesc dir = either die return =<< findPackageDesc dir diff --git a/Cabal/Distribution/Text.hs b/Cabal/Distribution/Text.hs index 54f7fc2640a..a26fe49a396 100644 --- a/Cabal/Distribution/Text.hs +++ b/Cabal/Distribution/Text.hs @@ -17,6 +17,8 @@ module Distribution.Text ( display, simpleParse, stdParse, + render, + brokenString ) where import Prelude () @@ -41,6 +43,17 @@ defaultStyle = Disp.Style { Disp.mode = Disp.PageMode display :: Text a => a -> String display = Disp.renderStyle defaultStyle . disp +-- | similar to Disp.render, but using the Cabal default style +-- (which is different from Text.Prettyprint default). +render :: Disp.Doc -> String +render = Disp.renderStyle defaultStyle + +-- | Takes a string, and turns it into a paragraph-like +-- Doc, i.e. an fsep of the words in it. Main purpose is +-- to produce indented paragraphs. +brokenString :: String -> Disp.Doc +brokenString s = Disp.fsep $ fmap Disp.text $ words s + simpleParse :: Text a => String -> Maybe a simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str , all isSpace s ] of diff --git a/Cabal/doc/installing-packages.rst b/Cabal/doc/installing-packages.rst index bf61ab163f7..5b4ccfd44c1 100644 --- a/Cabal/doc/installing-packages.rst +++ b/Cabal/doc/installing-packages.rst @@ -371,6 +371,34 @@ existing sandbox: $ cabal --ignore-sandbox install text # Installs 'text' in the user package database ('~/.cabal'). +Displaying cabal environment information +---------------------------------------- + +A cabal environment (the directory containing a package) has a certain +state. One example are the flags of the last (successful) +configuration. The ``cabal status`` command will print a summary over +several aspects of the environment, such as + +* the cabal version; + +* the (configured) versions of the compiler and other build-time dependencies; + +* the package, its components and the install-plan; + +* the (contents of) package-databases, the sandbox etc. + +Just ``cabal status`` will display a default selection of information. +Flags can be used to print specific items only; ``cabal status --all`` +will print the full summary. + +Example: + +:: + $ cabal status --compiler + Configured compiler: + ghc-7.10.3 + + Creating a binary package ------------------------- diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs index 4fded488793..0ab73941469 100644 --- a/cabal-install/Distribution/Client/Freeze.hs +++ b/cabal-install/Distribution/Client/Freeze.hs @@ -13,7 +13,8 @@ -- The cabal freeze command ----------------------------------------------------------------------------- module Distribution.Client.Freeze ( - freeze, getFreezePkgs + freeze, getFreezePkgs, + planPackages ) where import Distribution.Client.Config ( SavedConfig(..) ) diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs index 2122f88980d..e4929d6c708 100644 --- a/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal-install/Distribution/Client/Sandbox.hs @@ -21,6 +21,7 @@ module Distribution.Client.Sandbox ( withSandboxBinDirOnSearchPath, getSandboxConfigFilePath, + tryLoadSandboxConfig, loadConfigOrSandboxConfig, findSavedDistPref, initPackageDBIfNeeded, diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 98f909b5046..c4f9cf0ec9c 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -25,6 +25,7 @@ module Distribution.Client.Setup , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , defaultSolver, defaultMaxBackjumps + , defaultFreezeFlags , listCommand, ListFlags(..) , updateCommand , upgradeCommand @@ -32,6 +33,7 @@ module Distribution.Client.Setup , infoCommand, InfoFlags(..) , fetchCommand, FetchFlags(..) , freezeCommand, FreezeFlags(..) + , statusCommand, StatusFlags(..) , genBoundsCommand , getCommand, unpackCommand, GetFlags(..) , checkCommand @@ -176,6 +178,7 @@ globalCommand commands = CommandUI { , "register" , "sandbox" , "exec" + , "status" ] maxlen = maximum $ [length name | (name, _) <- cmdDescs] align str = str ++ replicate (maxlen - length str) ' ' @@ -196,6 +199,7 @@ globalCommand commands = CommandUI { , addCmd "install" , par , addCmd "help" + , addCmd "status" , addCmd "info" , addCmd "list" , addCmd "fetch" @@ -788,6 +792,105 @@ freezeCommand = CommandUI { } +-- ------------------------------------------------------------ +-- * Status command +-- ------------------------------------------------------------ + +data StatusFlags = StatusFlags { + statusVersion :: Flag Bool, + statusProgVersions :: Flag Bool, + statusCompiler :: Flag Bool, + statusPackage :: Flag Bool, + statusPlan :: Flag Bool, + statusSandbox :: Flag Bool, + statusPkgDbs :: Flag Bool, + statusCheckDb :: Flag Bool, + statusAll :: Flag Bool, + statusVerbosity :: Flag Verbosity + } + +defaultStatusFlags :: StatusFlags +defaultStatusFlags = StatusFlags { + statusVersion = toFlag False, + statusProgVersions = toFlag False, + statusCompiler = toFlag False, + statusPackage = toFlag False, + statusPlan = toFlag False, + statusSandbox = toFlag False, + statusPkgDbs = toFlag False, + statusCheckDb = toFlag False, + statusAll = toFlag False, + statusVerbosity = toFlag normal + } + +statusCommand :: CommandUI StatusFlags +statusCommand = CommandUI { + commandName = "status", + commandSynopsis = "Show various cabal/packagedb-related information.", + commandUsage = usageAlternatives "status" [ "[FLAGS]" ], + commandDescription = Just $ \_ -> wrapText $ + "A summary of the state of your cabal environment (for the local" + ++ " folder). Shows all, or a subset of: Various program versions," + ++ " information about the local package (if present)," + ++ " the sandbox (if present), and the package-databases" + ++ " in use (and their contents and consistency).", + commandNotes = Nothing, + commandDefaultFlags = defaultStatusFlags, + commandOptions = \ _showOrParseArgs -> [ + optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v }) + + , option [] ["version"] + "print the version of this program." + statusVersion (\v flags -> flags { statusVersion = v }) + trueArg + + , option [] ["versions"] + "list the versions of all known/related programs" + statusProgVersions (\v flags -> flags { statusProgVersions = v }) + trueArg + + , option [] ["compiler"] + "print the currently configured compiler info" + statusCompiler (\v flags -> flags { statusCompiler = v }) + trueArg + + , option [] ["package"] + (wrapText $ "print information about the package in the" + ++ " current directory") + statusPackage (\v flags -> flags { statusPackage = v }) + trueArg + + , option [] ["plan"] + (wrapText $ "list all packages in the install plan for the current" + ++ " package. Implies --package.") + statusPlan (\v flags -> flags { statusPlan = v }) + trueArg + + , option [] ["sandbox"] + (wrapText $ "print if there is a configured sandbox, and" + ++ " information about it.") + statusSandbox (\v flags -> flags { statusSandbox = v }) + trueArg + + , option [] ["databases"] + (wrapText $ "list all the packages in the global, local" + ++ " and sandbox package databases") + statusPkgDbs (\v flags -> flags { statusPkgDbs = v }) + trueArg + + , option [] ["check"] + "check package-databases for consistency" + statusCheckDb (\v flags -> flags { statusCheckDb = v }) + trueArg + + , option [] ["all"] + "include all the information" + statusAll (\v flags -> flags { statusAll = v }) + trueArg + + ] + } + genBoundsCommand :: CommandUI FreezeFlags genBoundsCommand = CommandUI { commandName = "gen-bounds", diff --git a/cabal-install/Distribution/Client/Status.hs b/cabal-install/Distribution/Client/Status.hs new file mode 100644 index 00000000000..7ae72a2f769 --- /dev/null +++ b/cabal-install/Distribution/Client/Status.hs @@ -0,0 +1,417 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.Status +-- Copyright : (c) Lennart Spitzner 2015 +-- License : BSD-like +-- +-- Maintainer : lsp@informatik.uni-kiel.de +-- Stability : provisional +-- Portability : portable +-- +-- print a summary of info about +-- - versions used +-- - the package (if present) +-- - package databases +-- - the sandbox (if present) +-- - the install plan +-- +----------------------------------------------------------------------------- +module Distribution.Client.Status ( + status + ) where + +import Distribution.Simple.PackageIndex ( allPackages ) +import Distribution.Simple.Program.Db ( configuredPrograms ) +import Distribution.Simple.Program.Types ( ConfiguredProgram(..) ) +import Distribution.Simple.Configure ( tryGetPersistBuildConfig + , checkPackageDBs ) +import Distribution.Simple.Compiler ( PackageDB(..) + , compilerId ) +import Distribution.Simple.BuildPaths ( exeExtension ) +import Distribution.Simple.Utils ( cabalVersion + , rawSystemStdout + , listPackageDescs + , currentDir + , wrapText + ) +import Distribution.Client.Setup ( StatusFlags(..) + , GlobalFlags(..) + , withRepoContext + , defaultFreezeFlags + ) +import Distribution.Client.Config ( defaultCompiler + , SavedConfig(..) + ) +import Distribution.Client.Sandbox ( getSandboxConfigFilePath + , tryLoadSandboxConfig + , loadConfigOrSandboxConfig + , maybeWithSandboxPackageInfo + , maybeWithSandboxDirOnSearchPath + ) +import Distribution.Client.Sandbox.PackageEnvironment ( sandboxPackageDBPath ) +import Distribution.Client.Setup ( configCompilerAux' ) +import Distribution.Client.SetupWrapper ( useDistPref + , defaultSetupScriptOptions ) +import Distribution.Client.Freeze ( planPackages ) +import Distribution.Client.IndexUtils ( getInstalledPackages + , getSourcePackages + ) +import Distribution.Client.Targets ( resolveUserTargets + , UserTarget(..) ) +import Distribution.Client.Types ( SourcePackageDb(..) ) +import Distribution.Solver.Types.PkgConfigDb ( readPkgConfigDb ) +import Distribution.Text ( simpleParse + , display + , disp + , render + , brokenString + ) +import Distribution.Version ( Version(..) + ) +import Distribution.PackageDescription.Parse ( readPackageDescription ) +import Distribution.PackageDescription ( GenericPackageDescription(..) + , package + ) +import Distribution.InstalledPackageInfo ( InstalledPackageInfo(..) ) +import Distribution.Package +import Distribution.Verbosity + +import qualified Distribution.Simple.Setup as Cabal +import qualified Distribution.Simple.LocalBuildInfo as LBI + +import qualified Paths_cabal_install ( version ) + +import Distribution.Client.Compat.ExecutablePath ( getExecutablePath ) +import System.Directory ( doesFileExist ) +import System.FilePath ( splitFileName + , combine + , splitPath + , joinPath + , takeDirectory + , (<.>) + ) +import Control.Monad ( when + , forM + , guard + , forM_ + ) +import Data.Version ( showVersion + ) +import Data.Maybe ( isJust + ) +import Data.List ( groupBy + , sortBy + ) +import Data.Ord ( comparing + ) +import Text.PrettyPrint ( empty + , ($$) + , vcat + , nest + , text + , punctuate + , ($+$) + , (<+>) + ) +import Data.Monoid ( (<>) + ) +import qualified Data.Monoid as Monoid +import Data.List ( inits ) +import Data.Foldable ( asum ) + + + +status :: Verbosity -> GlobalFlags -> StatusFlags -> IO () +status verbosity globalFlags statusFlags = do + (useSandbox, config) <- loadConfigOrSandboxConfig + verbosity + (globalFlags { globalRequireSandbox = Cabal.Flag False }) + (defaultComp, platform, defaultConf) <- configCompilerAux' + $ savedConfigureFlags config + let distPref = useDistPref defaultSetupScriptOptions + -- TODO: this currently only works if the cabal version used for configuring + -- is the same as the one doing the status. would be cool if it would + -- either work or at least indicate this otherwise. + buildConfig <- tryGetPersistBuildConfig distPref + let (comp, conf) = case buildConfig of + Left _ -> (defaultComp, defaultConf) + Right c -> (LBI.compiler c, LBI.withPrograms c) + let globalFlags' = savedGlobalFlags config `Monoid.mappend` globalFlags + sandboxConfigPath <- getSandboxConfigFilePath globalFlags + sandboxConfigExists <- doesFileExist sandboxConfigPath + (sandboxPath, sandboxDbPath) <- if sandboxConfigExists + then do + (sandboxPath, _pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags + return $ ( Just sandboxPath + , Just $ sandboxPackageDBPath sandboxPath comp platform) + else return (Nothing, Nothing) + let dbs :: [PackageDB] -- TODO: it might be better to inspect the currently + -- configured dbs instead of a static global,local,.. + dbs = GlobalPackageDB + : UserPackageDB + : case sandboxDbPath of + Nothing -> [] + Just p -> [SpecificPackageDB p] + let noFlags = not $ any Cabal.fromFlag [ statusVersion statusFlags + , statusProgVersions statusFlags + , statusCompiler statusFlags + , statusPackage statusFlags + , statusPlan statusFlags + , statusSandbox statusFlags + , statusPkgDbs statusFlags + , statusCheckDb statusFlags + , statusAll statusFlags + ] + doAll = Cabal.fromFlag $ statusAll statusFlags + doVersion = Cabal.fromFlag (statusVersion statusFlags) + || doAll || noFlags + doProgVersions = Cabal.fromFlag (statusProgVersions statusFlags) + || doAll + doCompiler = Cabal.fromFlag (statusCompiler statusFlags) + || doAll || noFlags + doPackage = Cabal.fromFlag (statusPackage statusFlags) + || Cabal.fromFlag (statusPlan statusFlags) -- implication + || doAll || noFlags + doPlan = Cabal.fromFlag (statusPlan statusFlags) + || doAll + doSandbox = Cabal.fromFlag (statusSandbox statusFlags) + || doAll || noFlags + doPkgDbs = Cabal.fromFlag (statusPkgDbs statusFlags) + || doAll + doCheckDb = Cabal.fromFlag (statusCheckDb statusFlags) + || doAll + case () of { () -> do + when doVersion printCurrentVersion + -- printOtherCabalCheck is called by printCurrentVersion + when doProgVersions printProgramVersions + when doCompiler printCompiler + when doPackage printPackageInformation + when doSandbox printSandboxInformation + when doPkgDbs printPackageDbs + when doCheckDb printPackageDBChecks + -- printInstallPlan is called by printPackageInformation + where + -- print self version information: + printCurrentVersion :: IO () + -- check if there is a different newer cabal-install installed + -- (with the likely reason of a missing PATH addition): + printOtherCabalCheck :: IO () + -- print external program versions (ghc, ...): + printProgramVersions :: IO () + -- print the configured compiler + printCompiler :: IO () + -- information about the package in the current directory: + printPackageInformation :: IO () + -- print information about the sandbox in the current directory + -- (including a check if a parent directory has a sandbox): + printSandboxInformation :: IO () + -- print which package dbs are currently configured: + printPackageDbs :: IO () + -- ghc-pkg check on the current package dbs (including sandbox, if present) + printPackageDBChecks :: IO () + -- print the install plan (i.e. all configured dependencies); similar + -- to "cabal freeze --dry-run": + printInstallPlan :: IO () + printCurrentVersion = do + putStrLn "Self version:" + putStrLn $ render + $ nest 2 + $ brokenString + $ "cabal-install version " + ++ display Paths_cabal_install.version + ++ " compiled using version " + ++ display cabalVersion + ++ " of the Cabal library." + printOtherCabalCheck + printOtherCabalCheck = do + defInstDirs <- LBI.defaultInstallDirs defaultCompiler True False + let binDir :: FilePath + binDir = LBI.fromPathTemplate + $ LBI.bindir + $ LBI.substituteInstallDirTemplates [] defInstDirs + currentBinDir <- getExecutablePath + when (takeDirectory binDir /= takeDirectory currentBinDir) $ do + let defaultCabalPath = binDir `combine` ("cabal" <.> exeExtension) + exists <- doesFileExist defaultCabalPath + when exists $ do + -- TODO: replace rawSystemStdout by rawSystemStdInOuts + v <- rawSystemStdout verbosity defaultCabalPath ["--version"] + let vs :: [Maybe Version] + vs = map (simpleParse . filter (\x -> x `elem` "0123456789.")) + $ lines v + case vs of + [Just cabalInstallVersion, Just _cabalVersion] -> + if cabalInstallVersion == Paths_cabal_install.version + then return () + else putStrLn $ render + $ nest 2 + $ brokenString + $ " There is a different 'cabal' executable" + ++ " (version " + ++ showVersion cabalInstallVersion + ++ ") located in " ++ binDir + ++ "." + _ -> putStrLn $ render + $ nest 2 + $ brokenString + $ wrapText + $ " Warning: could not parse version of" + ++ " the `cabal` executable located in " + ++ binDir + ++ "." + return () + printProgramVersions = do + putStrLn "Program versions:" + flip mapM_ (configuredPrograms conf) $ \cp -> + case programVersion cp of + Nothing -> return () + Just v -> putStrLn + $ render + $ nest 2 + $ text (programId cp) + <> text "-" + <> disp v + printCompiler = do + putStrLn "Configured compiler:" + case buildConfig of + Left _ -> putStrLn $ " Could not be determined." + Right lbi -> putStrLn $ " " ++ (display $ compilerId $ LBI.compiler lbi) + printPackageInformation = do + putStrLn "Local package(s):" + packageDescs <- listPackageDescs currentDir + case packageDescs of + [] -> putStrLn " No packages in the current directory." + [p] -> do + ppd <- readPackageDescription verbosity p + let packageDesc = packageDescription $ ppd + let packName :: String + packName = unPackageName $ pkgName $ package $ packageDesc + let components :: [String] + components = + ( [ "Library \"" ++ packName ++ "\"" + | isJust (condLibrary ppd) ] + ++ [ "Executable \"" ++ fst e ++ "\"" + | e <- condExecutables ppd] + ++ [ "Testsuite \"" ++ fst t ++ "\"" + | t <- condTestSuites ppd] + ++ [ "Benchmark \"" ++ fst b ++ "\"" + | b <- condBenchmarks ppd] + ) + putStrLn $ render + $ nest 2 + $ text ("Package \"" ++ packName ++ "\" containing " + ++ show (length components) ++ " component(s):") + $$ ( nest 2 + $ vcat + $ fmap text components + ) + when doPlan printInstallPlan + _ -> + putStrLn " Multiple packages in the current directory." + printInstallPlan = do + putStrLn "Install plan:" + installedPkgIndex <- getInstalledPackages + verbosity + comp + dbs + conf + sourcePkgDb <- withRepoContext verbosity + globalFlags' + (getSourcePackages verbosity) + pkgConfigDb <- readPkgConfigDb verbosity conf + pkgSpecifiers <- withRepoContext verbosity + globalFlags' + $ \repoContext -> resolveUserTargets + verbosity + repoContext + (Cabal.fromFlag $ globalWorldFile globalFlags') + (packageIndex sourcePkgDb) + [UserTargetLocalDir "."] + maybeWithSandboxPackageInfo + (lessVerbose verbosity) + (savedConfigureFlags config) + globalFlags' + comp + platform + conf + useSandbox $ \mSandboxPkgInfo -> + maybeWithSandboxDirOnSearchPath useSandbox $ do + planPkgs <- planPackages + (lessVerbose verbosity) + comp + platform + mSandboxPkgInfo + defaultFreezeFlags + installedPkgIndex + sourcePkgDb + pkgConfigDb + pkgSpecifiers + planPkgs `forM_` \pkg -> + let pid = (packageId pkg) + in putStrLn $ " " ++ display (packageName pid) + ++ " == " + ++ showVersion (packageVersion pid) + printSandboxInformation = case (sandboxPath, sandboxDbPath) of + (Just path, Just dbpath) -> do + putStrLn $ "Sandbox: Present in current directory:" + putStrLn $ " config in " ++ sandboxConfigPath + putStrLn $ " sandbox in " ++ path + putStrLn $ " sandbox package db in " ++ dbpath + -- TODO: (optionally) print add-source directories (?) + _ -> do + let (dir,fname) = splitFileName sandboxConfigPath + dirs = splitPath dir + r <- if length dirs <= 1 + then return Nothing + -- test if there is a sandbox is any of the parents + else fmap asum + $ ( fmap joinPath + $ reverse + $ inits + $ init dirs + ) `forM` \path -> -- doesnt exist -> Nothing; otherwise Just path. + fmap (fmap (const path) . guard) + $ doesFileExist + $ combine path fname + putStr "Sandbox: Not present in current directory." + case r of + Nothing -> putStrLn $ "." + Just op -> putStrLn $ ";\n But there is a sandbox in parent:\n " + ++ op + printPackageDbs = do + installedPackageIndex <- getInstalledPackages verbosity comp dbs conf + let pkgs = allPackages installedPackageIndex + pkgTuples = [ (root, disp $ sourcePackageId pkg) + | pkg <- pkgs + , root <- [x | Just x <- [pkgRoot pkg]] + ] + grouped = groupBy (\a b -> fst a == fst b) + $ sortBy (comparing fst) + $ pkgTuples + groups = [(fst (head x), map snd x) | x <- grouped] + let packageDoc ps = if Cabal.fromFlag (statusPkgDbs statusFlags) + || Cabal.fromFlag (statusAll statusFlags) + then nest 2 ( text "(" + <> vcat (punctuate (text ",") ps) + <> text ")") + else empty + putStrLn $ render + $ ( text "Package databases:" + $$ ( nest 2 + $ vcat + $ flip fmap groups + $ \(root, ps) -> + ( text (show (length ps)) + <+> text "packages in database" + <+> text root) + $+$ + packageDoc ps)) + printPackageDBChecks = do + putStrLn $ "Package database checks:" + checks <- checkPackageDBs verbosity comp dbs conf + flip mapM_ checks $ \(db, output) -> if null output + then putStrLn $ " clean for database " ++ show db ++ "." + else do + putStrLn $ " " ++ show db ++ ":" + mapM_ putStrLn output + } diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 11e08c42442..a51250c5c0b 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -27,6 +27,7 @@ import Distribution.Client.Setup , installCommand, upgradeCommand, uninstallCommand , FetchFlags(..), fetchCommand , FreezeFlags(..), freezeCommand + , StatusFlags(..), statusCommand , genBoundsCommand , GetFlags(..), getCommand, unpackCommand , checkCommand @@ -83,6 +84,7 @@ import Distribution.Client.Fetch (fetch) import Distribution.Client.Freeze (freeze) import Distribution.Client.GenBounds (genBounds) import Distribution.Client.Check as Check (check) +import Distribution.Client.Status as Status (status) --import Distribution.Client.Clean (clean) import qualified Distribution.Client.Upload as Upload import Distribution.Client.Run (run, splitRunArgs) @@ -248,6 +250,7 @@ mainWorker args = topHandler $ , regularCmd fetchCommand fetchAction , regularCmd freezeCommand freezeAction , regularCmd getCommand getAction + , regularCmd statusCommand statusAction , hiddenCmd unpackCommand unpackAction , regularCmd checkCommand checkAction , regularCmd sdistCommand sdistAction @@ -857,6 +860,11 @@ freezeAction freezeFlags _extraArgs globalFlags = do mSandboxPkgInfo globalFlags' freezeFlags +statusAction :: StatusFlags -> [String] -> Action +statusAction statusFlags _extraArgs globalFlags = + Status.status (fromFlag $ statusVerbosity statusFlags) globalFlags statusFlags + + genBoundsAction :: FreezeFlags -> [String] -> GlobalFlags -> IO () genBoundsAction freezeFlags _extraArgs globalFlags = do let verbosity = fromFlag (freezeVerbosity freezeFlags) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index f9357d6e4cc..1f3e8e41196 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -293,6 +293,7 @@ executable cabal Distribution.Client.SrcDist Distribution.Client.SolverInstallPlan Distribution.Client.SolverPlanIndex + Distribution.Client.Status Distribution.Client.Tar Distribution.Client.Targets Distribution.Client.Types diff --git a/cabal-install/changelog b/cabal-install/changelog index 84ba9767479..d8fdf8e7fd8 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -24,6 +24,7 @@ '.../$pkgid.log' to '.../$compiler/$libname.log' (#3807). * Added a new command, 'cabal reconfigure', which re-runs 'configure' with the most recently used flags (#2214). + * Added a 'status' command (#3643). 1.24.0.0 Ryan Thomas March 2016 * If there are multiple remote repos, 'cabal update' now updates From 883b2905358afdbc43c9dc84293b53db422a4f31 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Mon, 8 Aug 2016 23:48:23 +0200 Subject: [PATCH 2/8] Improve documentation. --- Cabal/doc/installing-packages.rst | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/Cabal/doc/installing-packages.rst b/Cabal/doc/installing-packages.rst index 5b4ccfd44c1..ed8382dbff6 100644 --- a/Cabal/doc/installing-packages.rst +++ b/Cabal/doc/installing-packages.rst @@ -398,6 +398,25 @@ Example: Configured compiler: ghc-7.10.3 +Full list of options supported by ``cabal status``: + +* ``--version`` -- Print the version of this program. +* ``--versions`` -- List the versions of all known/related programs + (e.g. ``ghc`` and ``ghc-pkg``). +* ``--compiler`` -- Print the currently configured compiler info. +* ``--package`` -- Print information about the package in the current directory. +* ``--plan`` -- List all packages in the install plan for the current + package. Implies ``--package``. +* ``--sandbox`` -- Print information about the currently configured sandbox + (if any). +* ``--databases`` -- List all packages in the global, local and sandbox + package databases +* ``--check`` -- Check package databases for consistency. +* ``--all`` -- Include all the above information. + +Please note that the output of ``cabal status`` is not intended to be +machine parseable and should not be expected to be stable across +versions. Creating a binary package ------------------------- From d3efd42f6bc3e45d9f9536361f8f9ed9159dc149 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Mon, 15 Aug 2016 01:52:44 +0200 Subject: [PATCH 3/8] Move checkProgramDbs to cabal-install. --- Cabal/Distribution/Simple/Configure.hs | 24 ------- cabal-install/Distribution/Client/Status.hs | 74 ++++++++++++--------- 2 files changed, 43 insertions(+), 55 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index af90eec1866..8cd5c161eb2 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -44,7 +44,6 @@ module Distribution.Simple.Configure (configure, getInstalledPackages, getInstalledPackagesMonitorFiles, getPackageDBContents, - checkPackageDBs, configCompiler, configCompilerAux, configCompilerEx, configCompilerAuxEx, ccLdOptionsBuildInfo, @@ -1270,29 +1269,6 @@ getInstalledPackages verbosity comp packageDBs progdb = do flv -> die $ "don't know how to find the installed packages for " ++ display flv --- | Check the consistency of the given package databases. -checkPackageDBs :: Verbosity -> Compiler - -> PackageDBStack -- ^ The stack of package databases. - -> ProgramConfiguration - -> IO [(PackageDB, [String])] -checkPackageDBs verbosity comp packageDBs progconf = do - when (null packageDBs) $ - die $ "No package databases have been specified. If you use " - ++ "--package-db=clear, you must follow it with --package-db= " - ++ "with 'global', 'user' or a specific file." - - debug verbosity "checking package-db..." - case compilerFlavor comp of - GHC -> GHC.checkPackageDBs verbosity comp packageDBs progconf - -- GHCJS -> GHCJS.checkPackageDBs verbosity packageDBs progconf - -- JHC -> JHC.checkPackageDBs verbosity packageDBs progconf - -- LHC -> LHC.checkPackageDBs verbosity packageDBs progconf - -- UHC -> UHC.checkPackageDBs verbosity comp packageDBs progconf - -- HaskellSuite {} -> - -- HaskellSuite.checkPackageDBs verbosity packageDBs progconf - flv -> die $ "don't know how to check the packages database for " - ++ display flv - -- | Like 'getInstalledPackages', but for a single package DB. -- -- NB: Why isn't this always a fall through to 'getInstalledPackages'? diff --git a/cabal-install/Distribution/Client/Status.hs b/cabal-install/Distribution/Client/Status.hs index 7ae72a2f769..c4d32288849 100644 --- a/cabal-install/Distribution/Client/Status.hs +++ b/cabal-install/Distribution/Client/Status.hs @@ -21,45 +21,34 @@ module Distribution.Client.Status ( ) where import Distribution.Simple.PackageIndex ( allPackages ) -import Distribution.Simple.Program.Db ( configuredPrograms ) +import Distribution.Simple.Program.Db ( ProgramDb, configuredPrograms ) import Distribution.Simple.Program.Types ( ConfiguredProgram(..) ) -import Distribution.Simple.Configure ( tryGetPersistBuildConfig - , checkPackageDBs ) -import Distribution.Simple.Compiler ( PackageDB(..) +import Distribution.Simple.Configure ( tryGetPersistBuildConfig ) +import Distribution.Simple.Compiler ( Compiler(..), compilerFlavor + , PackageDB(..), PackageDBStack , compilerId ) import Distribution.Simple.BuildPaths ( exeExtension ) +import qualified Distribution.Simple.GHC as GHC + ( checkPackageDBs ) import Distribution.Simple.Utils ( cabalVersion + , die, debug , rawSystemStdout , listPackageDescs , currentDir , wrapText ) -import Distribution.Client.Setup ( StatusFlags(..) - , GlobalFlags(..) - , withRepoContext - , defaultFreezeFlags - ) -import Distribution.Client.Config ( defaultCompiler - , SavedConfig(..) - ) -import Distribution.Client.Sandbox ( getSandboxConfigFilePath - , tryLoadSandboxConfig - , loadConfigOrSandboxConfig - , maybeWithSandboxPackageInfo - , maybeWithSandboxDirOnSearchPath - ) -import Distribution.Client.Sandbox.PackageEnvironment ( sandboxPackageDBPath ) -import Distribution.Client.Setup ( configCompilerAux' ) -import Distribution.Client.SetupWrapper ( useDistPref - , defaultSetupScriptOptions ) -import Distribution.Client.Freeze ( planPackages ) -import Distribution.Client.IndexUtils ( getInstalledPackages - , getSourcePackages - ) -import Distribution.Client.Targets ( resolveUserTargets - , UserTarget(..) ) -import Distribution.Client.Types ( SourcePackageDb(..) ) -import Distribution.Solver.Types.PkgConfigDb ( readPkgConfigDb ) +import Distribution.Client.Setup hiding ( cabalVersion, packageName ) +import Distribution.Client.Config +import Distribution.Client.Sandbox +import Distribution.Client.Sandbox.PackageEnvironment +import Distribution.Client.SetupWrapper +import Distribution.Client.Freeze +import Distribution.Client.IndexUtils +import Distribution.Client.Targets +import Distribution.Client.Types +import Distribution.Solver.Types.PkgConfigDb + +import Distribution.Compiler ( CompilerFlavor(..) ) import Distribution.Text ( simpleParse , display , disp @@ -81,7 +70,7 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI import qualified Paths_cabal_install ( version ) -import Distribution.Client.Compat.ExecutablePath ( getExecutablePath ) +import Distribution.Client.Compat.ExecutablePath import System.Directory ( doesFileExist ) import System.FilePath ( splitFileName , combine @@ -120,6 +109,29 @@ import Data.List ( inits ) import Data.Foldable ( asum ) +-- | Check the consistency of the given package databases. +checkPackageDBs :: Verbosity -> Compiler + -> PackageDBStack -- ^ The stack of package databases. + -> ProgramDb + -> IO [(PackageDB, [String])] +checkPackageDBs verbosity comp packageDBs progdb = do + when (null packageDBs) $ + die $ "No package databases have been specified. If you use " + ++ "--package-db=clear, you must follow it with --package-db= " + ++ "with 'global', 'user' or a specific file." + + debug verbosity "checking package-db..." + case compilerFlavor comp of + GHC -> GHC.checkPackageDBs verbosity comp packageDBs progdb + -- GHCJS -> GHCJS.checkPackageDBs verbosity packageDBs progdb + -- JHC -> JHC.checkPackageDBs verbosity packageDBs progdb + -- LHC -> LHC.checkPackageDBs verbosity packageDBs progdb + -- UHC -> UHC.checkPackageDBs verbosity comp packageDBs progdb + -- HaskellSuite {} -> + -- HaskellSuite.checkPackageDBs verbosity packageDBs progdb + flv -> die $ "don't know how to check the packages database for " + ++ display flv + status :: Verbosity -> GlobalFlags -> StatusFlags -> IO () status verbosity globalFlags statusFlags = do From cc9cbfb462858626a23762e144c263842c1951fe Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Mon, 15 Aug 2016 02:13:35 +0200 Subject: [PATCH 4/8] Die when the LBI is unreadable. --- cabal-install/Distribution/Client/Status.hs | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/cabal-install/Distribution/Client/Status.hs b/cabal-install/Distribution/Client/Status.hs index c4d32288849..1b2ba2619e9 100644 --- a/cabal-install/Distribution/Client/Status.hs +++ b/cabal-install/Distribution/Client/Status.hs @@ -141,13 +141,12 @@ status verbosity globalFlags statusFlags = do (defaultComp, platform, defaultConf) <- configCompilerAux' $ savedConfigureFlags config let distPref = useDistPref defaultSetupScriptOptions - -- TODO: this currently only works if the cabal version used for configuring - -- is the same as the one doing the status. would be cool if it would - -- either work or at least indicate this otherwise. buildConfig <- tryGetPersistBuildConfig distPref - let (comp, conf) = case buildConfig of - Left _ -> (defaultComp, defaultConf) - Right c -> (LBI.compiler c, LBI.withPrograms c) + (comp, conf, dbs) <- case buildConfig of + Left _ -> die $ "Couldn't load the saved package config file. " + ++ "Most likely reason: the package was configured with a different " + ++ "version of Cabal than the one cabal-install was built with." + Right c -> return (LBI.compiler c, LBI.withPrograms c, LBI.withPackageDB c) let globalFlags' = savedGlobalFlags config `Monoid.mappend` globalFlags sandboxConfigPath <- getSandboxConfigFilePath globalFlags sandboxConfigExists <- doesFileExist sandboxConfigPath @@ -157,13 +156,6 @@ status verbosity globalFlags statusFlags = do return $ ( Just sandboxPath , Just $ sandboxPackageDBPath sandboxPath comp platform) else return (Nothing, Nothing) - let dbs :: [PackageDB] -- TODO: it might be better to inspect the currently - -- configured dbs instead of a static global,local,.. - dbs = GlobalPackageDB - : UserPackageDB - : case sandboxDbPath of - Nothing -> [] - Just p -> [SpecificPackageDB p] let noFlags = not $ any Cabal.fromFlag [ statusVersion statusFlags , statusProgVersions statusFlags , statusCompiler statusFlags From 2f4825d3d12b0b25e3f2e78310ac7e026a81164e Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Mon, 15 Aug 2016 03:32:24 +0200 Subject: [PATCH 5/8] Fix a warning. --- cabal-install/Distribution/Client/Status.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/Status.hs b/cabal-install/Distribution/Client/Status.hs index 1b2ba2619e9..0c0b38a2b49 100644 --- a/cabal-install/Distribution/Client/Status.hs +++ b/cabal-install/Distribution/Client/Status.hs @@ -138,8 +138,8 @@ status verbosity globalFlags statusFlags = do (useSandbox, config) <- loadConfigOrSandboxConfig verbosity (globalFlags { globalRequireSandbox = Cabal.Flag False }) - (defaultComp, platform, defaultConf) <- configCompilerAux' - $ savedConfigureFlags config + (_defaultComp, platform, _defaultConf) <- configCompilerAux' + $ savedConfigureFlags config let distPref = useDistPref defaultSetupScriptOptions buildConfig <- tryGetPersistBuildConfig distPref (comp, conf, dbs) <- case buildConfig of From 4ea8b37ea395bc97067a987190a6aaa4f33f80dc Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Sun, 11 Sep 2016 04:57:17 +0100 Subject: [PATCH 6/8] Fix a warning. --- Cabal/Distribution/Simple/Utils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index ece37fd3333..794a77a74c6 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -1287,11 +1287,11 @@ findPackageDesc dir = do ++ intercalate ", " l -- | List all package descriptions in the given directory. --- +-- -- In contrast to 'findPackageDesc', finding more than one -- package description is possible and does not lead -- to an error/'Left' value. -listPackageDescs :: FilePath -> IO [FilePath] +listPackageDescs :: FilePath -> NoCallStackIO [FilePath] listPackageDescs dir = do files <- getDirectoryContents dir -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal From 57ea046f1f9a2ba973a5711aaeb670d9a9870ce7 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Sun, 11 Sep 2016 16:28:45 +0100 Subject: [PATCH 7/8] s/ProgramConfiguration/ProgramDb/. --- Cabal/Distribution/Simple/GHC.hs | 6 +++--- cabal-install/Distribution/Client/Status.hs | 18 +++++++++--------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index bbbfc302471..b1e3f849612 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -303,12 +303,12 @@ getInstalledPackages verbosity comp packagedbs progdb = do -- | Check the consistency of the given package databases. checkPackageDBs :: Verbosity -> Compiler -> PackageDBStack - -> ProgramConfiguration + -> ProgramDb -> IO [(PackageDB, [String])] -checkPackageDBs verbosity comp packagedbs conf = do +checkPackageDBs verbosity comp packagedbs progdb = do checkPackageDbStack comp packagedbs sequenceA - [ do strs <- HcPkg.check (hcPkgInfo conf) verbosity packagedb + [ do strs <- HcPkg.check (hcPkgInfo progdb) verbosity packagedb return (packagedb, strs) | packagedb <- packagedbs ] diff --git a/cabal-install/Distribution/Client/Status.hs b/cabal-install/Distribution/Client/Status.hs index 0c0b38a2b49..4e2caf0504c 100644 --- a/cabal-install/Distribution/Client/Status.hs +++ b/cabal-install/Distribution/Client/Status.hs @@ -138,11 +138,11 @@ status verbosity globalFlags statusFlags = do (useSandbox, config) <- loadConfigOrSandboxConfig verbosity (globalFlags { globalRequireSandbox = Cabal.Flag False }) - (_defaultComp, platform, _defaultConf) <- configCompilerAux' - $ savedConfigureFlags config + (_defaultComp, platform, _defaultProgDb) <- configCompilerAux' + $ savedConfigureFlags config let distPref = useDistPref defaultSetupScriptOptions buildConfig <- tryGetPersistBuildConfig distPref - (comp, conf, dbs) <- case buildConfig of + (comp, progdb, dbs) <- case buildConfig of Left _ -> die $ "Couldn't load the saved package config file. " ++ "Most likely reason: the package was configured with a different " ++ "version of Cabal than the one cabal-install was built with." @@ -266,7 +266,7 @@ status verbosity globalFlags statusFlags = do return () printProgramVersions = do putStrLn "Program versions:" - flip mapM_ (configuredPrograms conf) $ \cp -> + flip mapM_ (configuredPrograms progdb) $ \cp -> case programVersion cp of Nothing -> return () Just v -> putStrLn @@ -318,11 +318,11 @@ status verbosity globalFlags statusFlags = do verbosity comp dbs - conf + progdb sourcePkgDb <- withRepoContext verbosity globalFlags' (getSourcePackages verbosity) - pkgConfigDb <- readPkgConfigDb verbosity conf + pkgConfigDb <- readPkgConfigDb verbosity progdb pkgSpecifiers <- withRepoContext verbosity globalFlags' $ \repoContext -> resolveUserTargets @@ -337,7 +337,7 @@ status verbosity globalFlags statusFlags = do globalFlags' comp platform - conf + progdb useSandbox $ \mSandboxPkgInfo -> maybeWithSandboxDirOnSearchPath useSandbox $ do planPkgs <- planPackages @@ -383,7 +383,7 @@ status verbosity globalFlags statusFlags = do Just op -> putStrLn $ ";\n But there is a sandbox in parent:\n " ++ op printPackageDbs = do - installedPackageIndex <- getInstalledPackages verbosity comp dbs conf + installedPackageIndex <- getInstalledPackages verbosity comp dbs progdb let pkgs = allPackages installedPackageIndex pkgTuples = [ (root, disp $ sourcePackageId pkg) | pkg <- pkgs @@ -412,7 +412,7 @@ status verbosity globalFlags statusFlags = do packageDoc ps)) printPackageDBChecks = do putStrLn $ "Package database checks:" - checks <- checkPackageDBs verbosity comp dbs conf + checks <- checkPackageDBs verbosity comp dbs progdb flip mapM_ checks $ \(db, output) -> if null output then putStrLn $ " clean for database " ++ show db ++ "." else do From 1c339e6c270d4def5116f617208d3cc103bf9047 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Sun, 11 Sep 2016 16:53:12 +0100 Subject: [PATCH 8/8] Fix documentation formatting. --- Cabal/doc/installing-packages.rst | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/Cabal/doc/installing-packages.rst b/Cabal/doc/installing-packages.rst index ed8382dbff6..3a7d7bce8e3 100644 --- a/Cabal/doc/installing-packages.rst +++ b/Cabal/doc/installing-packages.rst @@ -393,26 +393,28 @@ will print the full summary. Example: -:: +.. code-block:: console + $ cabal status --compiler Configured compiler: ghc-7.10.3 Full list of options supported by ``cabal status``: -* ``--version`` -- Print the version of this program. -* ``--versions`` -- List the versions of all known/related programs - (e.g. ``ghc`` and ``ghc-pkg``). -* ``--compiler`` -- Print the currently configured compiler info. -* ``--package`` -- Print information about the package in the current directory. -* ``--plan`` -- List all packages in the install plan for the current - package. Implies ``--package``. -* ``--sandbox`` -- Print information about the currently configured sandbox - (if any). -* ``--databases`` -- List all packages in the global, local and sandbox - package databases -* ``--check`` -- Check package databases for consistency. -* ``--all`` -- Include all the above information. +- ``--version`` -- Print the version of this program. +- ``--versions`` -- List the versions of all known/related programs + (e.g. ``ghc`` and ``ghc-pkg``). +- ``--compiler`` -- Print the currently configured compiler info. +- ``--package`` -- Print information about the package in the current + directory. +- ``--plan`` -- List all packages in the install plan for the current + package. Implies ``--package``. +- ``--sandbox`` -- Print information about the currently configured sandbox + (if any). +- ``--databases``-- List all packages in the global, local and sandbox + package databases +- ``--check`` -- Check package databases for consistency. +- ``--all`` -- Include all the above information. Please note that the output of ``cabal status`` is not intended to be machine parseable and should not be expected to be stable across