Skip to content

Commit

Permalink
Mark extensions implied by language as unused
Browse files Browse the repository at this point in the history
  • Loading branch information
amesgen committed Mar 2, 2023
1 parent 4681c81 commit b2c3f10
Show file tree
Hide file tree
Showing 2 changed files with 39 additions and 8 deletions.
30 changes: 22 additions & 8 deletions src/Hint/Extensions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -254,7 +254,7 @@ foo = $bar

module Hint.Extensions(extensionsHint) where

import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments)
import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,ModuleEx (..))
import Extension

import Data.Generics.Uniplate.DataOnly
Expand All @@ -266,6 +266,7 @@ import Refact.Types
import qualified Data.Set as Set
import qualified Data.Map as Map

import GHC.Driver.Session (languageExtensions)
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Hs
Expand All @@ -289,7 +290,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 (anchor sl) GHC.Data.Strict.Nothing)
Expand All @@ -304,7 +305,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)
Expand Down Expand Up @@ -336,9 +337,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]
Expand All @@ -352,10 +362,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"]
Expand Down
17 changes: 17 additions & 0 deletions tests/ghc2021.test
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit b2c3f10

Please sign in to comment.