From 74297f36bff63d8b4516aa7f2ba7aea5b1d88a63 Mon Sep 17 00:00:00 2001 From: amesgen Date: Thu, 2 Mar 2023 09:48:02 +0100 Subject: [PATCH 1/2] Include language in `ModuleEx` --- src/GHC/All.hs | 9 +++++---- src/Hint/Duplicate.hs | 2 +- src/Hint/Export.hs | 2 +- src/Hint/Unsafe.hs | 2 +- 4 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/GHC/All.hs b/src/GHC/All.hs index 87cc06fd..62e75d46 100644 --- a/src/GHC/All.hs +++ b/src/GHC/All.hs @@ -89,8 +89,9 @@ data ParseError = ParseError } -- | Result of 'parseModuleEx', representing a parsed module. -newtype ModuleEx = ModuleEx { +data ModuleEx = ModuleEx { ghcModule :: Located (HsModule GhcPs) + , ghcLanguage :: Maybe Language } -- | Extract a complete list of all the comments in a module. @@ -159,10 +160,10 @@ parseDeclGhcWithMode parseMode s = -- | Create a 'ModuleEx' from a GHC module. It is assumed the incoming -- parsed module has not been adjusted to account for operator -- fixities (it uses the HLint default fixities). -createModuleEx :: Located (HsModule GhcPs) -> ModuleEx +createModuleEx :: Located (HsModule GhcPs) -> Maybe Language -> ModuleEx createModuleEx = createModuleExWithFixities (map toFixity defaultFixities) -createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx +createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) -> Maybe Language -> ModuleEx createModuleExWithFixities fixities ast = ModuleEx (applyFixities (fixitiesFromModule ast ++ fixities) ast) @@ -214,7 +215,7 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList errs else do let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags - pure $ ModuleEx (applyFixities fixes a) + pure $ ModuleEx (applyFixities fixes a) (language dynFlags) PFailed s -> ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s) where diff --git a/src/Hint/Duplicate.hs b/src/Hint/Duplicate.hs index 8ff83db0..c13893ed 100644 --- a/src/Hint/Duplicate.hs +++ b/src/Hint/Duplicate.hs @@ -57,7 +57,7 @@ duplicateHint ms = ] where ds = [(modName m, fromMaybe "" (declName d), unLoc d) - | ModuleEx m <- map snd ms + | ModuleEx {ghcModule = m} <- map snd ms , d <- hsmodDecls (unLoc m)] dupes :: (Outputable e, Data e) => [(String, String, [LocatedA e])] -> [Idea] diff --git a/src/Hint/Export.hs b/src/Hint/Export.hs index 369d6bd9..747231d5 100644 --- a/src/Hint/Export.hs +++ b/src/Hint/Export.hs @@ -21,7 +21,7 @@ import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader exportHint :: ModuHint -exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = exports}) ) +exportHint _ ModuleEx {ghcModule = L s m@HsModule {hsmodName = Just name, hsmodExports = exports}} | Nothing <- exports = let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents (Nothing, noAnn) name)] )} in [(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}] diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs index b02aee30..15cecccc 100644 --- a/src/Hint/Unsafe.hs +++ b/src/Hint/Unsafe.hs @@ -46,7 +46,7 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable -- @ -- is. We advise that such constants should have a @NOINLINE@ pragma. unsafeHint :: DeclHint -unsafeHint _ (ModuleEx (L _ m)) = \ld@(L loc d) -> +unsafeHint _ ModuleEx {ghcModule = L _ m} = \ld@(L loc d) -> [rawIdea Hint.Type.Warning "Missing NOINLINE pragma" (locA loc) (unsafePrettyPrint d) (Just $ trimStart (unsafePrettyPrint $ gen x) ++ "\n" ++ unsafePrettyPrint d) From bf8ca0eef4e38c542b515dc2617ca031dc6d9eea Mon Sep 17 00:00:00 2001 From: amesgen Date: Thu, 2 Mar 2023 09:48:03 +0100 Subject: [PATCH 2/2] Mark extensions implied by language as unused --- src/Hint/Extensions.hs | 30 ++++++++++++++++++++++-------- tests/ghc2021.test | 17 +++++++++++++++++ 2 files changed, 39 insertions(+), 8 deletions(-) create mode 100644 tests/ghc2021.test diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs index a2f6ddf3..c8de56ee 100644 --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -262,7 +262,7 @@ data T = MkT -- @NoRefactor: refactor requires GHC >= 9.6.1 module Hint.Extensions(extensionsHint) where -import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,firstDeclComments) +import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,firstDeclComments,ModuleEx (..)) import Extension import Data.Generics.Uniplate.DataOnly @@ -275,6 +275,7 @@ import Data.Set qualified as Set import Data.Map qualified as Map import GHC.Data.FastString +import GHC.Driver.Session (languageExtensions) import GHC.Types.SrcLoc import GHC.Types.SourceText import GHC.Hs @@ -298,7 +299,7 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader extensionsHint :: ModuHint -extensionsHint _ x = +extensionsHint _ x@ModuleEx{ghcLanguage} = [ rawIdea Hint.Type.Warning "Unused LANGUAGE pragma" (RealSrcSpan (epaLocationRealSrcSpan sl) GHC.Data.Strict.Nothing) @@ -319,7 +320,7 @@ extensionsHint _ x = , let after = filter (maybe True (`Set.member` keep) . snd) before , before /= after , let explainedRemovals - | null after && not (any (`Map.member` implied) $ mapMaybe snd before) = [] + | null after && not (any (`Set.member` impliedExtensions) $ mapMaybe snd before) = [] | otherwise = before \\ after , let newPragma = if null after then "" else comment_ (mkLanguagePragmas sl $ map fst after) @@ -359,9 +360,18 @@ extensionsHint _ x = | e <- Set.toList useful , a:_ <- [filter (`Set.member` useful) $ extensionImpliedEnabledBy e] ] + impliedByLanguage :: Set.Set Extension + impliedByLanguage = case ghcLanguage of + Just l -> Set.fromList $ languageExtensions (Just l) + -- If we pass 'Nothing' to 'languageExtensions', the latest language + -- (i.e. GHC2021) is used; which might be unexpected for users on older + -- GHC versions where GHC2021 doesn't even exist yet. + Nothing -> Set.empty + impliedExtensions :: Set.Set Extension + impliedExtensions = Map.keysSet implied `Set.union` impliedByLanguage -- Those we should keep. keep :: Set.Set Extension - keep = useful `Set.difference` Map.keysSet implied + keep = useful `Set.difference` impliedExtensions -- The meaning of (a,b) is a used to imply b, but has gone, so -- suggest enabling b. disappear :: Map.Map Extension [Extension] @@ -375,10 +385,14 @@ extensionsHint _ x = , usedTH || usedExt a (ghcModule x) ] reason :: Extension -> String - reason x = - case Map.lookup x implied of - Just a -> "implied by " ++ show a - Nothing -> "not used" + reason x + | Just a <- Map.lookup x implied + = "implied by " ++ show a + | x `Set.member` impliedByLanguage + , Just l <- ghcLanguage + = "implied by " ++ show l + | otherwise + = "not used" deriveHaskell = ["Eq","Ord","Enum","Ix","Bounded","Read","Show"] deriveGenerics = ["Data","Typeable","Generic","Generic1","Lift"] diff --git a/tests/ghc2021.test b/tests/ghc2021.test new file mode 100644 index 00000000..9b80c121 --- /dev/null +++ b/tests/ghc2021.test @@ -0,0 +1,17 @@ +--------------------------------------------------------------------- +RUN tests/ghc2021.hs +FILE tests/ghc2021.hs +{-# LANGUAGE FlexibleContexts #-} +OUTPUT +No hints + +--------------------------------------------------------------------- +RUN tests/ghc2021.hs -XGHC2021 +OUTPUT +tests/ghc2021.hs:1:1-33: Warning: Unused LANGUAGE pragma +Found: + {-# LANGUAGE FlexibleContexts #-} +Perhaps you should remove it. +Note: Extension FlexibleContexts is implied by GHC2021 + +1 hint