diff --git a/hints.md b/hints.md index 2c4a20df..fa4beee2 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 c3c8e2d4..9dffc698 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 41665c8e..33715f1e 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 00000000..d5853f91 --- /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