-matchCheck_really dflags ctx vars ty qs
- | incomplete && shadow = do
- dsShadowWarn ctx eqns_shadow
- dsIncompleteWarn ctx pats
- match vars ty qs
- | incomplete = do
- dsIncompleteWarn ctx pats
- match vars ty qs
- | shadow = do
- dsShadowWarn ctx eqns_shadow
- match vars ty qs
- | otherwise =
- match vars ty qs
- where (pats, eqns_shadow) = check qs
- incomplete = want_incomplete && (notNull pats)
- want_incomplete = case ctx of
- DsMatchContext RecUpd _ ->
- dopt Opt_WarnIncompletePatternsRecUpd dflags
- _ ->
- dopt Opt_WarnIncompletePatterns dflags
- shadow = dopt Opt_WarnOverlappingPatterns dflags
- && not (null eqns_shadow)
+matchCheck_really dflags ctx@(DsMatchContext hs_ctx _) vars ty qs
+ = do { when shadow (dsShadowWarn ctx eqns_shadow)
+ ; when incomplete (dsIncompleteWarn ctx pats)
+ ; match vars ty qs }
+ where
+ (pats, eqns_shadow) = check qs
+ incomplete = incomplete_flag hs_ctx && (notNull pats)
+ shadow = dopt Opt_WarnOverlappingPatterns dflags
+ && notNull eqns_shadow
+
+ incomplete_flag :: HsMatchContext id -> Bool
+ incomplete_flag (FunRhs {}) = dopt Opt_WarnIncompletePatterns dflags
+ incomplete_flag CaseAlt = dopt Opt_WarnIncompletePatterns dflags
+
+ incomplete_flag LambdaExpr = dopt Opt_WarnIncompleteUniPatterns dflags
+ incomplete_flag PatBindRhs = dopt Opt_WarnIncompleteUniPatterns dflags
+ incomplete_flag ProcExpr = dopt Opt_WarnIncompleteUniPatterns dflags
+
+ incomplete_flag RecUpd = dopt Opt_WarnIncompletePatternsRecUpd dflags
+
+ incomplete_flag ThPatQuote = False
+ incomplete_flag (StmtCtxt {}) = False -- Don't warn about incomplete patterns
+ -- in list comprehensions, pattern guards
+ -- etc. They are often *supposed* to be
+ -- incomplete