Commit a4cb9a61 authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang

Add a ghc -show-packages mode to display ghc's view of the package env

You can use ghc -show-packages, in addition to any -package -package-conf
-hide-package, etc flags and see just what ghc's package info looks like.
The format is much like ghc-pkg show.

Like the existing verbose tracing, but a specific mode.
Re-introduce pretty printed package info (Cabal handled this previously).
parent 8955b5ee
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, RecordWildCards #-}
-- |
-- Package configuration information: essentially the interface to Cabal, with
......@@ -23,7 +23,7 @@ module PackageConfig (
installedPackageIdString,
sourcePackageIdString,
packageNameString,
showInstalledPackageInfo,
pprPackageConfig,
) where
#include "HsVersions.h"
......@@ -97,14 +97,35 @@ packageNameString pkg = str
where
PackageName str = packageName pkg
showInstalledPackageInfo :: PackageConfig -> String
showInstalledPackageInfo = show
instance Show ModuleName where
show = moduleNameString
instance Show PackageKey where
show = packageKeyString
pprPackageConfig :: PackageConfig -> SDoc
pprPackageConfig InstalledPackageInfo {..} =
vcat [
field "name" (ppr packageName),
field "version" (text (showVersion packageVersion)),
field "id" (ppr installedPackageId),
field "key" (ppr packageKey),
field "exposed" (ppr exposed),
field "exposed-modules" (fsep (map ppr exposedModules)),
field "hidden-modules" (fsep (map ppr hiddenModules)),
field "reexported-modules" (fsep (map ppr haddockHTMLs)),
field "trusted" (ppr trusted),
field "import-dirs" (fsep (map text importDirs)),
field "library-dirs" (fsep (map text libraryDirs)),
field "hs-libraries" (fsep (map text hsLibraries)),
field "extra-libraries" (fsep (map text extraLibraries)),
field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)),
field "include-dirs" (fsep (map text includeDirs)),
field "includes" (fsep (map text includes)),
field "depends" (fsep (map ppr depends)),
field "cc-options" (fsep (map text ccOptions)),
field "ld-options" (fsep (map text ldOptions)),
field "framework-dirs" (fsep (map text frameworkDirs)),
field "frameworks" (fsep (map text frameworks)),
field "haddock-interfaces" (fsep (map text haddockInterfaces)),
field "haddock-html" (fsep (map text haddockHTMLs))
]
where
field name body = text name <> colon <+> nest 4 body
-- -----------------------------------------------------------------------------
......
......@@ -16,8 +16,6 @@ module Packages (
lookupPackage,
resolveInstalledPackageId,
searchPackageId,
dumpPackages,
simpleDumpPackages,
getPackageDetails,
listVisibleModuleNames,
lookupModuleInAllPackages,
......@@ -42,6 +40,8 @@ module Packages (
-- * Utils
packageKeyPackageIdString,
pprFlag,
pprPackages,
pprPackagesSimple,
pprModuleMap,
isDllName
)
......@@ -63,7 +63,7 @@ import Maybes
import System.Environment ( getEnv )
import FastString
import ErrUtils ( debugTraceMsg, putMsg, MsgDoc )
import ErrUtils ( debugTraceMsg, MsgDoc )
import Exception
import Unique
......@@ -1422,21 +1422,20 @@ isDllName dflags _this_pkg this_mod name
-- -----------------------------------------------------------------------------
-- Displaying packages
-- | Show (very verbose) package info on console, if verbosity is >= 5
dumpPackages :: DynFlags -> IO ()
dumpPackages = dumpPackages' showInstalledPackageInfo
-- | Show (very verbose) package info
pprPackages :: DynFlags -> SDoc
pprPackages = pprPackagesWith pprPackageConfig
dumpPackages' :: (PackageConfig -> String) -> DynFlags -> IO ()
dumpPackages' showIPI dflags
= do putMsg dflags $
vcat (map (text . showIPI)
(listPackageConfigMap dflags))
pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc
pprPackagesWith pprIPI dflags =
vcat (intersperse (text "---") (map pprIPI (listPackageConfigMap dflags)))
-- | Show simplified package info on console, if verbosity == 4.
-- | Show simplified package info.
--
-- The idea is to only print package id, and any information that might
-- be different from the package databases (exposure, trust)
simpleDumpPackages :: DynFlags -> IO ()
simpleDumpPackages = dumpPackages' showIPI
pprPackagesSimple :: DynFlags -> SDoc
pprPackagesSimple = pprPackagesWith (text . showIPI)
where showIPI ipi = let InstalledPackageId i = installedPackageId ipi
e = if exposed ipi then "E" else " "
t = if trusted ipi then "T" else " "
......
......@@ -33,7 +33,7 @@ import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
import Config
import Constants
import HscTypes
import Packages ( dumpPackages, simpleDumpPackages, pprModuleMap )
import Packages ( pprPackages, pprPackagesSimple, pprModuleMap )
import DriverPhases
import BasicTypes ( failed )
import StaticFlags
......@@ -210,7 +210,7 @@ main' postLoadMode dflags0 args flagWarnings = do
---------------- Display configuration -----------
case verbosity dflags6 of
v | v == 4 -> liftIO $ simpleDumpPackages dflags6
v | v == 4 -> liftIO $ dumpPackagesSimple dflags6
| v >= 5 -> liftIO $ dumpPackages dflags6
| otherwise -> return ()
......@@ -237,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do
DoInteractive -> ghciUI srcs Nothing
DoEval exprs -> ghciUI srcs $ Just $ reverse exprs
DoAbiHash -> abiHash srcs
ShowPackages -> liftIO $ showPackages dflags6
liftIO $ dumpFinalStats dflags6
......@@ -435,12 +436,15 @@ data PostLoadMode
| DoInteractive -- ghc --interactive
| DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
| DoAbiHash -- ghc --abi-hash
| ShowPackages -- ghc --show-packages
doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode :: Mode
doMkDependHSMode, doMakeMode, doInteractiveMode,
doAbiHashMode, showPackagesMode :: Mode
doMkDependHSMode = mkPostLoadMode DoMkDependHS
doMakeMode = mkPostLoadMode DoMake
doInteractiveMode = mkPostLoadMode DoInteractive
doAbiHashMode = mkPostLoadMode DoAbiHash
showPackagesMode = mkPostLoadMode ShowPackages
showInterfaceMode :: FilePath -> Mode
showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
......@@ -533,6 +537,7 @@ mode_flags =
, Flag "-show-options" (PassFlag (setMode showOptionsMode))
, Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
, Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
, Flag "-show-packages" (PassFlag (setMode showPackagesMode))
] ++
[ Flag k' (PassFlag (setMode (printSetting k)))
| k <- ["Project version",
......@@ -772,6 +777,11 @@ countFS entries longest has_z (b:bs) =
in
countFS entries' longest' (has_z + has_zs) bs
showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO ()
showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags))
dumpPackages dflags = putMsg dflags (pprPackages dflags)
dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags)
-- -----------------------------------------------------------------------------
-- ABI hash support
......
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