Skip to content

Add support for NumericUnderscores extensions from CLI/config #1618

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Add support for NumericUnderscores extensions from CLI/config #1618

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions .hlint.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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}
21 changes: 15 additions & 6 deletions src/GHC/All.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So the provenance of these extensions is in ParseFlags. This is not passed to hints themselves.

The type of DeclHint is:

type DeclHint = Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]

If we want to propagate this information, we have essentially three choices:

  1. Smuggle it in ModuleEx.
  2. Smuggle it in Scope.
  3. Add another function argument here for the whole hlint configuration (ParseFlags ? and [Setting] maybe?)

Scope is, already, just a convenience/performance/cache wrapper around information that is extracted directly from the contents of a ModuleEx. Here is definition and logic to create.

I think one could argue that Scope is a more reasonable place for this than ModuleEx, but I'd go further: Scope should be part of ModuleEx directly. After all, scopeCreate is called on the ModuleEx - which means that we have already lost the ParseFlags information, if it is not present on ModuleEx.

IMO, a ModuleEx represents "what we know about a parsed module":

-- | Result of 'parseModuleEx', representing a parsed module.
newtype ModuleEx = ModuleEx {
    ghcModule :: Located (HsModule GhcPs)
}

But we don't know - what extensions were enabled while parsing this module?

I think "rearchitecting the way we pass flags around in hlint and breaking the whole API for hints" is probably not appropriate for this PR. If we extend ModuleEx, then we pave the way for further additions to ModuleEx as "the" place to put information relevant to a module. If we extend Scope, then we need to plumb that through anyway, possibly through ModuleEx resulting in duplication. But neither option prevent or impede a more serious refactoring in how this code works.

PFailed s ->
ExceptT $ parseFailureErr dynFlags str file str $ NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s)
where
Expand Down
2 changes: 1 addition & 1 deletion src/Hint/Duplicate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
2 changes: 1 addition & 1 deletion src/Hint/Export.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"]}]
Expand Down
35 changes: 25 additions & 10 deletions src/Hint/NumLiteral.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
Suggest the usage of underscore when NumericUnderscores is enabled.

<TEST>
123456
123456 -- @Suggestion 123_456 @NoRefactor
{-# LANGUAGE NumericUnderscores #-} \
1234
{-# LANGUAGE NumericUnderscores #-} \
Expand All @@ -21,43 +21,58 @@

module Hint.NumLiteral (numLiteralHint) where

import GHC.All (configuredExtensions)
import GHC.Hs
import GHC.Data.FastString
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.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)
Expand Down
2 changes: 1 addition & 1 deletion src/Hint/Unsafe.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion src/Language/Haskell/HLint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down