Add "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.

Author: Lennart Spitzner

Cabal/Distribution/PackageDescription/Parse.hs

@@ -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)
 
 
 -- -----------------------------------------------------------------------------

Cabal/Distribution/PackageDescription/PrettyPrint.hs

@@ -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

Cabal/Distribution/ParseUtils.hs

@@ -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)

Cabal/Distribution/Simple/Configure.hs

@@ -40,6 +40,7 @@ module Distribution.Simple.Configure (configure,
                                       getInstalledPackages,
                                       getInstalledPackagesMonitorFiles,
                                       getPackageDBContents,
+                                      checkPackageDBs,
                                       configCompiler, configCompilerAux,
                                       configCompilerEx, configCompilerAuxEx,
                                       ccLdOptionsBuildInfo,
@@ -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'?

Cabal/Distribution/Simple/GHC.hs

@@ -36,6 +36,7 @@ module Distribution.Simple.GHC (
         getGhcInfo,
         configure,
         getInstalledPackages,
+        checkPackageDBs,
         getInstalledPackagesMonitorFiles,
         getPackageDBContents,
         buildLib, buildExe,
@@ -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'.

Cabal/Distribution/Simple/Program/HcPkg.hs

@@ -23,6 +23,7 @@ module Distribution.Simple.Program.HcPkg (
     hide,
     dump,
     describe,
+    check,
     list,
 
     -- * Program invocations
@@ -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)
@@ -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) {

Cabal/Distribution/Simple/Utils.hs

@@ -103,6 +103,7 @@ module Distribution.Simple.Utils (
         -- * .cabal and .buildinfo files
         defaultPackageDesc,
         findPackageDesc,
+        listPackageDescs,
         tryFindPackageDesc,
         defaultHookedPackageDesc,
         findHookedPackageDesc,
@@ -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

Cabal/Distribution/Text.hs

@@ -15,6 +15,8 @@ module Distribution.Text (
   Text(..),
   display,
   simpleParse,
+  render,
+  brokenString
   ) where
 
 import qualified Distribution.Compat.ReadP as Parse
@@ -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

Cabal/changelog

@@ -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.

Cabal/doc/installing-packages.markdown

@@ -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

cabal-install/Distribution/Client/Freeze.hs

@@ -14,6 +14,7 @@
 -----------------------------------------------------------------------------
 module Distribution.Client.Freeze (
     freeze,
+    planPackages
   ) where
 
 import Distribution.Client.Config ( SavedConfig(..) )

cabal-install/Distribution/Client/Sandbox.hs

@@ -20,6 +20,7 @@ module Distribution.Client.Sandbox (
     withSandboxBinDirOnSearchPath,
 
     getSandboxConfigFilePath,
+    tryLoadSandboxConfig,
     loadConfigOrSandboxConfig,
     findSavedDistPref,
     initPackageDBIfNeeded,