Add support for NumericUnderscores extensions from CLI/config

Closes ndmitchell#1434

src/GHC/All.hs

@@ -5,7 +5,7 @@ module GHC.All(
     CppFlags(..), ParseFlags(..), defaultParseFlags,
     parseFlagsAddFixities, parseFlagsSetLanguage,
     ParseError(..), ModuleEx(..),
-    parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments,
+    parseModuleEx, createModuleEx, createModuleExWithFixities, createModuleExWithFixitiesAndExtensions, ghcComments, modComments,
     parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode,
     ) where
 
@@ -84,8 +84,9 @@ data ParseError = ParseError
     }
 
 -- | Result of 'parseModuleEx', representing a parsed module.
-newtype ModuleEx = ModuleEx {
-    ghcModule :: Located HsModule
+data ModuleEx = ModuleEx {
+    ghcModule :: Located HsModule,
+    hlintExtensions :: [Extension]
 }
 
 -- | Extract a complete list of all the comments in a module.
@@ -151,8 +152,14 @@ createModuleEx :: Located HsModule -> ModuleEx
 createModuleEx = createModuleExWithFixities (map toFixity defaultFixities)
 
 createModuleExWithFixities :: [(String, Fixity)] -> Located HsModule -> 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 -> 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
@@ -188,7 +195,7 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do
         ExceptT $ parseFailureErr dynFlags str file str 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 $ bagToList . getMessages  $ GhcPsMessage <$> snd (getPsMessages s)
   where

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]

src/Hint/Export.hs

@@ -22,7 +22,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 EpAnnNotUsed name)] )} in
       [(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}]

src/Hint/NumLiteral.hs

@@ -19,12 +19,14 @@
 
 module Hint.NumLiteral (numLiteralHint) where
 
+import GHC.All (hlintExtensions)
 import GHC.Hs
 import GHC.LanguageExtensions.Type (Extension (..))
 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.Generics.Uniplate.DataOnly (universeBi)
 import Refact.Types
@@ -34,10 +36,16 @@ import Idea (Idea, suggest)
 
 numLiteralHint :: DeclHint
 numLiteralHint _ modu =
-  if NumericUnderscores `elem` extensions (modComments modu) 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
+    moduleExtensions = toList (extensions $ modComments modu)
+    activeExtensions = hlintExtensions modu <> toList moduleExtensions
 
 suggestUnderscore :: LHsExpr GhcPs -> [Idea]
 suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) =

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)

src/Language/Haskell/HLint.hs

@@ -23,7 +23,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,