git.iko.soy/elk
on 267f708 help sign in
elk/src/Reporting/Error/Canonicalize.hs
328 lines 9.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Canonicalize where
4import Control.Arrow (second)
5import qualified Data.Char as Char
6import Text.PrettyPrint.ANSI.Leijen (indent, text)
8import qualified AST.Module.Name as ModuleName
9import qualified AST.Type as Type
10import qualified AST.Variable as Var
11import qualified Reporting.Annotation as A
12import qualified Reporting.Error.Helpers as Help
13import qualified Reporting.Region as Region
14import qualified Reporting.Render.Type as RenderType
15import qualified Reporting.Report as Report
18data Error
19 = Var VarError
20 | Pattern PatternError
21 | Alias AliasError
22 | Import ModuleName.Raw ImportError
23 | Export String [String]
24 | DuplicateExport String
25 | Port PortError
26 | BadPort String Type.Canonical
30-- VARIABLES
33data VarError = VarError
34 { varKind :: String
35 , varName :: String
36 , varProblem :: VarProblem
37 , varSuggestions :: [String]
38 }
41data VarProblem
42 = Ambiguous
43 | UnknownQualifier String String
44 | QualifiedUnknown String String
45 | ExposedUnknown
48variable :: String -> String -> VarProblem -> [String] -> Error
49variable kind name problem suggestions =
50 Var (VarError kind name problem suggestions)
54-- PATTERN
57data PatternError
58 = PatternArgMismatch Var.Canonical Int Int
61argMismatch :: Var.Canonical -> Int -> Int -> Error
62argMismatch name expected actual =
63 Pattern (PatternArgMismatch name expected actual)
67-- IMPORTS
70data ImportError
71 = ModuleNotFound [ModuleName.Raw]
72 | ValueNotFound String [String]
75moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error
76moduleNotFound name possibilities =
77 Import name (ModuleNotFound possibilities)
80valueNotFound :: ModuleName.Raw -> String -> [String] -> Error
81valueNotFound name value possibilities =
82 Import name (ValueNotFound value possibilities)
86-- ALIASES
89data AliasError
90 = ArgMismatch Var.Canonical Int Int
91 | SelfRecursive String [String] Type.Raw
92 | MutuallyRecursive [(Region.Region, String, [String], Type.Raw)]
95alias :: Var.Canonical -> Int -> Int -> Error
96alias name expected actual =
97 Alias (ArgMismatch name expected actual)
101-- PORTS
104data PortError =
105 PortError
106 { portName :: String
107 , portType :: Type.Canonical
108 , portMessage :: Maybe String
109 }
112port :: String -> Type.Canonical -> Maybe String -> Error
113port name tipe maybeMessage =
114 Port (PortError name tipe maybeMessage)
118-- TO REPORT
121namingError :: String -> String -> Report.Report
122namingError pre post =
123 Report.report "NAMING ERROR" Nothing pre (text post)
126toReport :: RenderType.Localizer -> Error -> Report.Report
127toReport localizer err =
128 case err of
129 Var (VarError kind name problem suggestions) ->
130 let var = kind ++ " `" ++ name ++ "`"
131 in
132 case problem of
133 Ambiguous ->
134 namingError
135 ("This usage of " ++ var ++ " is ambiguous.")
136 (Help.maybeYouWant suggestions)
138 UnknownQualifier qualifier localName ->
139 namingError
140 ("Cannot find " ++ var ++ ".")
141 ( "The qualifier `" ++ qualifier ++ "` is not in scope. "
142 ++ Help.maybeYouWant (map (\modul -> modul ++ "." ++ localName) suggestions)
143 )
145 QualifiedUnknown qualifier localName ->
146 namingError
147 ("Cannot find " ++ var ++ ".")
148 ( "`" ++ qualifier ++ "` does not expose `" ++ localName ++ "`. "
149 ++ Help.maybeYouWant (map (\v -> qualifier ++ "." ++ v) suggestions)
150 )
152 ExposedUnknown ->
153 namingError
154 ("Cannot find " ++ var)
155 (Help.maybeYouWant suggestions)
157 Pattern patternError ->
158 case patternError of
159 PatternArgMismatch var expected actual ->
160 argMismatchReport "Pattern" var expected actual
162 Alias aliasError ->
163 case aliasError of
164 ArgMismatch var expected actual ->
165 argMismatchReport "Type" var expected actual
167 SelfRecursive name tvars tipe ->
168 Report.report
169 "ALIAS PROBLEM"
170 Nothing
171 "This type alias is recursive, forming an infinite type!"
172 (
173 Help.stack
174 [ Help.reflowParagraph $
175 "When I expand a recursive type alias, it just keeps getting bigger and bigger.\
176 \ So dealiasing results in an infinitely large type! Try this instead:"
177 , indent 4 $
178 RenderType.decl localizer name tvars [(name, [unsafePromote tipe])]
179 , text $
180 "This is kind of a subtle distinction. I suggested the naive fix, but you can\n"
181 ++ "often do something a bit nicer. So I would recommend reading more at:\n"
182 ++ Help.hintLink "recursive-alias"
183 ]
184 )
186 MutuallyRecursive aliases ->
187 Report.report
188 "ALIAS PROBLEM"
189 Nothing
190 "This type alias is part of a mutually recursive set of type aliases."
191 ( Help.stack
192 [ text "The following type aliases are mutually recursive:"
193 , indent 4 (Help.drawCycle (map (\(_, name, _, _) -> name) aliases))
194 , Help.reflowParagraph $
195 "You need to convert at least one `type alias` into a `type`. This is a kind of\
196 \ subtle distinction, so definitely read up on this before you make a fix: "
197 ++ Help.hintLink "recursive-alias"
198 ]
199 )
201 Import name importError ->
202 let moduleName = ModuleName.toString name
203 in
204 case importError of
205 ModuleNotFound suggestions ->
206 namingError
207 ("Could not find a module named `" ++ moduleName ++ "`")
208 (Help.maybeYouWant (map ModuleName.toString suggestions))
210 ValueNotFound value suggestions ->
211 namingError
212 ("Module `" ++ moduleName ++ "` does not expose `" ++ value ++ "`")
213 (Help.maybeYouWant suggestions)
215 Export name suggestions ->
216 namingError
217 ("Could not export `" ++ name ++ "` which is not defined in this module.")
218 (Help.maybeYouWant suggestions)
220 DuplicateExport name ->
221 namingError
222 ("You are trying to export `" ++ name ++ "` multiple times!")
223 "Remove duplicates until there is only one listed."
225 Port (PortError name tipe maybeMessage) ->
226 let
227 context =
228 maybe "" (" the following " ++ ) maybeMessage
229 in
230 Report.report
231 "PORT ERROR"
232 Nothing
233 ("Port `" ++ name ++ "` is trying to communicate an unsupported type."
234 )
235 ( Help.stack
236 [ text ("The specific unsupported type is" ++ context ++ ":")
237 , indent 4 (RenderType.toDoc localizer tipe)
238 , text "The types of values that can flow through in and out of Elm include:"
239 , indent 4 $ Help.reflowParagraph $
240 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
241 \ Tuples, Json.Values, and concrete records."
242 -- TODO add a note about custom decoders and encoders when they exist!
243 ]
244 )
246 BadPort name tipe ->
247 Report.report
248 "PORT ERROR"
249 Nothing
250 ("Port `" ++ name ++ "` has an invalid type."
251 )
252 ( Help.stack
253 [ text ("You are saying it should be:")
254 , indent 4 (RenderType.toDoc localizer tipe)
255 , Help.reflowParagraph $
256 "But you need to use the particular format described here:\
257 \ <http://guide.elm-lang.org/effect_managers/>"
258 ]
259 )
262argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report
263argMismatchReport kind var expected actual =
264 let
265 numArgs =
266 "too "
267 ++ (if actual < expected then "few" else "many")
268 ++ " arguments"
269 in
270 Report.report
271 (map Char.toUpper numArgs)
272 Nothing
273 ( kind ++ " " ++ Var.toString var ++ " has " ++ numArgs ++ "."
274 )
275 (text ("Expecting " ++ show expected ++ ", but got " ++ show actual ++ "."))
278extractSuggestions :: Error -> Maybe [String]
279extractSuggestions err =
280 case err of
281 Var (VarError _ _ _ suggestions) ->
282 Just suggestions
284 Pattern _ ->
285 Nothing
287 Alias _ ->
288 Nothing
290 Import _ importError ->
291 case importError of
292 ModuleNotFound suggestions ->
293 Just (map ModuleName.toString suggestions)
295 ValueNotFound _ suggestions ->
296 Just suggestions
298 Export _ suggestions ->
299 Just suggestions
301 DuplicateExport _ ->
302 Nothing
304 Port _ ->
305 Nothing
307 BadPort _ _ ->
308 Nothing
311unsafePromote :: Type.Raw -> Type.Canonical
312unsafePromote (A.A _ rawType) =
313 case rawType of
314 Type.RLambda arg result ->
315 Type.Lambda (unsafePromote arg) (unsafePromote result)
317 Type.RVar x ->
318 Type.Var x
320 Type.RType (Var.Raw name) ->
321 Type.Type (Var.local name)
323 Type.RApp func args ->
324 Type.App (unsafePromote func) (map unsafePromote args)
326 Type.RRecord fields ext ->
327 Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)