@@ -2,18 +2,18 @@
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
8+import qualified Text.PrettyPrint as P
119
1210import qualified AST.Module as Module
1311import qualified AST.Type as Type
1412import qualified AST.Variable as Var
1513import Elm.Utils ((|>))
16−import qualified Reporting.Region as R
14+import qualified Reporting.PrettyPrint as P
15+import qualified Reporting.Region as Region
16+import qualified Reporting.Report as Report
1717
1818
1919data Error
@@ -31,19 +31,20 @@ data VarError = VarError
3131 { varKind :: String
3232 , varName :: String
3333 , varProblem :: VarProblem
34+ , varSuggestions :: [String]
3435 }
3536
3637
3738data VarProblem
38− = Ambiguous [String]
39− | UnknownQualifier [Module.Name]
40− | QualifiedUnknown [String]
41− | ExposedUnknown { closeExposed :: [String], closeQualified :: [String] }
39+ = Ambiguous
40+ | UnknownQualifier String
41+ | QualifiedUnknown String
42+ | ExposedUnknown
4243
4344
44−var :: String -> String -> VarProblem -> Error
45−var kind name problem =
46− Var (VarError kind name problem)
45+variable :: String -> String -> VarProblem -> [String] -> Error
46+variable kind name problem suggestions =
47+ Var (VarError kind name problem suggestions)
4748
4849
4950-- PATTERN
@@ -79,7 +80,7 @@ valueNotFound name value possibilities =
7980data AliasError
8081 = ArgMismatch Var.Canonical Int Int
8182 | SelfRecursive String [String] Type.Raw
82− | MutuallyRecursive [(R.Region, String, [String], Type.Raw)]
83+ | MutuallyRecursive [(Region.Region, String, [String], Type.Raw)]
8384
8485
8586alias :: Var.Canonical -> Int -> Int -> Error
@@ -94,7 +95,7 @@ data PortError = PortError
9495 , portIsInbound :: Bool
9596 , portRootType :: Type.Canonical
9697 , portLocalType :: Type.Canonical
97− , portMessage :: String
98+ , portMessage :: Maybe String
9899 }
99100
100101
@@ -103,10 +104,10 @@ port
103104 -> Bool
104105 -> Type.Canonical
105106 -> Type.Canonical
106− -> String
107+ -> Maybe String
107108 -> Error
108−port name isInbound rootType localType message =
109− Port (PortError name isInbound rootType localType message)
109+port name isInbound rootType localType maybeMessage =
110+ Port (PortError name isInbound rootType localType maybeMessage)
110111
111112
112113-- NEARBY NAMES
@@ -128,138 +129,126 @@ distance x y =
128129 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
129130
130131
131−-- TO STRING
132+-- TO REPORT
132133
133−toString :: R.Region -> Error -> String
134−toString region err =
134+toReport :: Error -> Report.Report
135+toReport err =
135136 case err of
136− _ -> error "Canonicalize.toString" region
137−
138−
139−-- TO JSON
140−
141−toJson :: Error -> Json.Value
142−toJson err =
143− case err of
144− _ -> error "Canonicalize.toJson"
145−
146−{--
147−(.=.) key value =
148− key .= (value :: String)
149−
150−
151−errorToJson :: LError -> Json.Value
152−errorToJson (A.A region err) =
153− Json.object (generals ++ specifics)
154− where
155− generals =
156− [ "category" .=. "canonicalization"
157− , "region" .= region
158− ]
159−
160− specifics =
161− case err of
162− Var (VarError kind name varProblem) ->
163− [ "kind" .= kind
164− , "name" .= name
165− ]
166− ++ varProblemToJson varProblem
167−
168− Alias aliasError ->
169− case aliasError of
170− ArgMismatch name expected actual ->
171− [ "tag" .=. "alias-args"
172− , "name" .= Var.toString name
173− , "expected-args" .= expected
174− , "actual-args" .= actual
175− ]
176−
177− Recursive [(name, tvars, tipe)] ->
178− [ "tag" .=. "recursive-alias"
179− ]
180−
181− Recursive aliases ->
182− [ "tag" .=. "mutually-recursive-aliases"
183− ]
184−
185− Import moduleName importError ->
186− case importError of
187− ModuleNotFound suggestions ->
188− [ "tag" .=. "unknown-import"
189− , "name" .= moduleName
190− , "suggestions" .= suggestions
191− ]
192− ValueNotFound name suggestions ->
193− []
194−
195− Export name suggestions ->
196− []
197−
198− Port portError ->
199− []
200−
201−
202−varProblemToJson :: VarProblem -> [Json.Pair]
203−varProblemToJson varProblem =
204− let details tag suggestions =
205− [ "tag" .=. tag
206− , "suggestions" .= suggestions
207− ]
137+ Var (VarError kind name problem suggestions) ->
138+ let var = kind ++ " '" ++ name ++ "'"
139+ in
140+ case problem of
141+ Ambiguous ->
142+ Report.simple
143+ ("This usage of " ++ var ++ " is ambiguous.")
144+ (maybeYouWant suggestions)
145+
146+ UnknownQualifier qualifier ->
147+ Report.simple
148+ ("Cannot find " ++ var ++ ", qualifier '" ++ qualifier ++ "' is not in scope.")
149+ (maybeYouWant suggestions)
150+
151+ QualifiedUnknown qualifier ->
152+ Report.simple
153+ ("Cannot find " ++ var ++ ", module '" ++ qualifier ++ "' does not expose that value.")
154+ (maybeYouWant suggestions)
155+
156+ ExposedUnknown ->
157+ Report.simple
158+ ("Cannot find " ++ var)
159+ (maybeYouWant suggestions)
160+
161+ Pattern patternError ->
162+ case patternError of
163+ PatternArgMismatch var expected actual ->
164+ argMismatchReport "Pattern" var expected actual
165+
166+ Alias aliasError ->
167+ case aliasError of
168+ ArgMismatch var expected actual ->
169+ argMismatchReport "Type" var expected actual
170+
171+ SelfRecursive name tvars tipe ->
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."
181+
182+ MutuallyRecursive aliases ->
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."
188+ where
189+ showName (Region.Region start _, name, _, _) =
190+ "\n " ++ name ++ replicate (65 - length name) ' '
191+ ++ "line " ++ show (Region.line start)
192+
193+ Import name importError ->
194+ let moduleName = Module.nameToString name
195+ in
196+ case importError of
197+ ModuleNotFound suggestions ->
198+ Report.simple
199+ ("Could not find a module named '" ++ moduleName ++ "'")
200+ (maybeYouWant (map Module.nameToString suggestions))
201+
202+ ValueNotFound value suggestions ->
203+ Report.simple
204+ ("Module '" ++ moduleName ++ "' does not expose '" ++ value ++ "'")
205+ (maybeYouWant suggestions)
206+
207+ Export name suggestions ->
208+ Report.simple
209+ ("Could not export '" ++ name ++ "' which is not defined in this module.")
210+ (maybeYouWant suggestions)
211+
212+ Port (PortError name isInbound _rootType localType maybeMessage) ->
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
229+
230+
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."
238+
239+ postHint =
240+ "Expecting " ++ show expected ++ ", but got " ++ show actual ++ "."
208241 in
209− case varProblem of
210− Ambiguous possibilities ->
211− details "ambiguous" possibilities
212−
213− UnknownQualifier possibleModules ->
214− details
215− "unknown-qualifier"
216− (map Module.nameToString possibleModules)
217−
218− QualifiedUnknown possibilities ->
219− details "qualified-unknown" possibilities
220−
221− ExposedUnknown closeExposed closeQualified ->
222− details "exposed-unknown" (closeExposed ++ closeQualified)
223−--}
224−
225−{-- TO STRING
226−
227−mutuallyRecursiveMessage :: String
228−mutuallyRecursiveMessage =
229− "The following type aliases are mutually recursive, forming an \
230− \infinite type. When you expand them, they just keep getting bigger:"
231−
232−
233−typeAliasErrorSegue :: String
234−typeAliasErrorSegue =
235− "Try this instead:"
236−
237−
238−typeAliasErrorExplanation :: String
239−typeAliasErrorExplanation =
240− "It looks very similar, but the 'type' keyword creates a brand new type, \
241− \not just an alias for an existing one. This lets us avoid infinitely \
242− \expanding it during type inference."
243−
244−
245−typeAlias
246− :: (String, [String], Type.Type var)
247− -> D.Declaration' pk def var expr
248−typeAlias (n,ts,t) =
249− D.TypeAlias n ts t
250−
242+ Report.Report Nothing preHint postHint
251243
252−datatype
253− :: (String, [String], Type.Type var)
254− -> D.Declaration' pk def var expr
255−datatype (n,ts,t) =
256− D.Datatype n ts [(n,[t])]
257244
245+maybeYouWant :: [String] -> String
246+maybeYouWant suggestions =
247+ case suggestions of
248+ [] ->
249+ ""
258250
259−indented :: [D.ValidDecl] -> Doc
260−indented decls =
261− P.vcat (map prty decls) <> P.text "\n"
262− where
263− prty decl = P.text "\n " <> pretty decl
251+ _:_ ->
252+ "Maybe you want one of the following?\n"
253+ ++ concatMap ("\n "++) suggestions
264254
265−--}