Minor refactoring of Unit display

* for consistency, try to always use UnitPprInfo to display units to
  users

* remove some uses of `unitPackageIdString` as it doesn't show the
  component name and it uses String

7 files changed, 63 insertions, 56 deletions

diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 5b7b79c999..530fb767c3 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -1323,8 +1323,8 @@ linkPackage hsc_env pkg
         all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
         pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
 
-        maybePutStr dflags
-            ("Loading package " ++ unitPackageIdString pkg ++ " ... ")
+        maybePutSDoc dflags
+            (text "Loading unit " <> pprUnitInfoForUser pkg <> text " ... ")
 
         -- See comments with partOfGHCi
 #if defined(CAN_LOAD_DLL)
@@ -1354,9 +1354,9 @@ linkPackage hsc_env pkg
 
         if succeeded ok
            then maybePutStrLn dflags "done."
-           else let errmsg = "unable to load package `"
-                             ++ unitPackageIdString pkg ++ "'"
-                 in throwGhcExceptionIO (InstallationError errmsg)
+           else let errmsg = text "unable to load unit `"
+                             <> pprUnitInfoForUser pkg <> text "'"
+                 in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg))
 
 {-
 Note [Crash early load_dyn and locateLib]
@@ -1731,14 +1731,17 @@ loadFramework hsc_env extraPaths rootname
 
   ********************************************************************* -}
 
-maybePutStr :: DynFlags -> String -> IO ()
-maybePutStr dflags s
+maybePutSDoc :: DynFlags -> SDoc -> IO ()
+maybePutSDoc dflags s
     = when (verbosity dflags > 1) $
           putLogMsg dflags
               NoReason
               SevInteractive
               noSrcSpan
-              $ withPprStyle defaultUserStyle (text s)
+              $ withPprStyle defaultUserStyle s
+
+maybePutStr :: DynFlags -> String -> IO ()
+maybePutStr dflags s = maybePutSDoc dflags (text s)
 
 maybePutStrLn :: DynFlags -> String -> IO ()
 maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n")
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index ee51086e13..002fb1b6a9 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -168,8 +168,9 @@ mkUnit p
    | otherwise          = RealUnit (Definite (unitId p))
 
 -- | Create a UnitPprInfo from a UnitInfo
-mkUnitPprInfo :: GenUnitInfo u -> UnitPprInfo
-mkUnitPprInfo i = UnitPprInfo
+mkUnitPprInfo :: (u -> FastString) -> GenUnitInfo u -> UnitPprInfo
+mkUnitPprInfo ufs i = UnitPprInfo
+   (ufs (unitId i))
    (unitPackageNameString i)
    (unitPackageVersion i)
    ((unpackFS . unPackageName) <$> unitComponentName i)
diff --git a/compiler/GHC/Unit/Ppr.hs b/compiler/GHC/Unit/Ppr.hs
index 6c11dae34e..be969ea0f9 100644
--- a/compiler/GHC/Unit/Ppr.hs
+++ b/compiler/GHC/Unit/Ppr.hs
@@ -5,6 +5,7 @@ module GHC.Unit.Ppr
 where
 
 import GHC.Prelude
+import GHC.Data.FastString
 import GHC.Utils.Outputable
 import Data.Version
 
@@ -14,18 +15,22 @@ import Data.Version
 --    package-version:componentname
 --
 data UnitPprInfo = UnitPprInfo
