git.iko.soy/elk
on master help sign in
Pleasant messages when a pattern is missing
c2e4a69Evan Czaplicki
elm-compiler.cabal+1
compare with master
unifiedsplit
@@ -79,6 +79,7 @@ Library
79 Generate.JavaScript.Helpers,
79 Generate.JavaScript.Helpers,
80 Generate.JavaScript.Port,
80 Generate.JavaScript.Port,
81 Generate.JavaScript.Variable,
81 Generate.JavaScript.Variable,
82+ Nitpick.Pattern,
82 Nitpick.PatternMatches,
83 Nitpick.PatternMatches,
83 Nitpick.TopLevelTypes,
84 Nitpick.TopLevelTypes,
84 Optimize,
85 Optimize,
src/Nitpick/Pattern.hs+61
@@ -1,5 +1,6 @@
1module Nitpick.Pattern where
1module Nitpick.Pattern where
2
2
3+import qualified Data.List as List
3import qualified Data.Set as Set
4import qualified Data.Set as Set
4
5
5import qualified AST.Literal as L
6import qualified AST.Literal as L
@@ -8,3 +9,63 @@ import qualified AST.Variable as Var
8import qualified Reporting.Annotation as A
9import qualified Reporting.Annotation as A
9
10
10
11
12+data Pattern
13+ = Data Var.Canonical [Pattern]
14+ | Record [String]
15+ | Alias String Pattern
16+ | Var String
17+ | Anything
18+ | Literal L.Literal
19+ | AnythingBut (Set.Set L.Literal)
20+ deriving (Show, Eq)
21+
22+
23+fromCanonicalPattern :: P.CanonicalPattern -> Pattern
24+fromCanonicalPattern (A.A _ pattern) =
25+ case pattern of
26+ P.Data tag patterns ->
27+ Data tag (map fromCanonicalPattern patterns)
28+
29+ P.Record fields ->
30+ Record fields
31+
32+ P.Alias name pattern ->
33+ Alias name (fromCanonicalPattern pattern)
34+
35+ P.Var name ->
36+ Var name
37+
38+ P.Anything ->
39+ Anything
40+
41+ P.Literal literal ->
42+ Literal literal
43+
44+
45+-- TO STRING
46+
47+toString :: Pattern -> String
48+toString pattern =
49+ case pattern of
50+ Data tag args ->
51+ List.intercalate " " (Var.toString tag : map toString args)
52+
53+ Record fields ->
54+ "{ " ++ List.intercalate ", " fields ++ " }"
55+
56+ Alias alias realPattern ->
57+ toString realPattern ++ " as " ++ alias
58+
59+ Var name ->
60+ name
61+
62+ Anything ->
63+ "_"
64+
65+ Literal literal ->
66+ L.toString literal
67+
68+ AnythingBut literalSet ->
69+ List.intercalate " " ("<values besides:" : map L.toString (Set.toList literalSet))
70+
71+
src/Nitpick/PatternMatches.hs+11−48
@@ -10,11 +10,11 @@ import qualified Data.Set as Set
10import qualified AST.Expression.General as E
10import qualified AST.Expression.General as E
11import qualified AST.Expression.Canonical as Canonical
11import qualified AST.Expression.Canonical as Canonical
12import qualified AST.Helpers as Help
12import qualified AST.Helpers as Help
13−import qualified AST.Literal as L
14import qualified AST.Module as Module
13import qualified AST.Module as Module
15−import qualified AST.Pattern as P
14+import qualified AST.Pattern as Pattern
16import qualified AST.Variable as Var
15import qualified AST.Variable as Var
17import Elm.Utils ((|>))
16import Elm.Utils ((|>))
17+import Nitpick.Pattern (Pattern(..), fromCanonicalPattern)
18import qualified Reporting.Annotation as A
18import qualified Reporting.Annotation as A
19import qualified Reporting.Region as Region
19import qualified Reporting.Region as Region
20import qualified Reporting.Result as Result
20import qualified Reporting.Result as Result
@@ -35,42 +35,6 @@ patternMatches interfaces modul =
35 (Module.program body)
35 (Module.program body)
36
36
37
37
38−-- PATTERN MATCH DATA STRUCTURE
39−
40−data Pattern
41− = Data Var.Canonical [Pattern]
42− | Record [String]
43− | Alias String Pattern
44− | Var String
45− | Anything
46− | Literal L.Literal
47− | AnythingBut (Set.Set L.Literal)
48− deriving (Show, Eq)
49−
50−
51−fromCanonicalPattern :: P.CanonicalPattern -> Pattern
52−fromCanonicalPattern (A.A _ pattern) =
53− case pattern of
54− P.Data ctor patterns ->
55− Data ctor (map fromCanonicalPattern patterns)
56−
57− P.Record fields ->
58− Record fields
59−
60− P.Alias name pattern ->
61− Alias name (fromCanonicalPattern pattern)
62−
63− P.Var name ->
64− Var name
65−
66− P.Anything ->
67− Anything
68−
69− P.Literal literal ->
70− Literal literal
71−
72−
73−
74-- TAG DICT
38-- TAG DICT
75
39
76type TagDict =
40type TagDict =
@@ -116,8 +80,8 @@ toTagMapping adts =
116 |> Map.fromList
80 |> Map.fromList
117
81
118
82
119−lookupOtherCtors :: Var.Canonical -> TagDict -> [(Tag, Int)]
83+lookupOtherTags :: Var.Canonical -> TagDict -> [(Tag, Int)]
120−lookupOtherCtors (Var.Canonical home name) tagDict =
84+lookupOtherTags (Var.Canonical home name) tagDict =
121 case Map.lookup name =<< Map.lookup home tagDict of
85 case Map.lookup name =<< Map.lookup home tagDict of
122 Just otherTags ->
86 Just otherTags ->
123 otherTags
87 otherTags
@@ -144,7 +108,7 @@ checkExpression tagDict (A.A region expression) =
144 checkExpression tagDict
108 checkExpression tagDict
145
109
146 go2 a b =
110 go2 a b =
147− F.traverse_ go [a,b]
111+ go a <* go b
148
112
149 goPattern =
113 goPattern =
150 checkPatterns tagDict region
114 checkPatterns tagDict region
@@ -157,8 +121,7 @@ checkExpression tagDict (A.A region expression) =
157 Result.ok ()
121 Result.ok ()
158
122
159 E.Range low high ->
123 E.Range low high ->
160− go low
161− <* go high
124+ go2 low high
162
125
163 E.ExplicitList listExprs ->
126 E.ExplicitList listExprs ->
164 F.traverse_ go listExprs
127 F.traverse_ go listExprs
@@ -232,7 +195,7 @@ checkExpression tagDict (A.A region expression) =
232checkPatterns
195checkPatterns
233 :: TagDict
196 :: TagDict
234 -> Region.Region
197 -> Region.Region
235− -> [P.CanonicalPattern]
198+ -> [Pattern.CanonicalPattern]
236 -> Result.Result Warning.Warning e ()
199 -> Result.Result Warning.Warning e ()
237checkPatterns tagDict region patterns =
200checkPatterns tagDict region patterns =
238 checkPatternsHelp tagDict region [Anything] patterns
201 checkPatternsHelp tagDict region [Anything] patterns
@@ -242,7 +205,7 @@ checkPatternsHelp
242 :: TagDict
205 :: TagDict
243 -> Region.Region
206 -> Region.Region
244 -> [Pattern]
207 -> [Pattern]
245− -> [P.CanonicalPattern]
208+ -> [Pattern.CanonicalPattern]
246 -> Result.Result Warning.Warning e ()
209 -> Result.Result Warning.Warning e ()
247checkPatternsHelp tagDict region unhandled patterns =
210checkPatternsHelp tagDict region unhandled patterns =
248 case (unhandled, patterns) of
211 case (unhandled, patterns) of
@@ -250,7 +213,7 @@ checkPatternsHelp tagDict region unhandled patterns =
250 return ()
213 return ()
251
214
252 (_:_, []) ->
215 (_:_, []) ->
253− Result.warn region Warning.InexhaustivePatternMatch
216+ Result.warn region (Warning.InexhaustivePatternMatch unhandled)
254
217
255 (_, pattern@(A.A localRegion _) : remainingPatterns) ->
218 (_, pattern@(A.A localRegion _) : remainingPatterns) ->
256 do newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
219 do newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
@@ -260,7 +223,7 @@ checkPatternsHelp tagDict region unhandled patterns =
260filterPatterns
223filterPatterns
261 :: TagDict
224 :: TagDict
262 -> Region.Region
225 -> Region.Region
263− -> P.CanonicalPattern
226+ -> Pattern.CanonicalPattern
264 -> [Pattern]
227 -> [Pattern]
265 -> Result.Result Warning.Warning e [Pattern]
228 -> Result.Result Warning.Warning e [Pattern]
266filterPatterns tagDict region pattern unhandled =
229filterPatterns tagDict region pattern unhandled =
@@ -370,7 +333,7 @@ complementData :: TagDict -> Var.Canonical -> [Pattern] -> [Pattern]
370complementData tagDict tag patterns =
333complementData tagDict tag patterns =
371 let
334 let
372 otherTags =
335 otherTags =
373− lookupOtherCtors tag tagDict
336+ lookupOtherTags tag tagDict
374
337
375 tagComplements =
338 tagComplements =
376 Maybe.mapMaybe (tagToPattern tag) otherTags
339 Maybe.mapMaybe (tagToPattern tag) otherTags
src/Reporting/Warning.hs+28−8
@@ -9,6 +9,7 @@ import Text.PrettyPrint ((<+>))
9
9
10import qualified AST.Module as Module
10import qualified AST.Module as Module
11import qualified AST.Type as Type
11import qualified AST.Type as Type
12+import qualified Nitpick.Pattern as Pattern
12import qualified Reporting.Annotation as A
13import qualified Reporting.Annotation as A
13import qualified Reporting.PrettyPrint as P
14import qualified Reporting.PrettyPrint as P
14import qualified Reporting.Report as Report
15import qualified Reporting.Report as Report
@@ -19,7 +20,7 @@ import qualified Reporting.Report as Report
19data Warning
20data Warning
20 = UnusedImport Module.Name
21 = UnusedImport Module.Name
21 | MissingTypeAnnotation String Type.Canonical
22 | MissingTypeAnnotation String Type.Canonical
22− | InexhaustivePatternMatch
23+ | InexhaustivePatternMatch [Pattern.Pattern]
23 | RedundantPatternMatch
24 | RedundantPatternMatch
24
25
25
26
@@ -58,18 +59,24 @@ toReport dealiaser warning =
58 4
59 4
59 (P.pretty dealiaser False inferredType)
60 (P.pretty dealiaser False inferredType)
60
61
61− InexhaustivePatternMatch ->
62+ InexhaustivePatternMatch unhandled ->
62 Report.simple
63 Report.simple
63 "missing pattern"
64 "missing pattern"
64 "The following case expression does not handle all possible inputs."
65 "The following case expression does not handle all possible inputs."
65− ( "If none of the patterns match the given value, we have no choice but to crash!\n"
66+ ( "The following patterns are not being handled:\n"
67+ ++ viewPatternList unhandled
68+ ++ "\n\n"
69+ ++ "If we get values like this, we have no choice but to crash! Normally this means\n"
70+ ++ "you just added a new tag to a union type, but sometimes it can be because there\n"
71+ ++ "is something very odd about the data you are modeling. In those rare cases, you\n"
72+ ++ "probably want to either:\n"
66 ++ "\n"
73 ++ "\n"
67− ++ "If you somehow know that this pattern can never happen, you want to:\n"
74+ ++ " 1. Rethink the model. Maybe some cases are \"impossible\" but it is still\n"
68− ++ "\n"
75+ ++ " possible to construct such cases. Is there a way to model the values more\n"
69− ++ " 1. Rethink the data structures you are using. Is there a way to model the\n"
76+ ++ " precisely such that \"impossible\" values truly are impossible?\n"
70− ++ " values more precisely?\n"
71 ++ " 2. End the pattern match with a wildcard match that leads to an expression\n"
77 ++ " 2. End the pattern match with a wildcard match that leads to an expression\n"
72− ++ " like: Debug.crash \"This should never happen, but I guess it can!\""
78+ ++ " like: Debug.crash \"If you are reading this, I have made a mistake!\"\n"
79+ ++ " Generally speaking, you do not want it to have to be this way."
73 )
80 )
74
81
75 RedundantPatternMatch ->
82 RedundantPatternMatch ->
@@ -93,3 +100,16 @@ toJson dealiaser filePath (A.A region warning) =
93 , "type" .= ("warning" :: String)
100 , "type" .= ("warning" :: String)
94 ]
101 ]
95 ++ additionalFields
102 ++ additionalFields
103+
104+
105+-- PATTERN WARNINGS
106+
107+viewPatternList :: [Pattern.Pattern] -> String
108+viewPatternList unhandledPatterns =
109+ let
110+ (showPatterns, rest) =
111+ splitAt 4 unhandledPatterns
112+ in
113+ concatMap ((++) "\n ") $
114+ map Pattern.toString showPatterns
115+ ++ if null rest then [] else ["..."]