[commit: ghc] master: Add a ghc -show-packages mode to display ghc's view of the package env (a4cb9a6)
git at git.haskell.org
git at git.haskell.org
Fri Aug 29 14:04:06 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a4cb9a6173f0af76a32b812c022bbdd76b2abfac/ghc
>---------------------------------------------------------------
commit a4cb9a6173f0af76a32b812c022bbdd76b2abfac
Author: Duncan Coutts <duncan at well-typed.com>
Date: Sun Aug 24 03:38:39 2014 +0100
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).
>---------------------------------------------------------------
a4cb9a6173f0af76a32b812c022bbdd76b2abfac
compiler/main/PackageConfig.hs | 41 +++++++++++++++++++++++++++++++----------
compiler/main/Packages.lhs | 27 +++++++++++++--------------
ghc/Main.hs | 16 +++++++++++++---
3 files changed, 57 insertions(+), 27 deletions(-)
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 7cd2779..3124e29 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -1,4 +1,4 @@
-{-# 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
-- -----------------------------------------------------------------------------
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 9b18a33..af2d3fe 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -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 " "
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 70dde39..8746125 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -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
More information about the ghc-commits
mailing list