-   { unitPprPackageName    :: String       -- ^ Source package name
+   { unitPprId             :: FastString   -- ^ Identifier
+   , unitPprPackageName    :: String       -- ^ Source package name
    , unitPprPackageVersion :: Version      -- ^ Source package version
    , unitPprComponentName  :: Maybe String -- ^ Component name
    }
 
 instance Outputable UnitPprInfo where
-  ppr pprinfo = text $ mconcat
-      [ unitPprPackageName pprinfo
-      , case unitPprPackageVersion pprinfo of
-         Version [] [] -> ""
-         version       -> "-" ++ showVersion version
-      , case unitPprComponentName pprinfo of
-         Nothing    -> ""
-         Just cname -> ":" ++ cname
-      ]
+  ppr pprinfo = getPprDebug $ \debug ->
+    if debug
+       then ftext (unitPprId pprinfo)
+       else text $ mconcat
+         [ unitPprPackageName pprinfo
+         , case unitPprPackageVersion pprinfo of
+            Version [] [] -> ""
+            version       -> "-" ++ showVersion version
+         , case unitPprComponentName pprinfo of
+            Nothing    -> ""
+            Just cname -> ":" ++ cname
+         ]
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 2efd9626e6..6406e79e07 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -28,7 +28,6 @@ module GHC.Unit.State (
         lookupPackageName,
         improveUnit,
         searchPackageId,
-        displayUnitId,
         listVisibleModuleNames,
         lookupModuleInAllUnits,
         lookupModuleWithSuggestions,
@@ -61,14 +60,18 @@ module GHC.Unit.State (
         instUnitToUnit,
         instModuleToModule,
 
-        -- * Utils
-        mkIndefUnitId,
-        updateIndefUnitId,
-        unwireUnit,
+        -- * Pretty-printing
         pprFlag,
         pprUnits,
         pprUnitsSimple,
+        pprUnitIdForUser,
+        pprUnitInfoForUser,
         pprModuleMap,
+
+        -- * Utils
+        mkIndefUnitId,
+        updateIndefUnitId,
+        unwireUnit,
         homeUnitIsIndefinite,
         homeUnitIsDefinite,
     )
@@ -81,6 +84,7 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.Unit.Database
 import GHC.Unit.Info
+import GHC.Unit.Ppr
 import GHC.Unit.Types
 import GHC.Unit.Module
 import GHC.Driver.Session
@@ -887,7 +891,7 @@ findPackages prec_map pkg_map closure arg pkgs unusable
         else Right (sortByPreference prec_map ps)
   where
     finder (PackageArg str) p
-      = if str == unitPackageIdString p || str == unitPackageNameString p
+      = if matchingStr str p
           then Just p
           else Nothing
     finder (UnitIdArg uid) p
@@ -2100,6 +2104,8 @@ add_unit pkg_map ps (p, mb_parent)
 
 -- -----------------------------------------------------------------------------
 
+-- | Pretty-print a UnitId for the user.
+--
 -- Cabal packages may contain several components (programs, libraries, etc.).
 -- As far as GHC is concerned, installed package components ("units") are
 -- identified by an opaque IndefUnitId string provided by Cabal. As the string
@@ -2111,26 +2117,30 @@ add_unit pkg_map ps (p, mb_parent)
 --
 -- Component name is only displayed if it isn't the default library
 --
--- To do this we need to query the database (cached in DynFlags). We cache
--- these details in the IndefUnitId itself because we don't want to query
--- DynFlags each time we pretty-print the IndefUnitId
---
+-- To do this we need to query a unit database.
+pprUnitIdForUser :: UnitState -> UnitId -> SDoc
+pprUnitIdForUser state uid@(UnitId fs) =
+   case lookupUnitPprInfo state uid of
+      Nothing -> ftext fs -- we didn't find the unit at all
+      Just i  -> ppr i
+
+pprUnitInfoForUser :: UnitInfo -> SDoc
+pprUnitInfoForUser info = ppr (mkUnitPprInfo unitIdFS info)
+
+lookupUnitPprInfo :: UnitState -> UnitId -> Maybe UnitPprInfo
+lookupUnitPprInfo state uid = fmap (mkUnitPprInfo unitIdFS) (lookupUnitId state uid)
+
+-- | Create a IndefUnitId.
 mkIndefUnitId :: UnitState -> FastString -> IndefUnitId
-mkIndefUnitId pkgstate raw =
+mkIndefUnitId state raw =
     let uid = UnitId raw
-    in case lookupUnitId pkgstate uid of
-         Nothing -> Indefinite uid Nothing -- we didn't find the unit at all
-         Just c  -> Indefinite uid $ Just $ mkUnitPprInfo c
+    in Indefinite uid $! lookupUnitPprInfo state uid
 
 -- | Update component ID details from the database
 updateIndefUnitId :: UnitState -> IndefUnitId -> IndefUnitId
 updateIndefUnitId pkgstate uid = mkIndefUnitId pkgstate (unitIdFS (indefUnit uid))
 
 
-displayUnitId :: UnitState -> UnitId -> Maybe String
-displayUnitId pkgstate uid =
-    fmap unitPackageIdString (lookupUnitId pkgstate uid)
-
 -- -----------------------------------------------------------------------------
 -- Displaying packages
 
diff --git a/compiler/GHC/Unit/State.hs-boot b/compiler/GHC/Unit/State.hs-boot
index cc77d2b478..f03c12fac3 100644
--- a/compiler/GHC/Unit/State.hs-boot
+++ b/compiler/GHC/Unit/State.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Unit.State where
 
-import GHC.Prelude
 import GHC.Data.FastString
+import {-# SOURCE #-} GHC.Utils.Outputable
 import {-# SOURCE #-} GHC.Unit.Types (IndefUnitId, UnitId)
 
 data UnitState
@@ -9,5 +9,5 @@ data UnitDatabase unit
 
 emptyUnitState :: UnitState
 mkIndefUnitId :: UnitState -> FastString -> IndefUnitId
-displayUnitId :: UnitState -> UnitId -> Maybe String
+pprUnitIdForUser :: UnitState -> UnitId -> SDoc
 updateIndefUnitId :: UnitState -> IndefUnitId -> IndefUnitId
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 49a59cd9b5..c8847c8215 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -103,7 +103,7 @@ import Data.Bifunctor
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS.Char8
 
-import {-# SOURCE #-} GHC.Unit.State (UnitState,displayUnitId)
+import {-# SOURCE #-} GHC.Unit.State (pprUnitIdForUser)
 import {-# SOURCE #-} GHC.Driver.Session (unitState)
 
 ---------------------------------------------------------------------
@@ -508,19 +508,7 @@ instance Uniquable UnitId where
     getUnique = getUnique . unitIdFS
 
 instance Outputable UnitId where
-    ppr uid = sdocWithDynFlags $ \dflags -> pprUnitId (unitState dflags) uid
-
--- | Pretty-print a UnitId
---
--- In non-debug mode, query the given database to try to print
--- "package-version:component" instead of the raw UnitId
-pprUnitId :: UnitState -> UnitId -> SDoc
-pprUnitId state uid@(UnitId fs) = getPprDebug $ \debug ->
-   if debug
-      then ftext fs
-      else case displayUnitId state uid of
-            Just str -> text str
-            _        -> ftext fs
+    ppr uid = sdocWithDynFlags $ \dflags -> pprUnitIdForUser (unitState dflags) uid
 
 -- | A 'DefUnitId' is an 'UnitId' with the invariant that
 -- it only refers to a definite library; i.e., one we have generated
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
index 937ec2f055..a266829205 100644
--- a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
+++ b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
@@ -1,4 +1,4 @@
 
 sig/P.hsig:1:1: error:
-    • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:P’
-    • while checking that bkpcabal06-0.1.0.0:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:P]
+    • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’
+    • while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P]