summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-03-28 16:13:03 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2022-04-01 11:15:24 +0100
commitf8fc6d2e91038a98a321eceefe0a2ffff3dc9e72 (patch)
tree846f6310cb933eae6d38c5c24864b55c76032d1b /compiler/GHC/Driver
parentf8f152e7089af9a5434408e17ff071999d381ee1 (diff)
downloadhaskell-f8fc6d2e91038a98a321eceefe0a2ffff3dc9e72.tar.gz
driver: Improve -Wunused-packages error message (and simplify implementation)
In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r--compiler/GHC/Driver/Errors/Ppr.hs14
-rw-r--r--compiler/GHC/Driver/Errors/Types.hs2
-rw-r--r--compiler/GHC/Driver/Make.hs39
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs2
4 files changed, 25 insertions, 32 deletions
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 1b604e1071..76a0ed15d3 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -19,6 +19,7 @@ import GHC.Unit.Module
import GHC.Unit.State
import GHC.Types.Hint
import GHC.Types.SrcLoc
+import Data.Version
import Language.Haskell.Syntax.Decls (RuleDecl(..))
@@ -104,16 +105,23 @@ instance Diagnostic DriverMessage where
-> let msg = vcat [ text "The following packages were specified" <+>
text "via -package or -package-id flags,"
, text "but were not needed for compilation:"
- , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs))
+ , nest 2 (vcat (map (withDash . displayOneUnused) unusedArgs))
]
in mkSimpleDecorated msg
where
withDash :: SDoc -> SDoc
withDash = (<+>) (text "-")
+ displayOneUnused (_uid, pn , v, f) =
+ ppr pn <> text "-" <> text (showVersion v)
+ <+> parens (suffix f)
+
+ suffix f = text "exposed by flag" <+> pprUnusedArg f
+
pprUnusedArg :: PackageArg -> SDoc
- pprUnusedArg (PackageArg str) = text str
- pprUnusedArg (UnitIdArg uid) = ppr uid
+ pprUnusedArg (PackageArg str) = text "-package" <+> text str
+ pprUnusedArg (UnitIdArg uid) = text "-package-id" <+> ppr uid
+
DriverUnnecessarySourceImports mod
-> mkSimpleDecorated (text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod))
DriverDuplicatedModuleDeclaration mod files
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index 7257b23903..015ae5e375 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -143,7 +143,7 @@ data DriverMessage where
Test cases: warnings/should_compile/UnusedPackages
-}
- DriverUnusedPackages :: [PackageArg] -> DriverMessage
+ DriverUnusedPackages :: [(UnitId, PackageName, Version, PackageArg)] -> DriverMessage
{-| DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there
are {-# SOURCE #-} imports which are not necessary. See 'warnUnnecessarySourceImports'
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index c4858d04b0..de3401455f 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -264,7 +264,7 @@ instantiationNodes uid unit_state = InstantiationNode uid <$> iuids_to_check
where
iuids_to_check :: [InstantiatedUnit]
iuids_to_check =
- nubSort $ concatMap goUnitId (explicitUnits unit_state)
+ nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state)
where
goUnitId uid =
[ recur
@@ -460,11 +460,18 @@ warnUnusedPackages us dflags mod_graph =
$ concatMap ms_imps (
filter (\ms -> homeUnitId_ dflags == ms_unitid ms) (mgModSummaries mod_graph))
- requestedArgs = mapMaybe packageArg (packageFlags dflags)
+ used_args = Set.fromList $ map unitId loadedPackages
- unusedArgs
- = filter (\arg -> not $ any (matching us arg) loadedPackages)
- requestedArgs
+ resolve (u,mflag) = do
+ -- The units which we depend on via the command line explicitly
+ flag <- mflag
+ -- Which we can find the UnitInfo for (should be all of them)
+ ui <- lookupUnit us u
+ -- Which are not explicitly used
+ guard (Set.notMember (unitId ui) used_args)
+ return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag)
+
+ unusedArgs = mapMaybe resolve (explicitUnits us)
warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs)
@@ -472,28 +479,6 @@ warnUnusedPackages us dflags mod_graph =
then emptyMessages
else warn
- where
- packageArg (ExposePackage _ arg _) = Just arg
- packageArg _ = Nothing
-
- matchingStr :: String -> UnitInfo -> Bool
- matchingStr str p
- = str == unitPackageIdString p
- || str == unitPackageNameString p
-
- matching :: UnitState -> PackageArg -> UnitInfo -> Bool
- matching _ (PackageArg str) p = matchingStr str p
- matching state (UnitIdArg uid) p = uid == realUnit state p
-
- -- For wired-in packages, we have to unwire their id,
- -- otherwise they won't match package flags
- realUnit :: UnitState -> UnitInfo -> Unit
- realUnit state
- = unwireUnit state
- . RealUnit
- . Definite
- . unitId
-
-- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any
-- path from module to its boot file.
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 97eeb58260..909102b573 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -996,7 +996,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
-- MIN_VERSION macros
let uids = explicitUnits unit_state
- pkgs = catMaybes (map (lookupUnit unit_state) uids)
+ pkgs = mapMaybe (lookupUnit unit_state . fst) uids
mb_macro_include <-
if not (null pkgs) && gopt Opt_VersionMacros dflags
then do macro_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "h"