summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-06-01 12:24:56 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-07-07 13:56:14 -0400
commit0ddae2ba979ac2e01d7d9f6b79a9559fbfde46ea (patch)
treec5e76e2ca71ec70b6f30b067b99c2868004125d5
parentd25b6851bbd63b6a65fb7cd08b37c6bc74df9855 (diff)
downloadhaskell-0ddae2ba979ac2e01d7d9f6b79a9559fbfde46ea.tar.gz
DynFlags: factor out pprUnitId from "Outputable UnitId" instance
-rw-r--r--compiler/GHC/Unit/Types.hs21
1 files changed, 14 insertions, 7 deletions
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index dace82c759..49a59cd9b5 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 (displayUnitId)
+import {-# SOURCE #-} GHC.Unit.State (UnitState,displayUnitId)
import {-# SOURCE #-} GHC.Driver.Session (unitState)
---------------------------------------------------------------------
@@ -508,12 +508,19 @@ instance Uniquable UnitId where
getUnique = getUnique . unitIdFS
instance Outputable UnitId where
- ppr uid@(UnitId fs) =
- getPprDebug $ \debug ->
- sdocWithDynFlags $ \dflags ->
- case displayUnitId (unitState dflags) uid of
- Just str | not debug -> text str
- _ -> ftext fs
+ 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
-- | A 'DefUnitId' is an 'UnitId' with the invariant that
-- it only refers to a definite library; i.e., one we have generated