git.iko.soy/elk
on f4ea9e3 help sign in
elk/src/Reporting/Error/Syntax.hs
260 lines 8.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Syntax where
4import qualified Data.List as List
5import qualified Data.Set as Set
6import qualified Text.Parsec.Error as Parsec
7import qualified Text.PrettyPrint as P
8import Text.PrettyPrint ((<+>))
10import qualified AST.Helpers as Help
11import qualified AST.Type as Type
12import qualified Reporting.PrettyPrint as P
13import qualified Reporting.Report as Report
16data Error
17 = Parse [Parsec.Message]
18 | BadFunctionName Int
19 | BadPattern String
20 | InfixDuplicate String
21 | TypeWithoutDefinition String
22 | PortWithoutAnnotation String
23 | UnexpectedPort
24 | DuplicateFieldName String
25 | DuplicateValueDeclaration String
26 | DuplicateTypeDeclaration String
27 | DuplicateDefinition String
28 | UnboundTypeVarsInAlias String [String] String [String] Type.Raw
29 | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]
32-- TO REPORT
34toReport :: P.Dealiaser -> Error -> Report.Report
35toReport dealiaser err =
36 case err of
37 Parse messages ->
38 parseErrorReport messages
40 BadFunctionName arity ->
41 Report.simple
42 "BAD FUNCTION DEFINITION"
43 "Complex patterns cannot be used as function names."
44 ( "This function definition has " ++ show arity ++ " arguments, but instead of a normal name like\n"
45 ++ "`add` or `reverse` it has a pattern. There is no way to \"deconstruct\" a\n"
46 ++ "function with pattern matching, so this needs to be changed to a normal name."
47 )
49 BadPattern name ->
50 Report.simple
51 "BAD PATTERN"
52 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")
53 ( "Rename the variables so there are no duplicates.\n\n"
54 ++ "In Elm, pattern matching works by binding these free variables to subsections\n"
55 ++ "of the matching value. It does not make sense to have the same name for two\n"
56 ++ "different subsections though! When you say `" ++ name ++ "` in some code, there\n"
57 ++ "is no way for me to know which subsection you mean!"
58 )
60 InfixDuplicate opName ->
61 Report.simple
62 "INFIX OVERLAP"
63 ("The infix declarations for " ++ operator ++ " must be removed.")
64 ("The precedence and associativity can only be set in one place, and\n"
65 ++ "this information has already been set somewhere else."
66 )
67 where
68 operator =
69 if Help.isOp opName
70 then "(" ++ opName ++ ")"
71 else "`" ++ opName ++ "`"
73 TypeWithoutDefinition valueName ->
74 Report.simple
75 "MISSING DEFINITION"
76 ("There is a type annotation for `" ++ valueName ++ "` but there"
77 ++ " is no corresponding definition!"
78 )
79 ("Directly below the type annotation, put a definition like:\n\n"
80 ++ " " ++ valueName ++ " = 42"
81 )
83 PortWithoutAnnotation portName ->
84 Report.simple
85 "PORT ERROR"
86 ("Port `" ++ portName ++ "` does not have a type annotation!")
87 ("Directly above the port definition, I need something like this:\n\n"
88 ++ " port " ++ portName ++ " : Signal Int"
89 )
92 UnexpectedPort ->
93 Report.simple
94 "PORT ERROR"
95 "This module has ports, but ports can only appear in the main module."
96 ( "Ports in library code would create hidden dependencies where importing a\n"
97 ++ "module could bring in constraints not captured in the public API. Furthermore,\n"
98 ++ "if the module is imported twice, do we send values out the port twice?"
99 )
101 DuplicateFieldName name ->
102 Report.simple
103 "DUPLICATE FIELD"
104 ("This record has more than one field named `" ++ name ++ "`.")
105 "There can only be one. Do some renaming to make sure the names are distinct!"
107 DuplicateValueDeclaration name ->
108 Report.simple
109 "DUPLICATE DEFINITION"
110 ("Naming multiple top-level values `" ++ name ++ "` makes things\n"
111 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
112 )
113 ("Find all the top-level values named `" ++ name ++ "` and\n"
114 ++ "do some renaming. Make sure the names are distinct!"
115 )
117 DuplicateTypeDeclaration name ->
118 Report.simple
119 "DUPLICATE DEFINITION"
120 ("Naming multiple types `" ++ name ++ "` makes things ambiguous\n"
121 ++ "When you say `" ++ name ++ "` which one do you want?"
122 )
123 ("Find all the types named `" ++ name ++ "` and\n"
124 ++ "do some renaming. Make sure the names are distinct!"
125 )
127 DuplicateDefinition name ->
128 Report.simple
129 "DUPLICATE DEFINITION"
130 ("Naming multiple values `" ++ name ++ "` in a single let-expression makes\n"
131 ++ "things ambiguous. When you say `" ++ name ++ "` which one do you want?"
132 )
133 ("Find all the values named `" ++ name ++ "` in this let-expression and\n"
134 ++ "do some renaming. Make sure the names are distinct!"
135 )
137 UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
138 unboundTypeVars typeName tvar tvars $ P.render $
139 P.hang
140 (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
141 4
142 (P.pretty dealiaser False tipe)
143 where
144 vars = map P.text (givenVars ++ tvar : tvars)
147 UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
148 unboundTypeVars typeName tvar tvars $ P.render $
149 P.vcat
150 [ P.text "type" <+> P.text typeName <+> P.hsep vars
151 , map toDoc ctors
152 |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
153 |> P.vcat
154 |> P.nest 4
155 ]
156 where
157 (|>) = flip ($)
158 vars = map P.text (givenVars ++ tvar : tvars)
159 toDoc (ctor, args) =
160 P.text ctor <+> P.hsep (map (P.pretty dealiaser True) args)
163unboundTypeVars :: String -> String -> [String] -> String -> Report.Report
164unboundTypeVars typeName tvar tvars revisedDeclaration =
165 Report.simple
166 "UNBOUND TYPE VARS"
167 ( "Not all type variables in `" ++ typeName ++ "` are listed, making sneaky\n"
168 ++ "type errors possible. Unbound type variables include: "
169 ++ List.intercalate ", " (tvar:tvars)
170 )
171 ( "You probably want this definition instead:\n"
172 ++ concatMap ("\n "++) (lines revisedDeclaration) ++ "\n\n"
173 ++ "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\n"
174 ++ "another where it is a Bool. When we explicitly list the type variables, type\n"
175 ++ "checker can see that they are actually different types."
176 )
179-- TAGGING PARSE ERRORS
181newline :: String
182newline = "NEWLINE"
184freshLine :: String
185freshLine = "FRESH_LINE"
187whitespace :: String
188whitespace = "WHITESPACE"
190keyword :: String -> String
191keyword kwd =
192 "KEYWORD=" ++ kwd
194unkeyword :: String -> Maybe String
195unkeyword message =
196 if List.isPrefixOf "KEYWORD=" message
197 then Just (drop (length "KEYWORD=") message)
198 else Nothing
201-- REPORTING PARSE ERRORS
203parseErrorReport :: [Parsec.Message] -> Report.Report
204parseErrorReport messages =
205 let
206 addMsg message hint =
207 case message of
208 Parsec.SysUnExpect _msg ->
209 hint
211 Parsec.UnExpect _msg ->
212 hint
214 Parsec.Expect msg ->
215 let
216 msg' =
217 if msg `elem` [whitespace, newline, freshLine]
218 then "whitespace"
219 else msg
220 in
221 hint { _expected = Set.insert msg' (_expected hint) }
223 Parsec.Message msg ->
224 hint { _messages = msg : _messages hint }
226 (ParseHint msgs expects) =
227 foldr addMsg emptyHint messages
229 preHint =
230 case msgs of
231 [msg] ->
232 case unkeyword msg of
233 Just kwd ->
234 "It looks like the keyword `" ++ kwd ++ "` is being used as a variable.\n"
235 ++ "Try renaming it to something else."
236 Nothing ->
237 msg
239 _ -> "I ran into something unexpected when parsing your code!"
241 postHint =
242 if Set.null expects
243 then ""
244 else
245 "I am looking for one of the following things:\n"
246 ++ concatMap ("\n "++) (Set.toList expects)
247 in
248 Report.simple "SYNTAX PROBLEM" preHint postHint
251data ParseHint = ParseHint
252 { _messages :: [String]
253 , _expected :: Set.Set String
254 }
255 deriving (Show)
258emptyHint :: ParseHint
259emptyHint =
260 ParseHint [] Set.empty