Print out sub-libraries of packages more nicely.

Previously, we would print out the munged package name
which looked like z-bkpcabal01-z-p-0.1.0.0.  Now
it looks like: bkpcabal01-0.1.0.0:p.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, austin

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3235

5 files changed, 37 insertions, 6 deletions

diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 38b9d4fe5d..d85b80dbc2 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -308,6 +308,8 @@ buildUnit session cid insts lunit = do
             packageName = compat_pn,
             packageVersion = makeVersion [0],
             unitId = toInstalledUnitId (thisPackage dflags),
+            mungedPackageName = Nothing,
+            libName = Nothing,
             componentId = cid,
             instantiatedWith = insts,
             -- Slight inefficiency here haha
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 06678317e7..cb350d7f36 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -97,6 +97,7 @@ import qualified Data.Semigroup as Semigroup
 import qualified Data.Map as Map
 import qualified Data.Map.Strict as MapStrict
 import qualified Data.Set as Set
+import Data.Version
 
 -- ---------------------------------------------------------------------------
 -- The Package state
@@ -1857,9 +1858,15 @@ missingDependencyMsg (Just parent)
 -- -----------------------------------------------------------------------------
 
 componentIdString :: DynFlags -> ComponentId -> Maybe String
-componentIdString dflags cid =
-    fmap sourcePackageIdString (lookupInstalledPackage dflags
-        (componentIdToInstalledUnitId cid))
+componentIdString dflags cid = do
+    conf <- lookupInstalledPackage dflags (componentIdToInstalledUnitId cid)
+    return $
+        case libName conf of
+            Nothing -> sourcePackageIdString conf
+            Just (PackageName libname) ->
+                packageNameString conf
+                    ++ "-" ++ showVersion (packageVersion conf)
+                    ++ ":" ++ unpackFS libname
 
 displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String
 displayInstalledUnitId dflags uid =
diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs
index 7f8468aada..ecd82dd309 100644
--- a/libraries/ghc-boot/GHC/PackageDb.hs
+++ b/libraries/ghc-boot/GHC/PackageDb.hs
@@ -98,6 +98,8 @@ data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulenam
        sourcePackageId    :: srcpkgid,
        packageName        :: srcpkgname,
        packageVersion     :: Version,
+       mungedPackageName  :: Maybe srcpkgname,
+       libName            :: Maybe srcpkgname,
        abiHash            :: String,
        depends            :: [instunitid],
        -- | Like 'depends', but each dependency is annotated with the
@@ -182,6 +184,8 @@ emptyInstalledPackageInfo =
        sourcePackageId    = fromStringRep BS.empty,
        packageName        = fromStringRep BS.empty,
        packageVersion     = Version [] [],
+       mungedPackageName  = Nothing,
+       libName            = Nothing,
        abiHash            = "",
        depends            = [],
        abiDepends         = [],
@@ -440,6 +444,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
   put (InstalledPackageInfo
          unitId componentId instantiatedWith sourcePackageId
          packageName packageVersion
+         mungedPackageName libName
          abiHash depends abiDepends importDirs
          hsLibraries extraLibraries extraGHCiLibraries
          libraryDirs libraryDynDirs
@@ -452,6 +457,8 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
     put (toStringRep sourcePackageId)
     put (toStringRep packageName)
     put packageVersion
+    put (fmap toStringRep mungedPackageName)
+    put (fmap toStringRep libName)
     put (toStringRep unitId)
     put (toStringRep componentId)
     put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))
@@ -484,6 +491,8 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
     sourcePackageId    <- get
     packageName        <- get
     packageVersion     <- get
+    mungedPackageName  <- get
+    libName            <- get
     unitId             <- get
     componentId        <- get
     instantiatedWith   <- get
@@ -516,6 +525,8 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
                 instantiatedWith)
               (fromStringRep sourcePackageId)
               (fromStringRep packageName) packageVersion
+              (fmap fromStringRep mungedPackageName)
+              (fmap fromStringRep libName)
               abiHash
               (map fromStringRep depends)
               (map (\(k,v) -> (fromStringRep k, v)) abiDepends)
diff --git a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr
index 681c541e21..e6a1f31a82 100644
--- a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr
+++ b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stderr
@@ -6,5 +6,5 @@ q/H.hsig:2:1: error:
       Hsig file:  x :: Bool
       The two types are different
     • while merging the signatures from:
-        • z-bkpcabal01-z-p-0.1.0.0[H=<H>]:H
+        • bkpcabal01-0.1.0.0:p[H=<H>]:H
         • ...and the local signature for H
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index c42feecb22..c5ecbf23e1 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -41,6 +41,7 @@ import Distribution.Package hiding (installedUnitId)
 import Distribution.Text
 import Distribution.Version
 import Distribution.Backpack
+import Distribution.Types.UnqualComponentName
 import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File)
 import qualified Data.Version as Version
 import System.FilePath as FilePath
@@ -1243,8 +1244,17 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.componentId        = installedComponentId pkg,
        GhcPkg.instantiatedWith   = instantiatedWith pkg,
        GhcPkg.sourcePackageId    = sourcePackageId pkg,
-       GhcPkg.packageName        = packageName pkg,
+       GhcPkg.packageName        =
+        case sourcePackageName pkg of
+            Nothing -> packageName pkg
+            Just pn -> pn,
        GhcPkg.packageVersion     = Version.Version (versionNumbers (packageVersion pkg)) [],
+       GhcPkg.mungedPackageName  =
+         case sourcePackageName pkg of
+            Nothing -> Nothing
+            Just _  -> Just (packageName pkg),
+       GhcPkg.libName            =
+         fmap (mkPackageName . unUnqualComponentName) (sourceLibName pkg),
        GhcPkg.depends            = depends pkg,
        GhcPkg.abiDepends         = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
        GhcPkg.abiHash            = unAbiHash (abiHash pkg),
@@ -1268,7 +1278,8 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.exposed            = exposed pkg,
        GhcPkg.trusted            = trusted pkg
     }
-  where convertExposed (ExposedModule n reexport) = (n, reexport)
+  where
+    convertExposed (ExposedModule n reexport) = (n, reexport)
 
 instance GhcPkg.BinaryStringRep ComponentId where
   fromStringRep = mkComponentId . fromStringRep