Skip to content

Commit

Permalink
Add "status" command
Browse files Browse the repository at this point in the history
    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.
  • Loading branch information
Lennart Spitzner committed Feb 23, 2016
1 parent a984914 commit 497caee
Show file tree
Hide file tree
Showing 16 changed files with 659 additions and 25 deletions.
2 changes: 1 addition & 1 deletion Cabal/Distribution/PackageDescription/Parse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ import Control.Arrow (first)
import System.Directory (doesFileExist)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8

import Text.PrettyPrint
import Text.PrettyPrint hiding (render)


-- -----------------------------------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/PackageDescription/PrettyPrint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ import Data.Monoid as Mon (Monoid(mempty))
import Data.Maybe (isJust)
import Text.PrettyPrint
(hsep, parens, char, nest, empty, isEmpty, ($$), (<+>),
colon, (<>), text, vcat, ($+$), Doc, render)
colon, (<>), text, vcat, ($+$), Doc)

-- | Recompile with false for regression testing
simplifiedPrinting :: Bool
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/ParseUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ import Distribution.Text
import Distribution.Simple.Utils
import Language.Haskell.Extension

import Text.PrettyPrint hiding (braces)
import Text.PrettyPrint hiding (braces, render)
import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten)
Expand Down
24 changes: 24 additions & 0 deletions Cabal/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ module Distribution.Simple.Configure (configure,
getInstalledPackages,
getInstalledPackagesMonitorFiles,
getPackageDBContents,
checkPackageDBs,
configCompiler, configCompilerAux,
configCompilerEx, configCompilerAuxEx,
ccLdOptionsBuildInfo,
Expand Down Expand Up @@ -1051,6 +1052,29 @@ getInstalledPackages verbosity comp packageDBs progconf = 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'?
Expand Down
12 changes: 12 additions & 0 deletions Cabal/Distribution/Simple/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ module Distribution.Simple.GHC (
getGhcInfo,
configure,
getInstalledPackages,
checkPackageDBs,
getInstalledPackagesMonitorFiles,
getPackageDBContents,
buildLib, buildExe,
Expand Down Expand Up @@ -292,6 +293,17 @@ getInstalledPackages verbosity comp packagedbs conf = 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
checkPackageDbEnvVar
checkPackageDbStack comp packagedbs
sequence
[ 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'.
Expand Down
20 changes: 20 additions & 0 deletions Cabal/Distribution/Simple/Program/HcPkg.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ module Distribution.Simple.Program.HcPkg (
hide,
dump,
describe,
check,
list,

-- * Program invocations
Expand Down Expand Up @@ -264,6 +265,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)
Expand Down Expand Up @@ -432,6 +441,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) {
Expand Down
38 changes: 23 additions & 15 deletions Cabal/Distribution/Simple/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,7 @@ module Distribution.Simple.Utils (
-- * .cabal and .buildinfo files
defaultPackageDesc,
findPackageDesc,
listPackageDescs,
tryFindPackageDesc,
defaultHookedPackageDesc,
findHookedPackageDesc,
Expand Down Expand Up @@ -1224,30 +1225,37 @@ defaultPackageDesc _verbosity = tryFindPackageDesc currentDir
-- @.cabal@ files.
findPackageDesc :: FilePath -- ^Where to look
-> IO (Either String FilePath) -- ^<pkgname>.cabal
findPackageDesc dir
= do files <- getDirectoryContents dir
-- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.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 <pkgname>.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 <pkgname>.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
Expand Down
28 changes: 22 additions & 6 deletions Cabal/Distribution/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ module Distribution.Text (
Text(..),
display,
simpleParse,
render,
brokenString
) where

import qualified Distribution.Compat.ReadP as Parse
Expand All @@ -27,13 +29,27 @@ class Text a where
disp :: a -> Disp.Doc
parse :: Parse.ReadP r a

-- | Display a 'Text' value with the Cabal default style.
display :: Text a => a -> String
display = Disp.renderStyle style . disp
where style = Disp.Style {
Disp.mode = Disp.PageMode,
Disp.lineLength = 79,
Disp.ribbonsPerLine = 1.0
}
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

defaultStyle :: Disp.Style
defaultStyle = Disp.Style
{ Disp.mode = Disp.PageMode
, Disp.lineLength = 79 -- Disp default: 100
, Disp.ribbonsPerLine = 1.0 -- Disp default: 1.5
}

simpleParse :: Text a => String -> Maybe a
simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str
Expand Down
2 changes: 1 addition & 1 deletion Cabal/changelog
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
-*-change-log-*-

1.25.x.x (current development version)
* No changes yet.
* Add command 'status'

1.24.0.0 Ryan Thomas <[email protected]> February 2016
* Support GHC 8.
Expand Down
27 changes: 27 additions & 0 deletions Cabal/doc/installing-packages.markdown
Original file line number Diff line number Diff line change
Expand Up @@ -349,6 +349,33 @@ $ 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 ##

When creating binary packages (e.g. for Red Hat or Debian) one needs to
Expand Down
1 change: 1 addition & 0 deletions cabal-install/Distribution/Client/Freeze.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
-----------------------------------------------------------------------------
module Distribution.Client.Freeze (
freeze,
planPackages
) where

import Distribution.Client.Config ( SavedConfig(..) )
Expand Down
1 change: 1 addition & 0 deletions cabal-install/Distribution/Client/Sandbox.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module Distribution.Client.Sandbox (
withSandboxBinDirOnSearchPath,

getSandboxConfigFilePath,
tryLoadSandboxConfig,
loadConfigOrSandboxConfig,
findSavedDistPref,
initPackageDBIfNeeded,
Expand Down
Loading

0 comments on commit 497caee

Please sign in to comment.