PatternWildCard hint

Author: stephenjudkins

hints.md

@@ -1402,6 +1402,38 @@ x
 </tr>
 </table>
 
+## Builtin PatternWildCard
+
+<table>
+<tr>
+<th>Hint Name</th>
+<th>Hint</th>
+<th>Severity</th>
+</tr>
+<tr>
+<td>Don't use wildcard in pattern match</td>
+<td>
+Example: 
+<code>
+case x of { Foo _ -> spam }
+</code>
+<br>
+Found:
+<code>
+_
+</code>
+<br>
+Suggestion:
+<code>
+
+</code>
+<br>
+Does not support refactoring.
+</td>
+<td>Ignore</td>
+</tr>
+</table>
+
 ## Builtin Pragma
 
 <table>

hlint.cabal

@@ -160,6 +160,7 @@ library
         Hint.Naming
         Hint.NewType
         Hint.Pattern
+        Hint.PatternWildCard
         Hint.Pragma
         Hint.Restrict
         Hint.Smell

src/Hint/All.hs

@@ -33,14 +33,15 @@ 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.
 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}

src/Hint/PatternWildCard.hs

@@ -0,0 +1,33 @@
+{-
+    Warn against wildcards in pattern
+
+<TEST>
+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 })
+</TEST>
+-}
+
+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