Add a ghc -show-packages mode to display ghc's view of the package env
authorDuncan Coutts <duncan@well-typed.com>
Sun, 24 Aug 2014 02:38:39 +0000 (03:38 +0100)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 29 Aug 2014 11:39:04 +0000 (12:39 +0100)
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).

compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
ghc/Main.hs

index 7cd2779..3124e29 100644 (file)
@@ -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
 
 
 -- -----------------------------------------------------------------------------
index 9b18a33..af2d3fe 100644 (file)
@@ -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 " "
index 70dde39..8746125 100644 (file)
@@ -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