| Redundant $ |
Example:
diff --git a/src/GHC/All.hs b/src/GHC/All.hs
index 87cc06fd..400640b5 100644
--- a/src/GHC/All.hs
+++ b/src/GHC/All.hs
@@ -8,6 +8,7 @@ module GHC.All(
ParseError(..), ModuleEx(..),
parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments, firstDeclComments,
parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode,
+ ghcExtensionsEnabledInModule,
) where
import GHC.Driver.Ppr
@@ -18,6 +19,8 @@ import Data.Char
import Data.List
import Data.List.NonEmpty qualified as NE
import Data.List.Extra
+import Data.Set (Set)
+import Data.Set qualified as Set
import Timing
import Language.Preprocessor.Cpphs
import System.IO.Extra
@@ -108,6 +111,15 @@ firstDeclComments m =
[] -> EpaCommentsBalanced [] []
L ann _ : _ -> comments ann
+-- | The extensions enabled in pragmas at the top of a module.
+ghcExtensionsEnabledInModule :: ModuleEx -> Set Extension
+ghcExtensionsEnabledInModule 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).
+ extensions (modComments modu) `Set.union` extensions (firstDeclComments modu)
+
-- | The error handler invoked when GHC parsing has failed.
ghcFailOpParseModuleEx :: String
-> FilePath
diff --git a/src/Hint/Bracket.hs b/src/Hint/Bracket.hs
index 7ecce269..154d165b 100644
--- a/src/Hint/Bracket.hs
+++ b/src/Hint/Bracket.hs
@@ -93,7 +93,7 @@ main = 1; {-# ANN module ("HLint: ignore Use camelCase" :: String) #-}
main = 1; {-# ANN module (1 + (2)) #-} -- 2
-- special case from esqueleto, see #224
-main = operate <$> (select $ from $ \user -> return $ user ^. UserEmail)
+main = operate <$> (select $ from $ \user -> return $ user ^. UserEmail) -- @Ignore ???
-- unknown fixity, see #426
bad x = x . (x +? x . x)
-- special case people don't like to warn on
@@ -111,7 +111,7 @@ function (Ctor (Rec { field })) = Ctor (Rec {field = 1})
no = f @($x)
-- template haskell is harder
-issue1292 = [e| handleForeignCatch $ \ $(varP pylonExPtrVarName) -> $(quoteExp C.block modifiedStr) |]
+issue1292 = [e| handleForeignCatch $ \ $(varP pylonExPtrVarName) -> $(quoteExp C.block modifiedStr) |] -- @Ignore ???
-- no warnings for single-argument constraint contexts
foo :: (A) => ()
@@ -122,21 +122,33 @@ data Dict c where Dict :: (c) => Dict c
data Dict' c a where Dict' :: (c a) => Dict' c a
-- issue1501: Redundant bracket hint resulted in a parse error
-x = f $ \(Proxy @a) -> True
+x = f $ \(Proxy @a) -> True -- @Ignore ???
+
+-- dollar reduction tests with block arguments
+-- (keep these after any other tests that ignore this suggestion, so that
+-- hints.md is less confusing)
+{-# LANGUAGE BlockArguments #-} \
+a = f $ do x -- f do x
+a = f $ do x -- @Ignore f do x
+{-# LANGUAGE BlockArguments #-} \
+a = f $ \case _ -> x -- f \case _ -> x
+a = f $ \case _ -> x -- @Ignore f \case _ -> x
-}
module Hint.Bracket(bracketHint) where
-import Hint.Type(DeclHint,Idea(..),rawIdea,warn,suggest,Severity(..),toRefactSrcSpan,toSSA)
+import Hint.Type(DeclHint,Idea(..),ghcExtensionsEnabledInModule,idea,rawIdea,warn,suggest,Severity(..),toRefactSrcSpan,toSSA)
import Data.Data
import Data.List.Extra
+import Data.Set (member)
import Data.Generics.Uniplate.DataOnly
import Refact.Types
import GHC.Hs
-import GHC.Utils.Outputable
+import GHC.LanguageExtensions.Type (Extension(..))
+import GHC.Utils.Outputable hiding ((<>))
import GHC.Types.SrcLoc
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
@@ -144,12 +156,18 @@ import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
bracketHint :: DeclHint
-bracketHint _ _ x =
- concatMap (\x -> bracket prettyExpr isPartialAtom True x ++ dollar x) (childrenBi (descendBi splices $ descendBi annotations x) :: [LHsExpr GhcPs]) ++
+bracketHint _ modu x =
+ concatMap (\x -> bracket prettyExpr isPartialAtom True x ++ dollar blockArgSev x) (childrenBi (descendBi splices $ descendBi annotations x) :: [LHsExpr GhcPs]) ++
concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi (preprocess x) :: [LHsType GhcPs]) ++
concatMap (bracket unsafePrettyPrint (\_ _ -> False) False) (childrenBi x :: [LPat GhcPs]) ++
concatMap fieldDecl (childrenBi x)
where
+ exts = ghcExtensionsEnabledInModule modu
+ -- Ignore "Redundant $ with block argument" by default, unless we can see
+ -- that BlockArguments are enabled in this file.
+ blockArgSev
+ | BlockArguments `member` exts = Suggestion
+ | otherwise = Ignore
preprocess = transformBi removeSingleAtomConstrCtxs
where
removeSingleAtomConstrCtxs :: LHsContext GhcPs -> LHsContext GhcPs
@@ -267,15 +285,21 @@ fieldDecl _ = []
-- This function relies heavily on fixities having been applied to the
-- raw parse tree.
-dollar :: LHsExpr GhcPs -> [Idea]
-dollar = concatMap f . universe
+-- `blockArgSev` is the default severity to use for dollars with a block
+-- argument (a lambda, `do`, etc.).
+dollar :: Severity -> LHsExpr GhcPs -> [Idea]
+dollar blockArgSev = concatMap f . universe
where
- f x = [ (suggest "Redundant $" (reLoc x) (reLoc y) [r]){ideaSpan = locA (getLoc d)} | L _ (OpApp _ a d b) <- [x], isDol d
+ f x = [ (idea sev ("Redundant $" <> suffix) (reLoc x) (reLoc y) [r]){ideaSpan = locA (getLoc d)} | L _ (OpApp _ a d b) <- [x], isDol d
, let y = noLocA (HsApp noExtField a b) :: LHsExpr GhcPs
, not $ needBracket 0 y a
- , not $ needBracket 1 y b
, not $ isPartialAtom (Just x) b
- , let r = Replace Expr (toSSA x) [("a", toSSA a), ("b", toSSA b)] "a b"]
+ , let r = Replace Expr (toSSA x) [("a", toSSA a), ("b", toSSA b)] "a b"
+ , (sev, suffix) <-
+ if needBracket 1 y b
+ then [(blockArgSev, " with block argument") | isBlock (unLoc b)]
+ else [(Suggestion, "")]
+ ]
++
[ suggest "Move brackets to avoid $" (reLoc x) (reLoc (t y)) [r]
|(t, e@(L _ (HsPar _ (L _ (OpApp _ a1 op1 a2))))) <- splitInfix x
@@ -295,6 +319,14 @@ dollar = concatMap f . universe
-- , error $ show (unsafePrettyPrint a, gshow b, unsafePrettyPrint c)
, let y = noLocA $ OpApp noExtField a b c :: LHsExpr GhcPs
, let r = Replace Expr (toSSA x) [("x", toSSA a), ("op", toSSA b), ("y", toSSA c)] "x op y"]
+ isBlock = \case
+ HsDo {} -> True
+ HsCase {} -> True
+ HsLam {} -> True
+ HsLet {} -> True
+ HsIf {} -> True
+ HsProc {} -> True
+ _ -> False
splitInfix :: LHsExpr GhcPs -> [(LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)]
splitInfix (L l (OpApp _ lhs op rhs)) =
diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs
index a2f6ddf3..d6fdc080 100644
--- a/src/Hint/Extensions.hs
+++ b/src/Hint/Extensions.hs
@@ -262,7 +262,7 @@ data T = MkT -- @NoRefactor: refactor requires GHC >= 9.6.1
module Hint.Extensions(extensionsHint) where
-import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,firstDeclComments)
+import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcExtensionsEnabledInModule,ghcModule,modComments,firstDeclComments)
import Extension
import Data.Generics.Uniplate.DataOnly
@@ -334,16 +334,7 @@ extensionsHint _ x =
-- All the extensions defined to be used.
extensions :: Set.Set Extension
- extensions = Set.fromList $
- concatMap
- (mapMaybe readExtension . snd)
- (languagePragmas
- (pragmas (modComments x) ++ pragmas (firstDeclComments x)))
- -- 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 x`
- -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).
+ extensions = ghcExtensionsEnabledInModule x
-- Those extensions we detect to be useful.
useful :: Set.Set Extension
diff --git a/src/Hint/List.hs b/src/Hint/List.hs
index 93fbf86a..fe311af5 100644
--- a/src/Hint/List.hs
+++ b/src/Hint/List.hs
@@ -47,14 +47,16 @@ import Data.Generics.Uniplate.DataOnly
import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Maybe
+import Data.Set (member)
import Prelude
-import Hint.Type(DeclHint,Idea,suggest,ignore,substVars,toRefactSrcSpan,toSSA,modComments,firstDeclComments)
+import Hint.Type(DeclHint,Idea,suggest,ignore,substVars,toRefactSrcSpan,toSSA,ghcExtensionsEnabledInModule)
import Refact.Types hiding (SrcSpan)
import Refact.Types qualified as R
import GHC.Hs
+import GHC.LanguageExtensions.Type (Extension(..))
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Types.Name.Reader
@@ -73,12 +75,8 @@ import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
listHint :: DeclHint
listHint _ modu = listDecl overloadedListsOn
where
- -- Comments appearing without a line-break 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).
- exts = concatMap snd (languagePragmas (pragmas (modComments modu) ++ pragmas (firstDeclComments modu)))
- overloadedListsOn = "OverloadedLists" `elem` exts
+ exts = ghcExtensionsEnabledInModule modu
+ overloadedListsOn = OverloadedLists `member` exts
listDecl :: Bool -> LHsDecl GhcPs -> [Idea]
listDecl overloadedListsOn x =
diff --git a/src/Hint/NumLiteral.hs b/src/Hint/NumLiteral.hs
index a20bc293..86d817bd 100644
--- a/src/Hint/NumLiteral.hs
+++ b/src/Hint/NumLiteral.hs
@@ -26,24 +26,18 @@ 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.List (intercalate)
-import Data.Set (union)
+import Data.Set (member)
import Data.Generics.Uniplate.DataOnly (universeBi)
import Refact.Types
-import Hint.Type (DeclHint, toSSA, modComments, firstDeclComments)
+import Hint.Type (DeclHint, toSSA, ghcExtensionsEnabledInModule)
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
+ if NumericUnderscores `member` ghcExtensionsEnabledInModule modu then
concatMap suggestUnderscore . universeBi
else
const []
diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs
index 1b642547..98626b19 100644
--- a/src/Hint/Pattern.hs
+++ b/src/Hint/Pattern.hs
@@ -59,10 +59,11 @@ otherwise = True
module Hint.Pattern(patternHint) where
-import Hint.Type(DeclHint,Idea,modComments,firstDeclComments,ideaTo,toSSA,toRefactSrcSpan,suggest,suggestRemove,warn)
+import Hint.Type(DeclHint,Idea,ghcExtensionsEnabledInModule,ideaTo,toSSA,toRefactSrcSpan,suggest,suggestRemove,warn)
import Data.Generics.Uniplate.DataOnly
import Data.Function
import Data.List.Extra
+import Data.Set (member)
import Data.Tuple
import Data.Maybe
import Data.Either
@@ -70,13 +71,13 @@ import Refact.Types hiding (RType(Pattern, Match), SrcSpan)
import Refact.Types qualified as R (RType(Pattern, Match), SrcSpan)
import GHC.Hs hiding(asPattern)
+import GHC.LanguageExtensions.Type (Extension(..))
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Types.Basic hiding (Pattern)
import GHC.Data.Strict qualified
-import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
@@ -91,13 +92,7 @@ patternHint _scope modu x =
concatMap (patHint strict True) (universeBi $ transformBi noPatBind x) ++
concatMap expHint (universeBi x)
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).
- exts = nubOrd $ concatMap snd (languagePragmas (pragmas (modComments modu) ++ pragmas (firstDeclComments modu))) -- language extensions enabled at source
- strict = "Strict" `elem` exts
+ strict = Strict `member` ghcExtensionsEnabledInModule modu
noPatBind :: LHsBind GhcPs -> LHsBind GhcPs
noPatBind (L loc a@PatBind{}) = L loc a{pat_lhs=noLocA (WildPat noExtField)}
|