on master help sign in
Add back redundancy check
626b319Evan Czaplicki
src/Nitpick/PatternMatches.hs+29−13
@@ -32,6 +32,9 @@ import qualified Reporting.Result as Result
32
32
33
33
34
34
35+-- NITPICK PATTERN MATCHES
36+
37+
35type Result warning a =
38type Result warning a =
36 Result.Result () warning Error.Error a
39 Result.Result () warning Error.Error a
37
40
@@ -49,10 +52,6 @@ patternMatches interfaces (Module.Module name _ info) =
49 <* checkExpression arityDict (Module.program info)
52 <* checkExpression arityDict (Module.program info)
50
53
51
54
52−
53−-- CHECK EXPRESSIONS
54−
55−
56checkExpression :: ArityDict -> C.Expr -> Result wrn ()
55checkExpression :: ArityDict -> C.Expr -> Result wrn ()
57checkExpression arityDict (A.A region expression) =
56checkExpression arityDict (A.A region expression) =
58 let
57 let
@@ -140,15 +139,32 @@ checkExpression arityDict (A.A region expression) =
140
139
141checkPatterns :: ArityDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
140checkPatterns :: ArityDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
142checkPatterns arityDict region origin patterns =
141checkPatterns arityDict region origin patterns =
143− let
142+ do matrix <- checkRedundant arityDict region [] patterns
144− matrix =
145− map (\p -> [fromCanonicalPattern p]) patterns
146− in
147− if isUseful arityDict matrix [Anything] then
143+ if isUseful arityDict matrix [Anything]
148− Result.throw region (Error.Incomplete origin (error "TODO"))
144+ then Result.throw region (Error.Incomplete origin (error "TODO"))
145+ else Result.ok ()
146+
147+
148+checkRedundant
149+ :: ArityDict
150+ -> Region.Region
151+ -> [[Pattern]]
152+ -> [Pattern.Canonical]
153+ -> Result wrn [[Pattern]]
154+checkRedundant arityDict region checked unchecked =
155+ case unchecked of
156+ [] ->
157+ Result.ok checked
149
158
159+ nextPattern@(A.A patRegion _) : rest ->
160+ let
161+ next =
162+ [fromCanonicalPattern nextPattern]
163+ in
164+ if isUseful arityDict checked next then
165+ checkRedundant arityDict region (next : checked) rest
150− else
166+ else
151− return ()
167+ Result.throw region (Error.Redundant patRegion (length checked + 1))
152
168
153
169
154
170
@@ -163,7 +179,7 @@ checkPatterns arityDict region origin patterns =
163
179
164
180
165
181
166−-- REDUNDANT PATTERNS
182+-- DETECT USEFUL PATTERNS
167
183
168
184
169isUseful :: ArityDict -> [[Pattern]] -> [Pattern] -> Bool
185isUseful :: ArityDict -> [[Pattern]] -> [Pattern] -> Bool
src/Reporting/Error/Pattern.hs+5−4
@@ -6,13 +6,14 @@ import Text.PrettyPrint.ANSI.Leijen (text)
6import qualified Nitpick.Pattern as Pattern
6import qualified Nitpick.Pattern as Pattern
7import qualified Reporting.Error.Helpers as Help
7import qualified Reporting.Error.Helpers as Help
8import qualified Reporting.Render.Type as RenderType
8import qualified Reporting.Render.Type as RenderType
9+import qualified Reporting.Region as Region
9import qualified Reporting.Report as Report
10import qualified Reporting.Report as Report
10
11
11
12
12
13
13data Error
14data Error
14 = Incomplete Origin [Pattern.Pattern]
15 = Incomplete Origin [Pattern.Pattern]
15− | Redundant
16+ | Redundant Region.Region Int
16
17
17
18
18data Origin
19data Origin
@@ -49,11 +50,11 @@ toReport _localizer err =
49 "This `case` does not have branches for all possibilities."
50 "This `case` does not have branches for all possibilities."
50 (text (unhandledError unhandled (missingBranchesMessage (length unhandled))))
51 (text (unhandledError unhandled (missingBranchesMessage (length unhandled))))
51
52
52− Redundant ->
53+ Redundant region index ->
53 Report.report
54 Report.report
54 "REDUNDANT PATTERN"
55 "REDUNDANT PATTERN"
55− Nothing
56+ (Just region)
56− "The following pattern is redundant. Remove it."
57+ ("The " ++ Help.ordinalize index ++ " pattern is redundant. Remove it.")
57 (text "Any value with this shape will be handled by a previous pattern.")
58 (text "Any value with this shape will be handled by a previous pattern.")
58
59
59
60