diff --git a/.hlint.yaml b/.hlint.yaml index 642648f3a..5d7e9bed1 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -76,3 +76,6 @@ - ignore: {name: Use const, within: Config.Yaml} # TEMPORARY: this lint is deleted on HEAD - ignore: {name: Use String} +# We don't use NumericUnderscores, but hints aren't aware of which extensions +# are restricted. +- ignore: {name: Use underscore} diff --git a/src/GHC/All.hs b/src/GHC/All.hs index 87cc06fd9..aa006cbb6 100644 --- a/src/GHC/All.hs +++ b/src/GHC/All.hs @@ -6,7 +6,9 @@ module GHC.All( CppFlags(..), ParseFlags(..), defaultParseFlags, parseFlagsAddFixities, parseFlagsSetLanguage, ParseError(..), ModuleEx(..), - parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments, firstDeclComments, + parseModuleEx, createModuleEx, createModuleExWithFixities, + createModuleExWithFixitiesAndExtensions, ghcComments, modComments, + firstDeclComments, parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode, ) where @@ -89,8 +91,9 @@ data ParseError = ParseError } -- | Result of 'parseModuleEx', representing a parsed module. -newtype ModuleEx = ModuleEx { - ghcModule :: Located (HsModule GhcPs) +data ModuleEx = ModuleEx { + ghcModule :: Located (HsModule GhcPs), + configuredExtensions :: [Extension] } -- | Extract a complete list of all the comments in a module. @@ -163,8 +166,14 @@ createModuleEx :: Located (HsModule GhcPs) -> ModuleEx createModuleEx = createModuleExWithFixities (map toFixity defaultFixities) createModuleExWithFixities :: [(String, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx -createModuleExWithFixities fixities ast = - ModuleEx (applyFixities (fixitiesFromModule ast ++ fixities) ast) +createModuleExWithFixities = createModuleExWithFixitiesAndExtensions [] + +-- | Create a 'ModuleEx' from a GHC module. Provide a list of custom operator +-- fixities and a list of GHC extensions that should be used when parsing the module +-- (if there are any extensions required other than those explicitly enabled in the module). +createModuleExWithFixitiesAndExtensions :: [Extension] -> [(String, Fixity)] -> Located (HsModule GhcPs) -> ModuleEx +createModuleExWithFixitiesAndExtensions extensions fixities ast = + ModuleEx (applyFixities (fixitiesFromModule ast ++ fixities) ast) extensions impliedEnables :: Extension -> [Extension] impliedEnables ext = case Data.List.lookup ext extensionImplications of @@ -214,7 +223,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) (enabledExtensions flags) 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 8ff83db0c..1b937b0ee 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 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 369d6bd96..e470bd87d 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 (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/NumLiteral.hs b/src/Hint/NumLiteral.hs index a20bc2939..d2f2b695d 100644 --- a/src/Hint/NumLiteral.hs +++ b/src/Hint/NumLiteral.hs @@ -2,7 +2,7 @@ Suggest the usage of underscore when NumericUnderscores is enabled. -123456 +123456 -- @Suggestion 123_456 @NoRefactor {-# LANGUAGE NumericUnderscores #-} \ 1234 {-# LANGUAGE NumericUnderscores #-} \ @@ -21,6 +21,7 @@ module Hint.NumLiteral (numLiteralHint) where +import GHC.All (configuredExtensions) import GHC.Hs import GHC.Data.FastString import GHC.LanguageExtensions.Type (Extension (..)) @@ -28,36 +29,50 @@ import GHC.Types.SrcLoc import GHC.Types.SourceText import GHC.Util.ApiAnnotation (extensions) import Data.Char (isDigit, isOctDigit, isHexDigit) +import Data.Foldable (toList) import Data.List (intercalate) import Data.Set (union) import Data.Generics.Uniplate.DataOnly (universeBi) import Refact.Types import Hint.Type (DeclHint, toSSA, modComments, firstDeclComments) -import Idea (Idea, suggest) +import Idea (Idea(..), Note(..), suggest) numLiteralHint :: DeclHint numLiteralHint _ modu = - -- Comments appearing without an empty line before the first - -- declaration in a module are now associated with the declaration - -- not the module so to be safe, look also at `firstDeclComments - -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517). - let exts = union (extensions (modComments modu)) (extensions (firstDeclComments modu)) in - if NumericUnderscores `elem` exts then + -- TODO: there's a subtle bug when the module disables `NumericUnderscores`. + -- This seems pathological, though, because who would enable it for their + -- project but disable it in specific files? + if NumericUnderscores `elem` activeExtensions then concatMap suggestUnderscore . universeBi else const [] + where + -- Comments appearing without an empty line before the first + -- declaration in a module are now associated with the declaration + -- not the module so to be safe, look also at `firstDeclComments + -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517). + moduleExtensions = extensions (modComments modu) `union` extensions (firstDeclComments modu) + activeExtensions = configuredExtensions modu <> toList moduleExtensions suggestUnderscore :: LHsExpr GhcPs -> [Idea] suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt ] + [ (suggest "Use underscore" (reLoc x) (reLoc y) [r]) + { ideaNote = [ RequiresExtension "NumericUnderscores" ] + } + | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt + ] where underscoredSrcTxt = addUnderscore (unpackFS srcTxt) y :: LocatedAn NoEpAnns (HsExpr GhcPs) y = noLocA $ HsOverLit noExtField $ ol{ol_val = HsIntegral intLit{il_text = SourceText (fsLit underscoredSrcTxt)}} r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt ] + [ (suggest "Use underscore" (reLoc x) (reLoc y) [r]) + { ideaNote = [ RequiresExtension "NumericUnderscores" ] + } + | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt + ] where underscoredSrcTxt = addUnderscore (unpackFS srcTxt) y :: LocatedAn NoEpAnns (HsExpr GhcPs) diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs index b02aee30e..daa3b7a67 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 (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) diff --git a/src/Language/Haskell/HLint.hs b/src/Language/Haskell/HLint.hs index e2f5bb74f..a936093bf 100644 --- a/src/Language/Haskell/HLint.hs +++ b/src/Language/Haskell/HLint.hs @@ -24,7 +24,7 @@ module Language.Haskell.HLint( -- * Hints Hint, -- * Modules - ModuleEx, parseModuleEx, createModuleEx, createModuleExWithFixities, ParseError(..), + ModuleEx, parseModuleEx, createModuleEx, createModuleExWithFixities, createModuleExWithFixitiesAndExtensions, ParseError(..), -- * Parse flags defaultParseFlags, ParseFlags(..), CppFlags(..), FixityInfo,