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

5 files changed, 50 insertions, 46 deletions

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