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

2 files changed, 44 insertions, 24 deletions

diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 7cd2779bc4..3124e292c1 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 9b18a33eae..af2d3fe952 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 " "