From 57df44004b268e203593a50077028955cd83c87c Mon Sep 17 00:00:00 2001 From: Stephen Judkins Date: Thu, 16 Mar 2023 15:12:21 -0700 Subject: [PATCH 1/3] PatternWildCard hint --- hints.md | 32 ++++++++++++++++++++++++++++++++ hlint.cabal | 1 + src/Hint/All.hs | 4 +++- src/Hint/PatternWildCard.hs | 33 +++++++++++++++++++++++++++++++++ 4 files changed, 69 insertions(+), 1 deletion(-) create mode 100644 src/Hint/PatternWildCard.hs diff --git a/hints.md b/hints.md index 13c033636..062999187 100644 --- a/hints.md +++ b/hints.md @@ -1402,6 +1402,38 @@ x +## Builtin PatternWildCard + + + + + + + + + + + + +
Hint NameHintSeverity
Don't use wildcard in pattern match +Example: + +case x of { Foo _ -> spam } + +
+Found: + +_ + +
+Suggestion: + + + +
+Does not support refactoring. +		Ignore
+ ## Builtin Pragma diff --git a/hlint.cabal b/hlint.cabal index d662c3a96..e507b2a20 100644 --- a/hlint.cabal +++ b/hlint.cabal @@ -160,6 +160,7 @@ library Hint.Naming Hint.NewType Hint.Pattern + Hint.PatternWildCard Hint.Pragma Hint.Restrict Hint.Smell diff --git a/src/Hint/All.hs b/src/Hint/All.hs index 3565249a9..396700b95 100644 --- a/src/Hint/All.hs +++ b/src/Hint/All.hs @@ -33,6 +33,7 @@ import Hint.Unsafe import Hint.NewType import Hint.Smell import Hint.NumLiteral +import Hint.PatternWildCard -- | A list of the builtin hints wired into HLint. -- This list is likely to grow over time. @@ -40,7 +41,7 @@ data HintBuiltin = HintList | HintListRec | HintMonad | HintLambda | HintFixities | HintBracket | HintNaming | HintPattern | HintImport | HintExport | HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict | - HintComment | HintNewType | HintSmell | HintNumLiteral + HintComment | HintNewType | HintSmell | HintNumLiteral | HintPatternWildCard deriving (Show,Eq,Ord,Bounded,Enum) -- See https://github.com/ndmitchell/hlint/issues/1150 - Duplicate is too slow @@ -68,6 +69,7 @@ builtin x = case x of HintMonad -> decl monadHint HintExtensions -> modu extensionsHint HintNumLiteral -> decl numLiteralHint + HintPatternWildCard -> decl patternWildCardHint where wrap = timed "Hint" (drop 4 $ show x) . forceList decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c} diff --git a/src/Hint/PatternWildCard.hs b/src/Hint/PatternWildCard.hs new file mode 100644 index 000000000..b3e93d497 --- /dev/null +++ b/src/Hint/PatternWildCard.hs @@ -0,0 +1,33 @@ +{- + Warn against wildcards in pattern + + +foo (case x of { Foo _ -> spam }) -- @Ignore ??? +case x of { Foo (Spam (Eggs _)) -> spam } -- @Ignore ??? +case x of { Foo _ -> spam } -- @Ignore ??? +case x of { Foo bar -> spam } +foo (case x of { Foo bar -> spam }) + +-} + +module Hint.PatternWildCard (patternWildCardHint) +where + +import Hint.Type (DeclHint, ignoreNoSuggestion, Idea) +import GHC.Hs +import GHC.Types.SrcLoc +import Data.Generics.Uniplate.DataOnly + +patternWildCardHint :: DeclHint +patternWildCardHint _ _ code = concatMap inspectCode $ childrenBi code + +inspectCode :: LHsExpr GhcPs -> [Idea] +inspectCode (L _ ((HsCase _ _ (MG _ (L _ cases) _)))) = concatMap inspectCase cases +inspectCode o = concatMap inspectCode $ children o + +inspectCase :: LMatch GhcPs (LHsExpr GhcPs) -> [Idea] +inspectCase c@(L _ (Match _ _ pats _)) = concatMap inspectPat pats + +inspectPat :: LPat GhcPs -> [Idea] +inspectPat c@(L _ (WildPat _)) = [ignoreNoSuggestion "Don't use wildcard in pattern match" (reLoc c)] +inspectPat o = concatMap inspectPat $ children o From f9f98c2a7f7209e1098db9cea9b0d96d04bb988a Mon Sep 17 00:00:00 2001 From: Stephen Judkins Date: Mon, 17 Apr 2023 16:11:00 -0700 Subject: [PATCH 2/3] work with haskell >= 9.6 --- src/Hint/PatternWildCard.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Hint/PatternWildCard.hs b/src/Hint/PatternWildCard.hs index b3e93d497..ba4478440 100644 --- a/src/Hint/PatternWildCard.hs +++ b/src/Hint/PatternWildCard.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {- Warn against wildcards in pattern @@ -22,7 +23,11 @@ patternWildCardHint :: DeclHint patternWildCardHint _ _ code = concatMap inspectCode $ childrenBi code inspectCode :: LHsExpr GhcPs -> [Idea] +#if __GLASGOW_HASKELL__ >= 906 +inspectCode (L _ ((HsCase _ _ (MG _ (L _ cases))))) = concatMap inspectCase cases +#else inspectCode (L _ ((HsCase _ _ (MG _ (L _ cases) _)))) = concatMap inspectCase cases +#endif inspectCode o = concatMap inspectCode $ children o inspectCase :: LMatch GhcPs (LHsExpr GhcPs) -> [Idea] From 8d330e7ed248154aa6d1ee51bf25e87dbfa038be Mon Sep 17 00:00:00 2001 From: Stephen Judkins Date: Thu, 16 Mar 2023 15:12:21 -0700 Subject: [PATCH 3/3] PatternWildCard hint --- hints.md | 32 +++++++++++++++++++++++++++++++ hlint.cabal | 1 + src/Hint/All.hs | 4 +++- src/Hint/PatternWildCard.hs | 38 +++++++++++++++++++++++++++++++++++++ 4 files changed, 74 insertions(+), 1 deletion(-) create mode 100644 src/Hint/PatternWildCard.hs diff --git a/hints.md b/hints.md index 2c4a20dfc..fa4beee2e 100644 --- a/hints.md +++ b/hints.md @@ -1433,6 +1433,38 @@ x
+## Builtin PatternWildCard + + + + + + + + + + + + +
Hint NameHintSeverity
Don't use wildcard in pattern match +Example: + +case x of { Foo _ -> spam } + +
+Found: + +_ + +
+Suggestion: + + + +
+Does not support refactoring. +		Ignore
+ ## Builtin Pragma diff --git a/hlint.cabal b/hlint.cabal index c3c8e2d45..9dffc6988 100644 --- a/hlint.cabal +++ b/hlint.cabal @@ -162,6 +162,7 @@ library Hint.Negation Hint.NewType Hint.Pattern + Hint.PatternWildCard Hint.Pragma Hint.Restrict Hint.Smell diff --git a/src/Hint/All.hs b/src/Hint/All.hs index 41665c8ef..33715f1e4 100644 --- a/src/Hint/All.hs +++ b/src/Hint/All.hs @@ -34,6 +34,7 @@ import Hint.Unsafe import Hint.NewType import Hint.Smell import Hint.NumLiteral +import Hint.PatternWildCard -- | A list of the builtin hints wired into HLint. -- This list is likely to grow over time. @@ -41,7 +42,7 @@ data HintBuiltin = HintList | HintListRec | HintMonad | HintLambda | HintFixities | HintNegation | HintBracket | HintNaming | HintPattern | HintImport | HintExport | HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict | - HintComment | HintNewType | HintSmell | HintNumLiteral + HintComment | HintNewType | HintSmell | HintNumLiteral | HintPatternWildCard deriving (Show,Eq,Ord,Bounded,Enum) -- See https://github.com/ndmitchell/hlint/issues/1150 - Duplicate is too slow @@ -70,6 +71,7 @@ builtin x = case x of HintMonad -> decl monadHint HintExtensions -> modu extensionsHint HintNumLiteral -> decl numLiteralHint + HintPatternWildCard -> decl patternWildCardHint where wrap = timed "Hint" (drop 4 $ show x) . forceList decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c} diff --git a/src/Hint/PatternWildCard.hs b/src/Hint/PatternWildCard.hs new file mode 100644 index 000000000..d5853f912 --- /dev/null +++ b/src/Hint/PatternWildCard.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE CPP #-} +{- + Warn against wildcards in pattern + + +foo (case x of { Foo _ -> spam }) -- @Ignore ??? +case x of { Foo (Spam (Eggs _)) -> spam } -- @Ignore ??? +case x of { Foo _ -> spam } -- @Ignore ??? +case x of { Foo bar -> spam } +foo (case x of { Foo bar -> spam }) + +-} + +module Hint.PatternWildCard (patternWildCardHint) +where + +import Hint.Type (DeclHint, ignoreNoSuggestion, Idea) +import GHC.Hs +import GHC.Types.SrcLoc +import Data.Generics.Uniplate.DataOnly + +patternWildCardHint :: DeclHint +patternWildCardHint _ _ code = concatMap inspectCode $ childrenBi code + +inspectCode :: LHsExpr GhcPs -> [Idea] +#if __GLASGOW_HASKELL__ >= 906 +inspectCode (L _ ((HsCase _ _ (MG _ (L _ cases))))) = concatMap inspectCase cases +#else +inspectCode (L _ ((HsCase _ _ (MG _ (L _ cases) _)))) = concatMap inspectCase cases +#endif +inspectCode o = concatMap inspectCode $ children o + +inspectCase :: LMatch GhcPs (LHsExpr GhcPs) -> [Idea] +inspectCase c@(L _ (Match _ _ (L _ pats) _)) = concatMap inspectPat pats + +inspectPat :: LPat GhcPs -> [Idea] +inspectPat c@(L _ (WildPat _)) = [ignoreNoSuggestion "Don't use wildcard in pattern match" (reLoc c)] +inspectPat o = concatMap inspectPat $ children o