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 Name |
+Hint |
+Severity |
+
+
+| 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