@@ -2,9 +2,15 @@
22module Reporting.Error.Syntax where
33
44import qualified Data.Aeson as Json
5+import qualified Data.List as List
56import qualified Text.Parsec.Error as Parsec
7+import qualified Text.PrettyPrint as P
8+import Text.PrettyPrint ((<+>))
69
7−import qualified Reporting.Region as R
10+import qualified AST.Helpers as Help
11+import qualified AST.Type as Type
12+import Elm.Utils ((|>))
13+import qualified Reporting.PrettyPrint as P
814
915
1016data Error
@@ -15,15 +21,103 @@ data Error
1521 | DuplicateValueDeclaration String
1622 | DuplicateTypeDeclaration String
1723 | DuplicateDefinition String
18− | UnboundTypeVar String String
24+ | UnboundTypeVarsInAlias String [String] String [String] Type.Raw
25+ | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]
1926
2027
2128-- TO STRING
2229
23−toString :: R.Region -> Error -> String
24−toString region err =
30+toHint :: Error -> String
31+toHint err =
2532 case err of
26− _ -> error "Syntax.toString" region
33+ Parse messages ->
34+ error "TODO" messages
35+
36+ InfixDuplicate opName ->
37+ "The infix declarations for " ++ operator ++ " must be removed.\n\n"
38+ ++ "The precedence and associativity can only be set in one place, and\n"
39+ ++ "this information has already been set somewhere else."
40+ where
41+ operator =
42+ if Help.isOp opName
43+ then "(" ++ opName ++ ")"
44+ else "`" ++ opName ++ "`"
45+
46+ TypeWithoutDefinition valueName ->
47+ "There is a type annotation for '" ++ valueName ++ "' but there"
48+ ++ "is no corresponding definition! I need something like this:\n\n"
49+ ++ " " ++ valueName ++ " = 42\n\n"
50+ ++ "And be sure to put the definition directly below the type annotation."
51+
52+ PortWithoutAnnotation portName ->
53+ "There is a port named '" ++ portName ++ "' but it does not have"
54+ ++ "a type annotation! I need something like this:\n\n"
55+ ++ indent ("port " ++ portName ++ " : Signal Int") ++ "\n\n"
56+ ++ "And be sure to put this annotation directly above the port definition."
57+
58+ DuplicateValueDeclaration name ->
59+ "Multiple top-level declarations define '" ++ name ++ "',\n"
60+ ++ "but the name overlap makes all uses of '" ++ name ++ "' ambiguous.\n"
61+ ++ "How can we know which you want?!\n\n"
62+ ++ "Find all the top-level variables named '" ++ name ++ "' and\n"
63+ ++ "do some renaming. Make sure the names are distinct!"
64+
65+ DuplicateTypeDeclaration tipeName ->
66+ "Multiple declarations define a type '" ++ tipeName ++ "',\n"
67+ ++ "but the name overlap makes all uses of '" ++ tipeName ++ "' ambiguous.\n"
68+ ++ "How can we know which you want?!\n\n"
69+ ++ "Find all the types named '" ++ tipeName ++ "' and\n"
70+ ++ "do some renaming. Make sure the names are distinct!"
71+
72+ DuplicateDefinition name ->
73+ "This let-expression defines multiple variables named '" ++ name ++ "',\n"
74+ ++ "but the name overlap makes all uses of '" ++ name ++ "' ambiguous.\n"
75+ ++ "How can we know which you want?!\n\n"
76+ ++ "Find the variables named '" ++ name ++ "' in this let-expression and\n"
77+ ++ "do some renaming. Make sure the names are distinct!"
78+
79+ UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
80+ unboundTypeVars typeName tvar tvars $ P.render $
81+ P.hang
82+ (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
83+ 4
84+ (P.pretty False tipe)
85+ where
86+ vars = map P.text (givenVars ++ tvar : tvars)
87+
88+
89+ UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
90+ unboundTypeVars typeName tvar tvars $ P.render $
91+ P.vcat
92+ [ P.text "type" <+> P.text typeName <+> P.hsep vars
93+ , map toDoc ctors
94+ |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
95+ |> P.vcat
96+ |> P.nest 4
97+ ]
98+ where
99+ vars = map P.text (givenVars ++ tvar : tvars)
100+ toDoc (ctor, args) =
101+ P.text ctor <+> P.hsep (map (P.pretty True) args)
102+
103+
104+unboundTypeVars :: String -> String -> [String] -> String -> String
105+unboundTypeVars typeName tvar tvars revisedDeclaration =
106+ "In the definition of type '" ++ typeName ++ "' you use the following\n"
107+ ++ "unbound type variable" ++ s ++ ": " ++ List.intercalate ", " (tvar:tvars) ++ "\n\n"
108+ ++ "All type variables must be listed to avoid sneaky type errors.\n"
109+ ++ "Imagine one '" ++ typeName ++ "' where '" ++ tvar ++ "' is an Int and\n"
110+ ++ "another where it is a Bool. They both look like a '" ++ typeName ++ "'\n"
111+ ++ "to the type checker, but they are actually different types!\n\n"
112+ ++ "Maybe you want a definition like this?\n\n"
113+ ++ indent revisedDeclaration ++ "\n\n"
114+ where
115+ s = if null tvars then "" else "s"
116+
117+
118+indent :: String -> String
119+indent string =
120+ List.intercalate "\n" (map (" " ++ ) (lines string))
27121
28122
29123-- TO JSON
@@ -32,4 +126,3 @@ toJson :: Error -> Json.Value
32126toJson err =
33127 case err of
34128 _ -> error "Syntax.toJson"
35−