@@ -2,9 +2,6 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Reporting.Error.Canonicalize where
44
5−--import Data.Aeson ((.=))
6−import qualified Data.Aeson as Json
7−--import qualified Data.Aeson.Types as Json
85import Data.Function (on)
96import qualified Data.List as List
107import qualified Text.EditDistance as Dist
@@ -15,7 +12,8 @@ import qualified AST.Type as Type
1512import qualified AST.Variable as Var
1613import Elm.Utils ((|>))
1714import qualified Reporting.PrettyPrint as P
18−import qualified Reporting.Region as R
15+import qualified Reporting.Region as Region
16+import qualified Reporting.Report as Report
1917
2018
2119data Error
@@ -82,7 +80,7 @@ valueNotFound name value possibilities =
8280data AliasError
8381 = ArgMismatch Var.Canonical Int Int
8482 | SelfRecursive String [String] Type.Raw
85− | MutuallyRecursive [(R.Region, String, [String], Type.Raw)]
83+ | MutuallyRecursive [(Region.Region, String, [String], Type.Raw)]
8684
8785
8886alias :: Var.Canonical -> Int -> Int -> Error
@@ -131,126 +129,126 @@ distance x y =
131129 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
132130
133131
134−-- TO STRING
132+-- TO REPORT
135133
136−toString :: R.Region -> Error -> String
137−toString region err =
138− case err of
139− _ -> error "Canonicalize.toString" region
140−
141−
142−-- TO JSON
143−
144−toJson :: Error -> Json.Value
145−toJson err =
146− case err of
147− _ -> error "Canonicalize.toJson"
148−
149−
150−-- HINTS
151−
152−toHint :: Error -> String
153−toHint err =
134+toReport :: Error -> Report.Report
135+toReport err =
154136 case err of
155137 Var (VarError kind name problem suggestions) ->
156− let var = kind ++ "'" ++ name ++ "'"
138+ let var = kind ++ " '" ++ name ++ "'"
157139 in
158140 case problem of
159141 Ambiguous ->
160− "This usage of " ++ var ++ " is ambiguous"
161− ++ maybeYouWant "\n\n" suggestions
142+ Report.simple
143+ ("This usage of " ++ var ++ " is ambiguous.")
144+ (maybeYouWant suggestions)
162145
163146 UnknownQualifier qualifier ->
164− "Cannot find " ++ var ++ "\n\n"
165− ++ "The qualifier " ++ qualifier ++ " is not in scope."
166− ++ maybeYouWant "\n" suggestions
147+ Report.simple
148+ ("Cannot find " ++ var ++ ", qualifier '" ++ qualifier ++ "' is not in scope.")
149+ (maybeYouWant suggestions)
167150
168151 QualifiedUnknown qualifier ->
169− "Cannot find " ++ var ++ "\n\n"
170− ++ "The module called " ++ qualifier ++ " does not expose that value."
171− ++ maybeYouWant "\n" suggestions
152+ Report.simple
153+ ("Cannot find " ++ var ++ ", module '" ++ qualifier ++ "'' does not expose that value.")
154+ (maybeYouWant suggestions)
172155
173156 ExposedUnknown ->
174− "Cannot find " ++ var
175− ++ maybeYouWant "\n\n" suggestions
157+ Report.simple
158+ ("Cannot find " ++ var)
159+ (maybeYouWant suggestions)
176160
177161 Pattern patternError ->
178162 case patternError of
179163 PatternArgMismatch var expected actual ->
180− argMismatchHint "pattern" var expected actual
164+ argMismatchReport "Pattern" var expected actual
181165
182166 Alias aliasError ->
183167 case aliasError of
184168 ArgMismatch var expected actual ->
185− argMismatchHint "type" var expected actual
169+ argMismatchReport "Type" var expected actual
186170
187171 SelfRecursive name tvars tipe ->
188− "This type alias is recursive, forming an infinite type!\n\n"
189− ++ "Type aliases are just names for more fundamental types, so I go through\n"
190− ++ "and expand them all to know the real underlying type. The problem is that\n"
191− ++ "when I expand a recursive type alias, it keeps getting bigger and bigger.\n"
192− ++ "Dealiasing results in an infinitely large type! Try this instead:\n\n"
193− ++ " type " ++ name ++ concatMap (' ':) tvars ++ " ="
194− ++ P.render (P.nest 8 (P.hang (P.text name) 2 (P.pretty True tipe)))
195− ++ "\n\nThis creates a brand new type that cannot be expanded. It is similar types\n"
196− ++ "like List which are recursive, but do not get expanded into infinite types."
172+ Report.simple "This type alias is recursive, forming an infinite type!" $
173+ "Type aliases are just names for more fundamental types, so I go through\n"
174+ ++ "and expand them all to know the real underlying type. The problem is that\n"
175+ ++ "when I expand a recursive type alias, it keeps getting bigger and bigger.\n"
176+ ++ "Dealiasing results in an infinitely large type! Try this instead:\n\n"
177+ ++ " type " ++ name ++ concatMap (' ':) tvars ++ " ="
178+ ++ P.render (P.nest 8 (P.hang (P.text name) 2 (P.pretty True tipe)))
179+ ++ "\n\nThis creates a brand new type that cannot be expanded. It is similar types\n"
180+ ++ "like List which are recursive, but do not get expanded into infinite types."
197181
198182 MutuallyRecursive aliases ->
199− "This type alias is part of a mutually recursive set of type aliases.\n"
200− ++ "The following type aliases all depend on each other in some way:\n"
201− ++ concatMap showName aliases ++ "\n\n"
202− ++ "The problem is that when you try to expand any of these type aliases, they\n"
203− ++ "expand infinitely! To fix, first try to centralize them into one alias."
183+ Report.simple "This type alias is part of a mutually recursive set of type aliases." $
184+ "The following type aliases all depend on each other in some way:\n"
185+ ++ concatMap showName aliases ++ "\n\n"
186+ ++ "The problem is that when you try to expand any of these type aliases, they\n"
187+ ++ "expand infinitely! To fix, first try to centralize them into one alias."
204188 where
205− showName (R.Region start _, name, _, _) =
189+ showName (Region.Region start _, name, _, _) =
206190 "\n " ++ name ++ replicate (65 - length name) ' '
207− ++ "line " ++ show (R.line start)
191+ ++ "line " ++ show (Region.line start)
208192
209193 Import name importError ->
194+ let moduleName = Module.nameToString name
195+ in
210196 case importError of
211197 ModuleNotFound suggestions ->
212− "Could not find a module named '" ++ Module.nameToString name ++ "'"
213− ++ maybeYouWant "\n\n" (map Module.nameToString suggestions)
198+ Report.simple
199+ ("Could not find a module named '" ++ moduleName ++ "'")
200+ (maybeYouWant (map Module.nameToString suggestions))
214201
215202 ValueNotFound value suggestions ->
216− "Module '" ++ Module.nameToString name ++ "' does not expose '" ++ value ++ "'"
217− ++ maybeYouWant "\n\n" suggestions
203+ Report.simple
204+ ("Module '" ++ moduleName ++ "' does not expose '" ++ value ++ "'")
205+ (maybeYouWant suggestions)
218206
219207 Export name suggestions ->
220− "Could not export '" ++ name ++ "'\n\n"
221− ++ "It is not defined in this module."
222− ++ maybeYouWant " " suggestions
208+ Report.simple
209+ ("Could not export '" ++ name ++ "' which is not defined in this module.")
210+ (maybeYouWant suggestions)
223211
224212 Port (PortError name isInbound _rootType localType maybeMessage) ->
225− "Cannot pass " ++ message ++ " through " ++ boundPort ++ " '" ++ name ++ "':\n\n"
226− ++ P.render (P.nest 4 (P.pretty False localType)) ++ "\n\n"
227− ++ "The kinds of values that can flow through " ++ boundPort ++ "s include:\n"
228− ++ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples,\n"
229− ++ "Json.Values, and concrete records."
230− where
231− boundPort =
232− if isInbound then "inbound port" else "outbound port"
213+ let
214+ boundPort =
215+ if isInbound then "inbound port" else "outbound port"
216+
217+ preHint =
218+ "Trying to send " ++ maybe "an unsupported type" id maybeMessage
219+ ++ " through " ++ boundPort ++ " '" ++ name ++ "'"
220+
221+ postHint =
222+ "The specific unsupported type is:\n\n"
223+ ++ P.render (P.nest 4 (P.pretty False localType)) ++ "\n\n"
224+ ++ "The types of values that can flow through " ++ boundPort ++ "s include:\n"
225+ ++ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples,\n"
226+ ++ "Json.Values, and concrete records."
227+ in
228+ Report.simple preHint postHint
233229
234− message =
235− maybe "the following type" id maybeMessage
236230
231+argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report
232+argMismatchReport kind var expected actual =
233+ let
234+ preHint =
235+ kind ++ " " ++ Var.toString var ++ " has too "
236+ ++ (if actual < expected then "few" else "many")
237+ ++ "arguments."
237238
238−argMismatchHint :: String -> Var.Canonical -> Int -> Int -> String
239−argMismatchHint kind var expected actual =
240− "The " ++ kind ++ " " ++ Var.toString var ++ " has too "
241− ++ (if actual < expected then "few" else "many")
242− ++ "arguments.\n\n"
243− ++ "Expecting " ++ show expected ++ ", but got " ++ show actual
239+ postHint =
240+ "Expecting " ++ show expected ++ ", but got " ++ show actual ++ "."
241+ in
242+ Report.Report Nothing preHint postHint
244243
245244
246−maybeYouWant :: String -> [String] -> String
247−maybeYouWant prefix suggestions =
245+maybeYouWant :: [String] -> String
246+maybeYouWant suggestions =
248247 case suggestions of
249248 [] ->
250249 ""
251250
252251 _:_ ->
253− prefix
254− ++ "Maybe you want one of the following?\n"
252+ "Maybe you want one of the following?\n"
255253 ++ concatMap ("\n "++) suggestions
256254