git.iko.soy/elk
on 2fbfb20 help sign in
elk/src/Reporting/Error/Syntax.hs
231 lines 7.3 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 Elm.Utils ((|>))
13import qualified Reporting.PrettyPrint as P
14import qualified Reporting.Report as Report
17data Error
18 = Parse [Parsec.Message]
19 | InfixDuplicate String
20 | TypeWithoutDefinition String
21 | PortWithoutAnnotation String
22 | UnexpectedPort
23 | DuplicateValueDeclaration String
24 | DuplicateTypeDeclaration String
25 | DuplicateDefinition String
26 | UnboundTypeVarsInAlias String [String] String [String] Type.Raw
27 | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]
30-- TO REPORT
32toReport :: Error -> Report.Report
33toReport err =
34 case err of
35 Parse messages ->
36 parseErrorReport messages
38 InfixDuplicate opName ->
39 Report.simple
40 "INFIX OVERLAP"
41 ("The infix declarations for " ++ operator ++ " must be removed.")
42 ("The precedence and associativity can only be set in one place, and\n"
43 ++ "this information has already been set somewhere else."
44 )
45 where
46 operator =
47 if Help.isOp opName
48 then "(" ++ opName ++ ")"
49 else "`" ++ opName ++ "`"
51 TypeWithoutDefinition valueName ->
52 Report.simple
53 "MISSING DEFINITION"
54 ("There is a type annotation for '" ++ valueName ++ "' but there"
55 ++ "is no corresponding definition!"
56 )
57 ("Directly below the type annotation, put a definition like:\n\n"
58 ++ " " ++ valueName ++ " = 42"
59 )
61 PortWithoutAnnotation portName ->
62 Report.simple
63 "PORT ERROR"
64 ("Port '" ++ portName ++ "' does not have a type annotation!")
65 ("Directly above the port definition, I need something like this:\n\n"
66 ++ " port " ++ portName ++ " : Signal Int"
67 )
70 UnexpectedPort ->
71 Report.simple
72 "PORT ERROR"
73 "This module has ports, but ports can only appear in the main module."
74 ( "Ports in library code would create hidden dependencies where importing a\n"
75 ++ "module could bring in constraints not captured in the public API. Furthermore,\n"
76 ++ "if the module is imported twice, do we send values out the port twice?"
77 )
79 DuplicateValueDeclaration name ->
80 Report.simple
81 "DUPLICATE DEFINITION"
82 ("Naming multiple top-level values '" ++ name ++ "' makes things\n"
83 ++ "ambiguous. When you say '" ++ name ++ "' which one do you want?!"
84 )
85 ("Find all the top-level values named '" ++ name ++ "' and\n"
86 ++ "do some renaming. Make sure the names are distinct!"
87 )
89 DuplicateTypeDeclaration name ->
90 Report.simple
91 "DUPLICATE DEFINITION"
92 ("Naming multiple types '" ++ name ++ "' makes things ambiguous\n"
93 ++ "When you say '" ++ name ++ "' which one do you want?!"
94 )
95 ("Find all the types named '" ++ name ++ "' and\n"
96 ++ "do some renaming. Make sure the names are distinct!"
97 )
99 DuplicateDefinition name ->
100 Report.simple
101 "DUPLICATE DEFINITION"
102 ("Naming multiple values '" ++ name ++ "' in a single let-expression makes\n"
103 ++ "things ambiguous. When you say '" ++ name ++ "' which one do you want?!"
104 )
105 ("Find all the values named '" ++ name ++ "' in this let-expression and\n"
106 ++ "do some renaming. Make sure the names are distinct!"
107 )
109 UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
110 unboundTypeVars typeName tvar tvars $ P.render $
111 P.hang
112 (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
113 4
114 (P.pretty False tipe)
115 where
116 vars = map P.text (givenVars ++ tvar : tvars)
119 UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
120 unboundTypeVars typeName tvar tvars $ P.render $
121 P.vcat
122 [ P.text "type" <+> P.text typeName <+> P.hsep vars
123 , map toDoc ctors
124 |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
125 |> P.vcat
126 |> P.nest 4
127 ]
128 where
129 vars = map P.text (givenVars ++ tvar : tvars)
130 toDoc (ctor, args) =
131 P.text ctor <+> P.hsep (map (P.pretty True) args)
134unboundTypeVars :: String -> String -> [String] -> String -> Report.Report
135unboundTypeVars typeName tvar tvars revisedDeclaration =
136 Report.simple
137 "UNBOUND TYPE VARS"
138 ( "Not all type variables in '" ++ typeName ++ "' are listed, making sneaky\n"
139 ++ "type errors possible. Unbound type variables include: "
140 ++ List.intercalate ", " (tvar:tvars)
141 )
142 ( "You probably want this definition instead:\n"
143 ++ concatMap ("\n "++) (lines revisedDeclaration) ++ "\n\n"
144 ++ "Here's why. Imagine one '" ++ typeName ++ "' where '" ++ tvar ++ "' is an Int and\n"
145 ++ "another where it is a Bool. When we explicitly list the type variables, type\n"
146 ++ "checker can see that they are actually different types."
147 )
150-- TAGGING PARSE ERRORS
152newline :: String
153newline = "NEWLINE"
155freshLine :: String
156freshLine = "FRESH_LINE"
158whitespace :: String
159whitespace = "WHITESPACE"
161keyword :: String -> String
162keyword kwd =
163 "KEYWORD=" ++ kwd
165unkeyword :: String -> Maybe String
166unkeyword message =
167 if List.isPrefixOf "KEYWORD=" message
168 then Just (drop (length "KEYWORD=") message)
169 else Nothing
172-- REPORTING PARSE ERRORS
174parseErrorReport :: [Parsec.Message] -> Report.Report
175parseErrorReport messages =
176 let
177 addMsg message hint =
178 case message of
179 Parsec.SysUnExpect _msg ->
180 hint
182 Parsec.UnExpect _msg ->
183 hint
185 Parsec.Expect msg ->
186 let
187 msg' =
188 if msg `elem` [whitespace, newline, freshLine]
189 then "whitespace"
190 else msg
191 in
192 hint { _expected = Set.insert msg' (_expected hint) }
194 Parsec.Message msg ->
195 hint { _messages = msg : _messages hint }
197 (ParseHint msgs expects) =
198 foldr addMsg emptyHint messages
200 preHint =
201 case msgs of
202 [msg] ->
203 case unkeyword msg of
204 Just kwd ->
205 "It looks like the keyword '" ++ kwd ++ "' is being used as a variable.\n"
206 ++ "Try renaming it to something else."
207 Nothing ->
208 msg
210 _ -> "I ran into something unexpected when parsing your code!"
212 postHint =
213 if Set.null expects
214 then ""
215 else
216 "I am looking for one of the following things:\n"
217 ++ concatMap ("\n "++) (Set.toList expects)
218 in
219 Report.simple "SYNTAX PROBLEM" preHint postHint
222data ParseHint = ParseHint
223 { _messages :: [String]
224 , _expected :: Set.Set String
225 }
226 deriving (Show)
229emptyHint :: ParseHint
230emptyHint =
231 ParseHint [] Set.empty