diff --git a/src/GHC/All.hs b/src/GHC/All.hs index e72005c98..26b64e4bc 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 @@ -86,8 +88,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. @@ -160,8 +163,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 -- | Parse a Haskell module. Applies the C pre processor, and uses -- best-guess fixity resolution if there are ambiguities. The @@ -197,7 +206,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 166de9b6e..a56da3ff3 100644 --- a/src/Hint/Duplicate.hs +++ b/src/Hint/Duplicate.hs @@ -58,7 +58,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..b03df83d7 100644 --- a/src/Hint/NumLiteral.hs +++ b/src/Hint/NumLiteral.hs @@ -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,6 +29,7 @@ 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) @@ -38,15 +40,20 @@ import Idea (Idea, 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 = union (extensions (modComments modu)) (extensions (firstDeclComments modu)) + activeExtensions = configuredExtensions modu <> toList moduleExtensions suggestUnderscore :: LHsExpr GhcPs -> [Idea] suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) = diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs index f7370deaa..bfe154fbe 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,