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