git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Reporting/Error/Canonicalize.hs
426 lines 13 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Canonicalize where
5import Control.Arrow ((***))
6import qualified Data.Char as Char
7import qualified Data.Text as Text
8import Data.Text (Text)
10import qualified AST.Declaration as Decl
11import qualified AST.Expression.Canonical as Canonical
12import qualified AST.Module.Name as ModuleName
13import qualified AST.Pattern as P
14import qualified AST.Type as Type
15import qualified AST.Variable as Var
16import qualified Reporting.Annotation as A
17import qualified Reporting.Region as Region
18import qualified Reporting.Render.Type as RenderType
19import qualified Reporting.Report as Report
20import qualified Reporting.Helpers as Help
21import Reporting.Helpers
22 ( Doc, (<>), dullyellow, fillSep, i2t, indent, maybeYouWant, reflowParagraph, text
23 )
27-- CANONICALIZATION ERRORS
30data Error
31 = Var VarError
32 | BadRecursion Region.Region Canonical.Def [Canonical.Def]
33 | BadInfix Region.Region Int Var.Canonical Decl.Assoc Var.Canonical Decl.Assoc
34 | Pattern PatternError
35 | Alias AliasError
36 | Import ModuleName.Raw ImportError
37 | Export Text [Text]
38 | DuplicateExport Text
39 | Port PortError
40 | BadPort Text Type.Canonical
44-- VARIABLES
47data VarError =
48 VarError
49 { varKind :: Text
50 , varName :: Text
51 , varProblem :: VarProblem
52 , varSuggestions :: [Text]
53 }
56data VarProblem
57 = Ambiguous
58 | UnknownQualifier Text Text
59 | QualifiedUnknown Text Text
60 | ExposedUnknown
63variable :: Text -> Text -> VarProblem -> [Text] -> Error
64variable kind name problem suggestions =
65 Var (VarError kind name problem suggestions)
69-- PATTERN
72data PatternError
73 = PatternArgMismatch Var.Canonical Int Int
76argMismatch :: Var.Canonical -> Int -> Int -> Error
77argMismatch name expected actual =
78 Pattern (PatternArgMismatch name expected actual)
82-- IMPORTS
85data ImportError
86 = ModuleNotFound [ModuleName.Raw]
87 | ValueNotFound Text [Text]
90moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error
91moduleNotFound name possibilities =
92 Import name (ModuleNotFound possibilities)
95valueNotFound :: ModuleName.Raw -> Text -> [Text] -> Error
96valueNotFound name value possibilities =
97 Import name (ValueNotFound value possibilities)
101-- ALIASES
104data AliasError
105 = ArgMismatch Var.Canonical Int Int
106 | SelfRecursive Text [Text] Type.Raw
107 | MutuallyRecursive [(Region.Region, Text, [Text], Type.Raw)]
110alias :: Var.Canonical -> Int -> Int -> Error
111alias name expected actual =
112 Alias (ArgMismatch name expected actual)
116-- PORTS
119data PortError =
120 PortError
121 { portName :: Text
122 , portType :: Type.Canonical
123 , portMessage :: Maybe Text
124 }
127port :: Text -> Type.Canonical -> Maybe Text -> Error
128port name tipe maybeMessage =
129 Port (PortError name tipe maybeMessage)
133-- TO REPORT
136namingError :: Text -> Text -> Report.Report
137namingError pre post =
138 Report.report "NAMING ERROR" Nothing pre (text post)
141toReport :: RenderType.Localizer -> Error -> Report.Report
142toReport localizer err =
143 case err of
144 Var (VarError kind name problem suggestions) ->
145 let var = kind <> " `" <> name <> "`"
146 in
147 case problem of
148 Ambiguous ->
149 namingError
150 ("This usage of " <> var <> " is ambiguous.")
151 (maybeYouWant suggestions)
153 UnknownQualifier qualifier localName ->
154 namingError
155 ("Cannot find " <> var <> ".")
156 ( "No module called `" <> qualifier <> "` has been imported. "
157 <> maybeYouWant (map (\modul -> modul <> "." <> localName) suggestions)
158 )
160 QualifiedUnknown qualifier localName ->
161 namingError
162 ("Cannot find " <> var <> ".")
163 ( "`" <> qualifier <> "` does not expose `" <> localName <> "`. "
164 <> maybeYouWant (map (\v -> qualifier <> "." <> v) suggestions)
165 )
167 ExposedUnknown ->
168 namingError
169 ("Cannot find " <> var)
170 (maybeYouWant suggestions)
172 BadRecursion region def defs ->
173 case defs of
174 [] ->
175 badSelfRecursion region (defToText def)
177 _ ->
178 badMutualRecursion region (defToText def) (map (defToText) defs)
180 BadInfix region _prec (Var.Canonical _ name1) _assoc1 (Var.Canonical _ name2) _assoc2 ->
181 Report.report
182 "INFIX PROBLEM"
183 (Just region)
184 ("You cannot mix (" <> name1 <> ") and (" <> name2 <> ") without parentheses." )
185 (
186 Help.stack
187 [ reflowParagraph $
188 "I do not know how to group these expressions. Add parentheses for me!"
189 ]
190 )
192 Pattern patternError ->
193 case patternError of
194 PatternArgMismatch var expected actual ->
195 argMismatchReport "Pattern" var expected actual
197 Alias aliasError ->
198 case aliasError of
199 ArgMismatch var expected actual ->
200 argMismatchReport "Type" var expected actual
202 SelfRecursive name tvars tipe ->
203 Report.report
204 "ALIAS PROBLEM"
205 Nothing
206 "This type alias is recursive, forming an infinite type!"
207 (
208 Help.stack
209 [ reflowParagraph $
210 "When I expand a recursive type alias, it just keeps getting bigger and bigger.\
211 \ So dealiasing results in an infinitely large type! Try this instead:"
212 , indent 4 $
213 RenderType.decl localizer name tvars [(name, [unsafePromote tipe])]
214 , text $
215 "This is kind of a subtle distinction. I suggested the naive fix, but you can\n"
216 <> "often do something a bit nicer. So I would recommend reading more at:\n"
217 <> Help.hintLink "recursive-alias"
218 ]
219 )
221 MutuallyRecursive aliases ->
222 Report.report
223 "ALIAS PROBLEM"
224 Nothing
225 "This type alias is part of a mutually recursive set of type aliases."
226 ( Help.stack
227 [ text "The following type aliases are mutually recursive:"
228 , indent 4 (Help.drawCycle (map (\(_, name, _, _) -> name) aliases))
229 , reflowParagraph $
230 "You need to convert at least one `type alias` into a `type`. This is a kind of\
231 \ subtle distinction, so definitely read up on this before you make a fix: "
232 <> Help.hintLink "recursive-alias"
233 ]
234 )
236 Import name importError ->
237 let moduleName = ModuleName.toText name
238 in
239 case importError of
240 ModuleNotFound suggestions ->
241 namingError
242 ("Could not find a module named `" <> moduleName <> "`")
243 (maybeYouWant suggestions)
245 ValueNotFound value suggestions ->
246 namingError
247 ("Module `" <> moduleName <> "` does not expose `" <> value <> "`")
248 (maybeYouWant suggestions)
250 Export name suggestions ->
251 namingError
252 ("Could not export `" <> name <> "` which is not defined in this module.")
253 (maybeYouWant suggestions)
255 DuplicateExport name ->
256 namingError
257 ("You are trying to export `" <> name <> "` multiple times!")
258 "Remove duplicates until there is only one listed."
260 Port (PortError name tipe maybeMessage) ->
261 let
262 context =
263 maybe "" (" the following " <> ) maybeMessage
264 in
265 Report.report
266 "PORT ERROR"
267 Nothing
268 ("Port `" <> name <> "` is trying to communicate an unsupported type."
269 )
270 ( Help.stack
271 [ text ("The specific unsupported type is" <> context <> ":")
272 , indent 4 (RenderType.toDoc localizer tipe)
273 , text "The types of values that can flow through in and out of Elm include:"
274 , indent 4 $ reflowParagraph $
275 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
276 \ Tuples, Json.Values, and concrete records."
277 -- TODO add a note about custom decoders and encoders when they exist!
278 ]
279 )
281 BadPort name tipe ->
282 Report.report
283 "PORT ERROR"
284 Nothing
285 ("Port `" <> name <> "` has an invalid type."
286 )
287 ( Help.stack
288 [ text ("You are saying it should be:")
289 , indent 4 (RenderType.toDoc localizer tipe)
290 , reflowParagraph $
291 "But you need to use the particular format described here:\
292 \ <http://guide.elm-lang.org/interop/javascript.html#ports>"
293 ]
294 )
297argMismatchReport :: Text -> Var.Canonical -> Int -> Int -> Report.Report
298argMismatchReport kind var expected actual =
299 let
300 numArgs =
301 "too "
302 <> (if actual < expected then "few" else "many")
303 <> " arguments"
304 in
305 Report.report
306 (Text.map Char.toUpper numArgs)
307 Nothing
308 ( kind <> " " <> Var.toText var <> " has " <> numArgs <> "."
309 )
310 ( text $
311 "Expecting " <> i2t expected <> ", but got " <> i2t actual <> "."
312 )
316extractSuggestions :: Error -> Maybe [Text]
317extractSuggestions err =
318 case err of
319 Var (VarError _ _ _ suggestions) ->
320 Just suggestions
322 BadRecursion _ _ _ ->
323 Nothing
325 BadInfix _ _ _ _ _ _ ->
326 Nothing
328 Pattern _ ->
329 Nothing
331 Alias _ ->
332 Nothing
334 Import _ importError ->
335 case importError of
336 ModuleNotFound suggestions ->
337 Just (map ModuleName.toText suggestions)
339 ValueNotFound _ suggestions ->
340 Just suggestions
342 Export _ suggestions ->
343 Just suggestions
345 DuplicateExport _ ->
346 Nothing
348 Port _ ->
349 Nothing
351 BadPort _ _ ->
352 Nothing
355unsafePromote :: Type.Raw -> Type.Canonical
356unsafePromote (A.A _ rawType) =
357 case rawType of
358 Type.RLambda arg result ->
359 Type.Lambda (unsafePromote arg) (unsafePromote result)
361 Type.RVar x ->
362 Type.Var x
364 Type.RType (Var.Raw name) ->
365 Type.Type (Var.local name)
367 Type.RApp func args ->
368 Type.App (unsafePromote func) (map unsafePromote args)
370 Type.RRecord fields ext ->
371 Type.Record (map (A.drop *** unsafePromote) fields) (fmap unsafePromote ext)
375-- BAD RECURSION
378badSelfRecursion :: Region.Region -> Text -> Report.Report
379badSelfRecursion region name =
380 let
381 header =
382 Help.functionName name <> " is defined directly in terms of itself, causing an infinite loop."
383 in
384 Report.report "BAD RECURSION" (Just region) header $
385 Help.stack
386 [ badSelfRecursionHelp "Maybe you are trying to mutate a variable?" $
387 "Elm does not have mutation, so when I see " <> Help.functionName name
388 <> " defined in terms of " <> Help.functionName name
389 <> ", I treat it as a recursive definition. Try giving the new value a new name!"
390 , badSelfRecursionHelp "Maybe you DO want a recursive value?" $
391 "To define " <> Help.functionName name <> " we need to know what " <> Help.functionName name
392 <> " is, so let’s expand it. Wait, but now we need to know what " <> Help.functionName name
393 <> " is, so let’s expand it... This will keep going infinitely!"
394 , badSelfRecursionHelp "To really learn what is going on and how to fix it, check out:" $
395 Help.hintLink "bad-recursion"
396 ]
399badSelfRecursionHelp :: Text -> Text -> Doc
400badSelfRecursionHelp intro body =
401 fillSep $
402 map (dullyellow . text) (Text.words intro)
403 ++ map text (Text.words body)
406badMutualRecursion :: Region.Region -> Text -> [Text] -> Report.Report
407badMutualRecursion region name names =
408 let
409 header =
410 Help.functionName name <> " is defined in terms of itself in a sneaky way, causing an infinite loop."
411 in
412 Report.report "BAD RECURSION" (Just region) header $
413 Help.stack
414 [ reflowParagraph $
415 "The following definitions depend directly on each other:"
416 , indent 4 $ Help.drawCycle (name : names)
417 , reflowParagraph $
418 "You seem to have a fairly tricky case, so I very highly recommend reading this: "
419 <> Help.hintLink "bad-recursion"
420 <> " It will help you really understand the problem and how to fix it. Read it!"
421 ]
424defToText :: Canonical.Def -> Text
425defToText (Canonical.Def _ pattern _ _) =
426 P.toText pattern